|
version 1.13, 2010/08/26 19:07:34
|
version 1.14, 2010/09/11 07:27:03
|
|
Line 20
|
Line 20
|
| */ |
*/ |
| |
|
| |
|
| #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;
|
unsigned long i; |
| unsigned long j;
|
unsigned long j; |
| unsigned long k;
|
unsigned long k; |
| unsigned long taille_matrice_f77;
|
unsigned long 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 < (unsigned long) 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(nombre_colonnes_a * sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(j = 0; j < (unsigned long) nombre_colonnes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_colonnes_a; j++) |
| {
|
{ |
| ((real8 **) (*s_matrice).tableau)[i][j] =
|
((real8 **) (*s_matrice).tableau)[i][j] = |
| ((integer8 *) tampon)[j];
|
((integer8 *) tampon)[j]; |
| }
|
} |
|
|
|
| free(tampon);
|
free(tampon); |
| }
|
} |
|
|
|
| (*s_matrice).type = 'R';
|
(*s_matrice).type = 'R'; |
| }
|
} |
|
|
|
| case 'R' :
|
case 'R' : |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((matrice_vs_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_vs_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == 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(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_a_f77)[k++] = ((real8 **)
|
((real8 *) matrice_a_f77)[k++] = ((real8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((wr = (real8 *) malloc(nombre_lignes_a * sizeof(real8)))
|
if ((wr = (real8 *) malloc(nombre_lignes_a * sizeof(real8))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((wi = (real8 *) malloc(nombre_lignes_a * sizeof(real8)))
|
if ((wi = (real8 *) malloc(nombre_lignes_a * sizeof(real8))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| lwork = -1;
|
lwork = -1; |
|
|
|
| if ((work = (real8 *) malloc(sizeof(real8))) == NULL)
|
if ((work = (real8 *) malloc(sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| &nombre_colonnes_a, &sdim, wr, wi,
|
&nombre_colonnes_a, &sdim, wr, wi, |
| matrice_vs_f77, &nombre_colonnes_a,
|
matrice_vs_f77, &nombre_colonnes_a, |
| work, &lwork, NULL, &info, 1, 1);
|
work, &lwork, NULL, &info, 1, 1); |
|
|
|
| lwork = ((real8 *) work)[0];
|
lwork = ((real8 *) work)[0]; |
| free(work);
|
free(work); |
|
|
|
| if ((work = (real8 *) malloc(lwork * sizeof(real8))) == NULL)
|
if ((work = (real8 *) malloc(lwork * sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
dgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| &nombre_colonnes_a, &sdim, wr, wi,
|
&nombre_colonnes_a, &sdim, wr, wi, |
| matrice_vs_f77, &nombre_colonnes_a,
|
matrice_vs_f77, &nombre_colonnes_a, |
| work, &lwork, NULL, &info, 1, 1);
|
work, &lwork, NULL, &info, 1, 1); |
|
|
|
| free(work);
|
free(work); |
| free(wr);
|
free(wr); |
| free(wi);
|
free(wi); |
|
|
|
| if (info != 0)
|
if (info != 0) |
| {
|
{ |
| if (info > 0)
|
if (info > 0) |
| {
|
{ |
| (*s_etat_processus).exception = d_ep_decomposition_QR;
|
(*s_etat_processus).exception = d_ep_decomposition_QR; |
| }
|
} |
| else
|
else |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
| }
|
} |
|
|
|
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(matrice_vs_f77);
|
free(matrice_vs_f77); |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 **) (*s_matrice).tableau)[j][i] =
|
((real8 **) (*s_matrice).tableau)[j][i] = |
| ((real8 *) matrice_a_f77)[k++];
|
((real8 *) matrice_a_f77)[k++]; |
| }
|
} |
| }
|
} |
|
|
|
| (**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes;
|
(**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes; |
| (**s_schur).nombre_lignes = (*s_matrice).nombre_lignes;
|
(**s_schur).nombre_lignes = (*s_matrice).nombre_lignes; |
| (**s_schur).type = 'R';
|
(**s_schur).type = 'R'; |
|
|
|
| if (((**s_schur).tableau = malloc((**s_schur)
|
if (((**s_schur).tableau = malloc((**s_schur) |
| .nombre_lignes * sizeof(real8 *))) == NULL)
|
.nombre_lignes * 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 < (**s_schur).nombre_lignes; i++)
|
for(i = 0; i < (**s_schur).nombre_lignes; i++) |
| {
|
{ |
| if ((((real8 **) (**s_schur).tableau)[i] = (real8 *)
|
if ((((real8 **) (**s_schur).tableau)[i] = (real8 *) |
| malloc((**s_schur).nombre_colonnes *
|
malloc((**s_schur).nombre_colonnes * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (**s_schur).nombre_lignes; j++)
|
for(j = 0; j < (**s_schur).nombre_lignes; j++) |
| {
|
{ |
| ((real8 **) (**s_schur).tableau)[j][i] = ((real8 *)
|
((real8 **) (**s_schur).tableau)[j][i] = ((real8 *) |
| matrice_vs_f77)[k++];
|
matrice_vs_f77)[k++]; |
| }
|
} |
| }
|
} |
|
|
|
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(matrice_vs_f77);
|
free(matrice_vs_f77); |
|
|
|
| break;
|
break; |
| }
|
} |
|
|
|
| case 'C' :
|
case 'C' : |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((matrice_vs_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_vs_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 *) matrice_a_f77)[k].partie_reelle =
|
((complex16 *) matrice_a_f77)[k].partie_reelle = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_reelle;
|
.partie_reelle; |
| ((complex16 *) matrice_a_f77)[k++].partie_imaginaire =
|
((complex16 *) matrice_a_f77)[k++].partie_imaginaire = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_imaginaire;
|
.partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| if ((w = (complex16 *) malloc(nombre_lignes_a * sizeof(complex16)))
|
if ((w = (complex16 *) malloc(nombre_lignes_a * sizeof(complex16))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| lwork = -1;
|
lwork = -1; |
|
|
|
| if ((work = (complex16 *) malloc(sizeof(complex16))) == NULL)
|
if ((work = (complex16 *) malloc(sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((rwork = (real8 *) malloc(nombre_lignes_a * sizeof(real8)))
|
if ((rwork = (real8 *) malloc(nombre_lignes_a * sizeof(real8))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| &nombre_colonnes_a, &sdim, w,
|
&nombre_colonnes_a, &sdim, w, |
| matrice_vs_f77, &nombre_colonnes_a,
|
matrice_vs_f77, &nombre_colonnes_a, |
| work, &lwork, rwork, NULL, &info, 1, 1);
|
work, &lwork, rwork, NULL, &info, 1, 1); |
|
|
|
| lwork = ((complex16 *) work)[0].partie_reelle;
|
lwork = ((complex16 *) work)[0].partie_reelle; |
| free(work);
|
free(work); |
|
|
|
| if ((work = (complex16 *) malloc(lwork * sizeof(complex16)))
|
if ((work = (complex16 *) malloc(lwork * sizeof(complex16))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur,
|
zgees_(&calcul_vecteurs_schur, &tri_vecteurs_schur, |
| NULL, &nombre_lignes_a, matrice_a_f77,
|
NULL, &nombre_lignes_a, matrice_a_f77, |
| &nombre_colonnes_a, &sdim, w,
|
&nombre_colonnes_a, &sdim, w, |
| matrice_vs_f77, &nombre_colonnes_a,
|
matrice_vs_f77, &nombre_colonnes_a, |
| work, &lwork, rwork, NULL, &info, 1, 1);
|
work, &lwork, rwork, NULL, &info, 1, 1); |
|
|
|
| free(work);
|
free(work); |
| free(rwork);
|
free(rwork); |
| free(w);
|
free(w); |
|
|
|
| if (info != 0)
|
if (info != 0) |
| {
|
{ |
| if (info > 0)
|
if (info > 0) |
| {
|
{ |
| (*s_etat_processus).exception = d_ep_decomposition_QR;
|
(*s_etat_processus).exception = d_ep_decomposition_QR; |
| }
|
} |
| else
|
else |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
| }
|
} |
|
|
|
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(matrice_vs_f77);
|
free(matrice_vs_f77); |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_reelle = ((complex16 *) matrice_a_f77)[k]
|
.partie_reelle = ((complex16 *) matrice_a_f77)[k] |
| .partie_reelle;
|
.partie_reelle; |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_imaginaire = ((complex16 *) matrice_a_f77)
|
.partie_imaginaire = ((complex16 *) matrice_a_f77) |
| [k++].partie_imaginaire;
|
[k++].partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| (**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes;
|
(**s_schur).nombre_colonnes = (*s_matrice).nombre_colonnes; |
| (**s_schur).nombre_lignes = (*s_matrice).nombre_lignes;
|
(**s_schur).nombre_lignes = (*s_matrice).nombre_lignes; |
| (**s_schur).type = 'C';
|
(**s_schur).type = 'C'; |
|
|
|
| if (((**s_schur).tableau = malloc((**s_schur)
|
if (((**s_schur).tableau = malloc((**s_schur) |
| .nombre_lignes * sizeof(complex16 *))) == NULL)
|
.nombre_lignes * sizeof(complex16 *))) == 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 < (**s_schur).nombre_lignes; i++)
|
for(i = 0; i < (**s_schur).nombre_lignes; i++) |
| {
|
{ |
| if ((((complex16 **) (**s_schur).tableau)[i] = (complex16 *)
|
if ((((complex16 **) (**s_schur).tableau)[i] = (complex16 *) |
| malloc((**s_schur).nombre_colonnes *
|
malloc((**s_schur).nombre_colonnes * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (**s_schur).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (**s_schur).nombre_lignes; j++)
|
for(j = 0; j < (**s_schur).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 **) (**s_schur).tableau)[j][i].partie_reelle =
|
((complex16 **) (**s_schur).tableau)[j][i].partie_reelle = |
| ((complex16 *) matrice_vs_f77)[k].partie_reelle;
|
((complex16 *) matrice_vs_f77)[k].partie_reelle; |
| ((complex16 **) (**s_schur).tableau)[j][i]
|
((complex16 **) (**s_schur).tableau)[j][i] |
| .partie_imaginaire = ((complex16 *) matrice_vs_f77)
|
.partie_imaginaire = ((complex16 *) matrice_vs_f77) |
| [k++].partie_imaginaire;
|
[k++].partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(matrice_vs_f77);
|
free(matrice_vs_f77); |
|
|
|
| break;
|
break; |
| }
|
} |
| }
|
} |
|
|
|
| return;
|
return; |
| }
|
} |
|
|
|
|
|
|
| /*
|
/* |
| ================================================================================
|
================================================================================ |
| Fonction réalisation la factorisation LQ d'une matrice quelconque
|
Fonction réalisation la factorisation LQ d'une matrice quelconque |
| ================================================================================
|
================================================================================ |
| Entrées : struct_matrice
|
Entrées : struct_matrice |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Sorties : décomposition de LQ de la matrice d'entrée. Le tableau tau
|
Sorties : décomposition de LQ de la matrice d'entrée. Le tableau tau |
| est initialisé par la fonction
|
est initialisé par la fonction |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Effets de bord : néant
|
Effets de bord : néant |
| ================================================================================
|
================================================================================ |
| */
|
*/ |
|
|
|
| void
|
void |
| factorisation_lq(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
factorisation_lq(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| void **tau)
|
void **tau) |
| {
|
{ |
| integer4 nombre_colonnes_a;
|
integer4 nombre_colonnes_a; |
| integer4 nombre_lignes_a;
|
integer4 nombre_lignes_a; |
| integer4 erreur;
|
integer4 erreur; |
|
|
|
| unsigned long i;
|
unsigned long i; |
| unsigned long j;
|
unsigned long j; |
| unsigned long k;
|
unsigned long k; |
| unsigned long taille_matrice_f77;
|
unsigned long taille_matrice_f77; |
|
|
|
| void *matrice_a_f77;
|
void *matrice_a_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; |
|
|
|
| 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 < (unsigned long) 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(nombre_colonnes_a * sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(j = 0; j < (unsigned long) nombre_colonnes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_colonnes_a; j++) |
| {
|
{ |
| ((real8 **) (*s_matrice).tableau)[i][j] =
|
((real8 **) (*s_matrice).tableau)[i][j] = |
| ((integer8 *) tampon)[j];
|
((integer8 *) tampon)[j]; |
| }
|
} |
|
|
|
| free(tampon);
|
free(tampon); |
| }
|
} |
|
|
|
| (*s_matrice).type = 'R';
|
(*s_matrice).type = 'R'; |
| }
|
} |
|
|
|
| case 'R' :
|
case 'R' : |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a) |
| ? nombre_colonnes_a : nombre_lignes_a) * sizeof(real8)))
|
? nombre_colonnes_a : nombre_lignes_a) * sizeof(real8))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((work = malloc(nombre_lignes_a * sizeof(real8))) == NULL)
|
if ((work = malloc(nombre_lignes_a * sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_a_f77)[k++] = ((real8 **)
|
((real8 *) matrice_a_f77)[k++] = ((real8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| dgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
dgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| &nombre_lignes_a, (*((real8 **) tau)), work, &erreur);
|
&nombre_lignes_a, (*((real8 **) tau)), work, &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); |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_lignes_a; j++) |
| {
|
{ |
| ((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *)
|
((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *) |
| matrice_a_f77)[k++];
|
matrice_a_f77)[k++]; |
| }
|
} |
| }
|
} |
|
|
|
| free(work);
|
free(work); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
|
|
|
| break;
|
break; |
| }
|
} |
|
|
|
| case 'C' :
|
case 'C' : |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a) |
| ? nombre_colonnes_a : nombre_lignes_a) *
|
? nombre_colonnes_a : nombre_lignes_a) * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((work = malloc(nombre_lignes_a * sizeof(complex16))) == NULL)
|
if ((work = malloc(nombre_lignes_a * sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 *) matrice_a_f77)[k].partie_reelle =
|
((complex16 *) matrice_a_f77)[k].partie_reelle = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_reelle;
|
.partie_reelle; |
| ((complex16 *) matrice_a_f77)[k++].partie_imaginaire =
|
((complex16 *) matrice_a_f77)[k++].partie_imaginaire = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_imaginaire;
|
.partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| zgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
zgelq2_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| &nombre_lignes_a, (*((complex16 **) tau)), work, &erreur);
|
&nombre_lignes_a, (*((complex16 **) tau)), work, &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); |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_lignes_a; j++) |
| {
|
{ |
| ((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle =
|
((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle = |
| ((complex16 *) matrice_a_f77)[k].partie_reelle;
|
((complex16 *) matrice_a_f77)[k].partie_reelle; |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_imaginaire = ((complex16 *) matrice_a_f77)
|
.partie_imaginaire = ((complex16 *) matrice_a_f77) |
| [k++].partie_imaginaire;
|
[k++].partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| free(work);
|
free(work); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
|
|
|
| break;
|
break; |
| }
|
} |
| }
|
} |
|
|
|
| return;
|
return; |
| }
|
} |
|
|
|
|
|
|
| /*
|
/* |
| ================================================================================
|
================================================================================ |
| Fonction réalisation la factorisation QR d'une matrice quelconque
|
Fonction réalisation la factorisation QR d'une matrice quelconque |
| ================================================================================
|
================================================================================ |
| Entrées : struct_matrice
|
Entrées : struct_matrice |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Sorties : décomposition de QR de la matrice d'entrée. Le tableau tau
|
Sorties : décomposition de QR de la matrice d'entrée. Le tableau tau |
| est initialisé par la fonction
|
est initialisé par la fonction |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Effets de bord : néant
|
Effets de bord : néant |
| ================================================================================
|
================================================================================ |
| */
|
*/ |
|
|
|
| void
|
void |
| factorisation_qr(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
factorisation_qr(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| void **tau)
|
void **tau) |
| {
|
{ |
| integer4 lwork;
|
integer4 lwork; |
| integer4 nombre_colonnes_a;
|
integer4 nombre_colonnes_a; |
| integer4 nombre_lignes_a;
|
integer4 nombre_lignes_a; |
| integer4 erreur;
|
integer4 erreur; |
| integer4 *pivot;
|
integer4 *pivot; |
|
|
|
| real8 *rwork;
|
real8 *rwork; |
|
|
|
| unsigned long i;
|
unsigned long i; |
| unsigned long j;
|
unsigned long j; |
| unsigned long k;
|
unsigned long k; |
| unsigned long taille_matrice_f77;
|
unsigned long taille_matrice_f77; |
|
|
|
| void *matrice_a_f77;
|
void *matrice_a_f77; |
| void *registre;
|
void *registre; |
| 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; |
|
|
|
| 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 < (unsigned long) 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(nombre_colonnes_a * sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(j = 0; j < (unsigned long) nombre_colonnes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_colonnes_a; j++) |
| {
|
{ |
| ((real8 **) (*s_matrice).tableau)[i][j] =
|
((real8 **) (*s_matrice).tableau)[i][j] = |
| ((integer8 *) tampon)[j];
|
((integer8 *) tampon)[j]; |
| }
|
} |
|
|
|
| free(tampon);
|
free(tampon); |
| }
|
} |
|
|
|
| (*s_matrice).type = 'R';
|
(*s_matrice).type = 'R'; |
| }
|
} |
|
|
|
| case 'R' :
|
case 'R' : |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a) |
| ? nombre_colonnes_a : nombre_lignes_a) * sizeof(real8)))
|
? nombre_colonnes_a : nombre_lignes_a) * sizeof(real8))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_a_f77)[k++] = ((real8 **)
|
((real8 *) matrice_a_f77)[k++] = ((real8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((pivot = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
if ((pivot = malloc(nombre_colonnes_a * sizeof(integer4))) == 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(i = 0; i < (unsigned long) nombre_colonnes_a; pivot[i++] = 0); |
|
|
|
| lwork = -1;
|
lwork = -1; |
|
|
|
| if ((work = malloc(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 taille de l'espace
|
// Calcul de la taille de l'espace |
|
|
|
| dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| &nombre_lignes_a, pivot, (*((real8 **) tau)),
|
&nombre_lignes_a, pivot, (*((real8 **) tau)), |
| work, &lwork, &erreur);
|
work, &lwork, &erreur); |
|
|
|
| lwork = ((real8 *) work)[0];
|
lwork = ((real8 *) work)[0]; |
|
|
|
| free(work);
|
free(work); |
|
|
|
| if ((work = malloc(lwork * sizeof(real8))) == NULL)
|
if ((work = malloc(lwork * 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 permutation |
|
|
|
| if ((registre = (void *) malloc(taille_matrice_f77 *
|
if ((registre = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| memcpy(registre, matrice_a_f77, taille_matrice_f77 * sizeof(real8));
|
memcpy(registre, matrice_a_f77, taille_matrice_f77 * sizeof(real8)); |
|
|
|
| dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre,
|
dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre, |
| &nombre_lignes_a, pivot, (*((real8 **) tau)),
|
&nombre_lignes_a, pivot, (*((real8 **) tau)), |
| work, &lwork, &erreur);
|
work, &lwork, &erreur); |
|
|
|
| free(registre);
|
free(registre); |
|
|
|
| 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
|
// La permutation doit maintenant être unitaire |
|
|
|
| dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
dgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| &nombre_lignes_a, pivot, (*((real8 **) tau)),
|
&nombre_lignes_a, pivot, (*((real8 **) tau)), |
| work, &lwork, &erreur);
|
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; |
| }
|
} |
|
|
|
| for(i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
for(i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| if ((i + 1) != (unsigned long) pivot[i])
|
if ((i + 1) != (unsigned long) pivot[i]) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(pivot);
|
free(pivot); |
| free(work);
|
free(work); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(tau);
|
free(tau); |
|
|
|
| return;
|
return; |
| }
|
} |
| }
|
} |
|
|
|
| free(pivot);
|
free(pivot); |
|
|
|
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_lignes_a; j++) |
| {
|
{ |
| ((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *)
|
((real8 **) (*s_matrice).tableau)[j][i] = ((real8 *) |
| matrice_a_f77)[k++];
|
matrice_a_f77)[k++]; |
| }
|
} |
| }
|
} |
|
|
|
| free(work);
|
free(work); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
|
|
|
| break;
|
break; |
| }
|
} |
|
|
|
| case 'C' :
|
case 'C' : |
| {
|
{ |
| if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_a_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a)
|
if (((*tau) = malloc(((nombre_colonnes_a < nombre_lignes_a) |
| ? nombre_colonnes_a : nombre_lignes_a) * sizeof(complex16)))
|
? nombre_colonnes_a : nombre_lignes_a) * sizeof(complex16))) |
| == NULL)
|
== NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 *) matrice_a_f77)[k].partie_reelle =
|
((complex16 *) matrice_a_f77)[k].partie_reelle = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_reelle;
|
.partie_reelle; |
| ((complex16 *) matrice_a_f77)[k++].partie_imaginaire =
|
((complex16 *) matrice_a_f77)[k++].partie_imaginaire = |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_imaginaire;
|
.partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| if ((pivot = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
if ((pivot = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((rwork = malloc(2 * nombre_colonnes_a * sizeof(real8))) == NULL)
|
if ((rwork = malloc(2 * nombre_colonnes_a * 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(i = 0; i < (unsigned long) nombre_colonnes_a; pivot[i++] = 0); |
|
|
|
| lwork = -1;
|
lwork = -1; |
|
|
|
| if ((work = malloc(sizeof(complex16))) == NULL)
|
if ((work = malloc(sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| // Calcul de la taille de l'espace
|
// Calcul de la taille de l'espace |
|
|
|
| zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| &nombre_lignes_a, pivot, (*((complex16 **) tau)),
|
&nombre_lignes_a, pivot, (*((complex16 **) tau)), |
| work, &lwork, rwork, &erreur);
|
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 =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(work);
|
free(work); |
| free(rwork);
|
free(rwork); |
| free(pivot);
|
free(pivot); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(tau);
|
free(tau); |
| return;
|
return; |
| }
|
} |
|
|
|
| lwork = ((complex16 *) work)[0].partie_reelle;
|
lwork = ((complex16 *) work)[0].partie_reelle; |
|
|
|
| free(work);
|
free(work); |
|
|
|
| if ((work = malloc(lwork * sizeof(complex16))) == NULL)
|
if ((work = malloc(lwork * sizeof(complex16))) == 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 permutation |
|
|
|
| if ((registre = (void *) malloc(taille_matrice_f77 *
|
if ((registre = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| memcpy(registre, matrice_a_f77,
|
memcpy(registre, matrice_a_f77, |
| taille_matrice_f77 * sizeof(complex16));
|
taille_matrice_f77 * sizeof(complex16)); |
|
|
|
| zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre,
|
zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, registre, |
| &nombre_lignes_a, pivot, (*((complex16 **) tau)),
|
&nombre_lignes_a, pivot, (*((complex16 **) tau)), |
| work, &lwork, rwork, &erreur);
|
work, &lwork, rwork, &erreur); |
|
|
|
| free(registre);
|
free(registre); |
|
|
|
| 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(rwork);
|
free(rwork); |
| free(pivot);
|
free(pivot); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(tau);
|
free(tau); |
| return;
|
return; |
| }
|
} |
|
|
|
| // La permutation doit maintenant être unitaire
|
// La permutation doit maintenant être unitaire |
|
|
|
| zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77,
|
zgeqp3_(&nombre_lignes_a, &nombre_colonnes_a, matrice_a_f77, |
| &nombre_lignes_a, pivot, (*((complex16 **) tau)),
|
&nombre_lignes_a, pivot, (*((complex16 **) tau)), |
| work, &lwork, rwork, &erreur);
|
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 =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(work);
|
free(work); |
| free(rwork);
|
free(rwork); |
| free(pivot);
|
free(pivot); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(tau);
|
free(tau); |
| return;
|
return; |
| }
|
} |
|
|
|
| free(rwork);
|
free(rwork); |
|
|
|
| for(i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
for(i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| if ((i + 1) != (unsigned long) pivot[i])
|
if ((i + 1) != (unsigned long) pivot[i]) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(pivot);
|
free(pivot); |
| free(work);
|
free(work); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
| free(tau);
|
free(tau); |
|
|
|
| return;
|
return; |
| }
|
} |
| }
|
} |
|
|
|
| free(pivot);
|
free(pivot); |
|
|
|
| for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++)
|
for(k = 0, i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| for(j = 0; j < (unsigned long) nombre_lignes_a; j++)
|
for(j = 0; j < (unsigned long) nombre_lignes_a; j++) |
| {
|
{ |
| ((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle =
|
((complex16 **) (*s_matrice).tableau)[j][i].partie_reelle = |
| ((complex16 *) matrice_a_f77)[k].partie_reelle;
|
((complex16 *) matrice_a_f77)[k].partie_reelle; |
| ((complex16 **) (*s_matrice).tableau)[j][i]
|
((complex16 **) (*s_matrice).tableau)[j][i] |
| .partie_imaginaire = ((complex16 *)
|
.partie_imaginaire = ((complex16 *) |
| matrice_a_f77)[k++].partie_imaginaire;
|
matrice_a_f77)[k++].partie_imaginaire; |
| }
|
} |
| }
|
} |
|
|
|
| free(work);
|
free(work); |
| free(matrice_a_f77);
|
free(matrice_a_f77); |
|
|
|
| break;
|
break; |
| }
|
} |
| }
|
} |
|
|
|
| return;
|
return; |
| }
|
} |
|
|
|
|
|
|
| /*
|
/* |
| ================================================================================
|
================================================================================ |
| Fonctions calculant le déterminant ou le rang d'une matrice quelconque
|
Fonctions calculant le déterminant ou le rang d'une matrice quelconque |
| ================================================================================
|
================================================================================ |
| Entrées : struct_matrice
|
Entrées : struct_matrice |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Sorties : déterminant
|
Sorties : déterminant |
| --------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
| Effets de bord : néant
|
Effets de bord : néant |
| ================================================================================
|
================================================================================ |
| */
|
*/ |
|
|
|
|
|
|
| static integer4
|
static integer4 |
| calcul_rang(struct_processus *s_etat_processus, void *matrice_f77,
|
calcul_rang(struct_processus *s_etat_processus, void *matrice_f77, |
| integer4 nombre_lignes_a, integer4 nombre_colonnes_a,
|
integer4 nombre_lignes_a, integer4 nombre_colonnes_a, |
| integer4 *pivot, integer4 dimension_vecteur_pivot, unsigned char type)
|
integer4 *pivot, integer4 dimension_vecteur_pivot, unsigned char type) |
| {
|
{ |
| integer4 erreur;
|
integer4 erreur; |
| integer4 *iwork;
|
integer4 *iwork; |
| integer4 *jpvt;
|
integer4 *jpvt; |
| integer4 lwork;
|
integer4 lwork; |
| integer4 longueur;
|
integer4 longueur; |
| integer4 nombre_colonnes_b;
|
integer4 nombre_colonnes_b; |
| integer4 nombre_lignes_b;
|
integer4 nombre_lignes_b; |
| integer4 ordre;
|
integer4 ordre; |
| integer4 rang;
|
integer4 rang; |
|
|
|
| real8 anorme;
|
real8 anorme; |
| real8 rcond;
|
real8 rcond; |
| real8 *rwork;
|
real8 *rwork; |
|
|
|
| unsigned char norme;
|
unsigned char norme; |
|
|
|
| unsigned long i;
|
unsigned long i; |
|
|
|
| void *matrice_b;
|
void *matrice_b; |
| void *matrice_c;
|
void *matrice_c; |
| void *work;
|
void *work; |
|
|
|
| #undef NORME_I
|
#undef NORME_I |
| #ifdef NORME_I
|
#ifdef NORME_I |
| norme = 'I';
|
norme = 'I'; |
|
|
|
| if ((work = malloc(nombre_lignes_a * sizeof(real8))) == NULL)
|
if ((work = malloc(nombre_lignes_a * 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); |
| }
|
} |
| #else
|
#else |
| norme = '1';
|
norme = '1'; |
| work = NULL;
|
work = NULL; |
| #endif
|
#endif |
|
|
|
| longueur = 1;
|
longueur = 1; |
|
|
|
| if (type == 'R')
|
if (type == 'R') |
| {
|
{ |
| anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
|
anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a, |
| matrice_f77, &nombre_lignes_a, work, longueur);
|
matrice_f77, &nombre_lignes_a, work, longueur); |
|
|
|
| #ifndef NORME_I
|
#ifndef NORME_I |
| free(work);
|
free(work); |
| #endif
|
#endif |
|
|
|
| if ((matrice_c = malloc(nombre_lignes_a * nombre_colonnes_a *
|
if ((matrice_c = malloc(nombre_lignes_a * nombre_colonnes_a * |
| sizeof(real8))) == NULL)
|
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); |
| }
|
} |
|
|
|
| memcpy(matrice_c, matrice_f77, nombre_lignes_a * nombre_colonnes_a *
|
memcpy(matrice_c, matrice_f77, nombre_lignes_a * nombre_colonnes_a * |
| sizeof(real8));
|
sizeof(real8)); |
|
|
|
| dgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77,
|
dgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77, |
| &nombre_lignes_a, pivot, &erreur);
|
&nombre_lignes_a, pivot, &erreur); |
|
|
|
| if (erreur < 0)
|
if (erreur < 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| if ((iwork = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
if ((iwork = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| if ((work = malloc(4 * nombre_colonnes_a * sizeof(real8))) == NULL)
|
if ((work = malloc(4 * nombre_colonnes_a * 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); |
| }
|
} |
|
|
|
| ordre = (nombre_lignes_a > nombre_colonnes_a)
|
ordre = (nombre_lignes_a > nombre_colonnes_a) |
| ? nombre_colonnes_a : nombre_lignes_a;
|
? nombre_colonnes_a : nombre_lignes_a; |
|
|
|
| dgecon_(&norme, &ordre, matrice_f77,
|
dgecon_(&norme, &ordre, matrice_f77, |
| &nombre_lignes_a, &anorme, &rcond, work, iwork, &erreur,
|
&nombre_lignes_a, &anorme, &rcond, work, iwork, &erreur, |
| longueur);
|
longueur); |
|
|
|
| free(work);
|
free(work); |
| free(iwork);
|
free(iwork); |
|
|
|
| if (erreur < 0)
|
if (erreur < 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| if ((jpvt = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
if ((jpvt = malloc(nombre_colonnes_a * sizeof(integer4))) == 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 < (unsigned long) nombre_colonnes_a; i++)
|
for(i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| ((integer4 *) jpvt)[i] = 0;
|
((integer4 *) jpvt)[i] = 0; |
| }
|
} |
|
|
|
| lwork = -1;
|
lwork = -1; |
|
|
|
| if ((work = malloc(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(-1);
|
return(-1); |
| }
|
} |
|
|
|
| nombre_colonnes_b = 1;
|
nombre_colonnes_b = 1; |
| nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a)
|
nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a) |
| ? nombre_lignes_a : nombre_colonnes_a;
|
? nombre_lignes_a : nombre_colonnes_a; |
|
|
|
| if ((matrice_b = malloc(nombre_lignes_b * sizeof(real8))) == 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 < (unsigned long) nombre_lignes_b; i++)
|
for(i = 0; i < (unsigned long) nombre_lignes_b; i++) |
| {
|
{ |
| ((real8 *) matrice_b)[i] = 0;
|
((real8 *) matrice_b)[i] = 0; |
| }
|
} |
|
|
|
| dgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
dgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| work, &lwork, &erreur);
|
work, &lwork, &erreur); |
|
|
|
| lwork = ((real8 *) work)[0];
|
lwork = ((real8 *) work)[0]; |
| free(work);
|
free(work); |
|
|
|
| if ((work = malloc(lwork * sizeof(real8))) == NULL)
|
if ((work = malloc(lwork * 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); |
| }
|
} |
|
|
|
| dgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
dgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| work, &lwork, &erreur);
|
work, &lwork, &erreur); |
|
|
|
| free(matrice_b);
|
free(matrice_b); |
| free(matrice_c);
|
free(matrice_c); |
| free(work);
|
free(work); |
| free(jpvt);
|
free(jpvt); |
|
|
|
| if (erreur < 0)
|
if (erreur < 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| return(-1);
|
return(-1); |
| }
|
} |
| }
|
} |
| else
|
else |
| {
|
{ |
| anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
|
anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a, |
| matrice_f77, &nombre_lignes_a, work, longueur);
|
matrice_f77, &nombre_lignes_a, work, longueur); |
|
|
|
| #ifndef NORME_I
|
#ifndef NORME_I |
| free(work);
|
free(work); |
| #endif
|
#endif |
|
|
|
| if ((matrice_c = malloc(nombre_lignes_a * nombre_colonnes_a *
|
if ((matrice_c = malloc(nombre_lignes_a * nombre_colonnes_a * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| memcpy(matrice_c, matrice_f77, nombre_lignes_a * nombre_colonnes_a *
|
memcpy(matrice_c, matrice_f77, nombre_lignes_a * nombre_colonnes_a * |
| sizeof(complex16));
|
sizeof(complex16)); |
|
|
|
| zgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77,
|
zgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77, |
| &nombre_lignes_a, pivot, &erreur);
|
&nombre_lignes_a, pivot, &erreur); |
|
|
|
| if (erreur < 0)
|
if (erreur < 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| if ((rwork = malloc(2 * nombre_colonnes_a * sizeof(real8))) == NULL)
|
if ((rwork = malloc(2 * nombre_colonnes_a * 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); |
| }
|
} |
|
|
|
| if ((work = malloc(2 * nombre_colonnes_a * sizeof(complex16))) == NULL)
|
if ((work = malloc(2 * nombre_colonnes_a * sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| ordre = (nombre_lignes_a > nombre_colonnes_a)
|
ordre = (nombre_lignes_a > nombre_colonnes_a) |
| ? nombre_colonnes_a : nombre_lignes_a;
|
? nombre_colonnes_a : nombre_lignes_a; |
|
|
|
| zgecon_(&norme, &ordre, matrice_f77,
|
zgecon_(&norme, &ordre, matrice_f77, |
| &nombre_lignes_a, &anorme, &rcond, work, rwork, &erreur,
|
&nombre_lignes_a, &anorme, &rcond, work, rwork, &erreur, |
| longueur);
|
longueur); |
|
|
|
| free(work);
|
free(work); |
|
|
|
| if (erreur < 0)
|
if (erreur < 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| if ((jpvt = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
|
if ((jpvt = malloc(nombre_colonnes_a * sizeof(integer4))) == 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 < (unsigned long) nombre_colonnes_a; i++)
|
for(i = 0; i < (unsigned long) nombre_colonnes_a; i++) |
| {
|
{ |
| ((integer4 *) jpvt)[i] = 0;
|
((integer4 *) jpvt)[i] = 0; |
| }
|
} |
|
|
|
| lwork = -1;
|
lwork = -1; |
|
|
|
| if ((work = malloc(sizeof(complex16))) == NULL)
|
if ((work = malloc(sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| nombre_colonnes_b = 1;
|
nombre_colonnes_b = 1; |
| nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a)
|
nombre_lignes_b = (nombre_lignes_a > nombre_colonnes_a) |
| ? nombre_lignes_a : nombre_colonnes_a;
|
? nombre_lignes_a : nombre_colonnes_a; |
|
|
|
| if ((matrice_b = malloc(nombre_lignes_b * sizeof(complex16))) == NULL)
|
if ((matrice_b = malloc(nombre_lignes_b * sizeof(complex16))) == 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 < (unsigned long) nombre_lignes_b; i++)
|
for(i = 0; i < (unsigned long) nombre_lignes_b; i++) |
| {
|
{ |
| ((complex16 *) matrice_b)[i].partie_reelle = 0;
|
((complex16 *) matrice_b)[i].partie_reelle = 0; |
| ((complex16 *) matrice_b)[i].partie_imaginaire = 0;
|
((complex16 *) matrice_b)[i].partie_imaginaire = 0; |
| }
|
} |
|
|
|
| zgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
zgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| work, &lwork, rwork, &erreur);
|
work, &lwork, rwork, &erreur); |
|
|
|
| lwork = ((complex16 *) work)[0].partie_reelle;
|
lwork = ((complex16 *) work)[0].partie_reelle; |
| free(work);
|
free(work); |
|
|
|
| if ((work = malloc(lwork * sizeof(complex16))) == NULL)
|
if ((work = malloc(lwork * sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return(-1);
|
return(-1); |
| }
|
} |
|
|
|
| zgelsy_(&nombre_lignes_a, &nombre_colonnes_a,
|
zgelsy_(&nombre_lignes_a, &nombre_colonnes_a, |
| &nombre_colonnes_b, matrice_c, &nombre_lignes_a,
|
&nombre_colonnes_b, matrice_c, &nombre_lignes_a, |
| matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang,
|
matrice_b, &nombre_lignes_b, jpvt, &rcond, &rang, |
| work, &lwork, rwork, &erreur);
|
work, &lwork, rwork, &erreur); |
|
|
|
| free(rwork);
|
free(rwork); |
| free(matrice_b);
|
free(matrice_b); |
| free(matrice_c);
|
free(matrice_c); |
| free(work);
|
free(work); |
| free(jpvt);
|
free(jpvt); |
|
|
|
| if (erreur < 0)
|
if (erreur < 0) |
| {
|
{ |
| (*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
| d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| return(-1);
|
return(-1); |
| }
|
} |
| }
|
} |
|
|
|
| return(rang);
|
return(rang); |
| }
|
} |
|
|
|
|
|
|
| void
|
void |
| determinant(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
determinant(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| void *valeur)
|
void *valeur) |
| {
|
{ |
| complex16 *vecteur_complexe;
|
complex16 *vecteur_complexe; |
|
|
|
| integer4 dimension_vecteur_pivot;
|
integer4 dimension_vecteur_pivot; |
| integer4 nombre_colonnes_a;
|
integer4 nombre_colonnes_a; |
| integer4 nombre_lignes_a;
|
integer4 nombre_lignes_a; |
| integer4 *pivot;
|
integer4 *pivot; |
| integer4 rang;
|
integer4 rang; |
|
|
|
| integer8 signe;
|
integer8 signe; |
|
|
|
| real8 *vecteur_reel;
|
real8 *vecteur_reel; |
|
|
|
| unsigned long i;
|
unsigned long i; |
| unsigned long j;
|
unsigned long j; |
| unsigned long k;
|
unsigned long k; |
| unsigned long taille_matrice_f77;
|
unsigned long taille_matrice_f77; |
|
|
|
| void *matrice_f77;
|
void *matrice_f77; |
|
|
|
| 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; |
| dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a)
|
dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a) |
| ? nombre_lignes_a : nombre_colonnes_a;
|
? nombre_lignes_a : nombre_colonnes_a; |
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
|
|
|
| switch((*s_matrice).type)
|
switch((*s_matrice).type) |
| {
|
{ |
| case 'I' :
|
case 'I' : |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == 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(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_f77)[k++] = ((integer8 **)
|
((real8 *) matrice_f77)[k++] = ((integer8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot * |
| sizeof(integer4))) == NULL)
|
sizeof(integer4))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| dimension_vecteur_pivot, 'R')) < 0)
|
dimension_vecteur_pivot, 'R')) < 0) |
| {
|
{ |
| return;
|
return; |
| }
|
} |
|
|
|
| if (rang < nombre_lignes_a)
|
if (rang < nombre_lignes_a) |
| {
|
{ |
| (*((real8 *) valeur)) = 0;
|
(*((real8 *) valeur)) = 0; |
| }
|
} |
| else
|
else |
| {
|
{ |
| if ((vecteur_reel = malloc((*s_matrice).nombre_colonnes *
|
if ((vecteur_reel = malloc((*s_matrice).nombre_colonnes * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| signe = 1;
|
signe = 1; |
|
|
|
| for(i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| if ((unsigned long) pivot[i] != (i + 1))
|
if ((unsigned long) pivot[i] != (i + 1)) |
| {
|
{ |
| signe = (signe == 1) ? -1 : 1;
|
signe = (signe == 1) ? -1 : 1; |
| }
|
} |
|
|
|
| vecteur_reel[i] = ((real8 *) matrice_f77)
|
vecteur_reel[i] = ((real8 *) matrice_f77) |
| [(i * nombre_colonnes_a) + i];
|
[(i * nombre_colonnes_a) + i]; |
| }
|
} |
|
|
|
| for(i = 1; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 1; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| vecteur_reel[0] *= vecteur_reel[i];
|
vecteur_reel[0] *= vecteur_reel[i]; |
| }
|
} |
|
|
|
| (*((real8 *) valeur)) = vecteur_reel[0] * signe;
|
(*((real8 *) valeur)) = vecteur_reel[0] * signe; |
|
|
|
| free(vecteur_reel);
|
free(vecteur_reel); |
| }
|
} |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| free(pivot);
|
free(pivot); |
|
|
|
| break;
|
break; |
| }
|
} |
|
|
|
| case 'R' :
|
case 'R' : |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == 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(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_f77)[k++] = ((real8 **)
|
((real8 *) matrice_f77)[k++] = ((real8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot * |
| sizeof(integer4))) == NULL)
|
sizeof(integer4))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| dimension_vecteur_pivot, 'R')) < 0)
|
dimension_vecteur_pivot, 'R')) < 0) |
| {
|
{ |
| return;
|
return; |
| }
|
} |
|
|
|
| if (rang < nombre_lignes_a)
|
if (rang < nombre_lignes_a) |
| {
|
{ |
| (*((real8 *) valeur)) = 0;
|
(*((real8 *) valeur)) = 0; |
| }
|
} |
| else
|
else |
| {
|
{ |
| if ((vecteur_reel = malloc((*s_matrice).nombre_colonnes *
|
if ((vecteur_reel = malloc((*s_matrice).nombre_colonnes * |
| sizeof(real8))) == NULL)
|
sizeof(real8))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| signe = 1;
|
signe = 1; |
|
|
|
| for(i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| if ((unsigned long) pivot[i] != (i + 1))
|
if ((unsigned long) pivot[i] != (i + 1)) |
| {
|
{ |
| signe = (signe == 1) ? -1 : 1;
|
signe = (signe == 1) ? -1 : 1; |
| }
|
} |
|
|
|
| vecteur_reel[i] = ((real8 *) matrice_f77)
|
vecteur_reel[i] = ((real8 *) matrice_f77) |
| [(i * nombre_colonnes_a) + i];
|
[(i * nombre_colonnes_a) + i]; |
| }
|
} |
|
|
|
| for(i = 1; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 1; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| vecteur_reel[0] *= vecteur_reel[i];
|
vecteur_reel[0] *= vecteur_reel[i]; |
| }
|
} |
|
|
|
| (*((real8 *) valeur)) = vecteur_reel[0] * signe;
|
(*((real8 *) valeur)) = vecteur_reel[0] * signe; |
|
|
|
| free(vecteur_reel);
|
free(vecteur_reel); |
| }
|
} |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| free(pivot);
|
free(pivot); |
|
|
|
| break;
|
break; |
| }
|
} |
|
|
|
| case 'C' :
|
case 'C' : |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 *) matrice_f77)[k++] = ((complex16 **)
|
((complex16 *) matrice_f77)[k++] = ((complex16 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot * |
| sizeof(integer4))) == NULL)
|
sizeof(integer4))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| dimension_vecteur_pivot, 'C')) < 0)
|
dimension_vecteur_pivot, 'C')) < 0) |
| {
|
{ |
| return;
|
return; |
| }
|
} |
|
|
|
| if (rang < nombre_lignes_a)
|
if (rang < nombre_lignes_a) |
| {
|
{ |
| (*((complex16 *) valeur)).partie_reelle = 0;
|
(*((complex16 *) valeur)).partie_reelle = 0; |
| (*((complex16 *) valeur)).partie_imaginaire = 0;
|
(*((complex16 *) valeur)).partie_imaginaire = 0; |
| }
|
} |
| else
|
else |
| {
|
{ |
| if ((vecteur_complexe = malloc((*s_matrice).nombre_colonnes *
|
if ((vecteur_complexe = malloc((*s_matrice).nombre_colonnes * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
| d_es_allocation_memoire;
|
d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| signe = 1;
|
signe = 1; |
|
|
|
| for(i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| if ((unsigned long) pivot[i] != (i + 1))
|
if ((unsigned long) pivot[i] != (i + 1)) |
| {
|
{ |
| signe = (signe == 1) ? -1 : 1;
|
signe = (signe == 1) ? -1 : 1; |
| }
|
} |
|
|
|
| vecteur_complexe[i] = ((complex16 *) matrice_f77)
|
vecteur_complexe[i] = ((complex16 *) matrice_f77) |
| [(i * nombre_colonnes_a) + i];
|
[(i * nombre_colonnes_a) + i]; |
| }
|
} |
|
|
|
| for(i = 1; i < (*s_matrice).nombre_colonnes; i++)
|
for(i = 1; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| f77multiplicationcc_(&(vecteur_complexe[0]),
|
f77multiplicationcc_(&(vecteur_complexe[0]), |
| &(vecteur_complexe[i]), &(vecteur_complexe[0]));
|
&(vecteur_complexe[i]), &(vecteur_complexe[0])); |
| }
|
} |
|
|
|
| f77multiplicationci_(&(vecteur_complexe[0]), &signe,
|
f77multiplicationci_(&(vecteur_complexe[0]), &signe, |
| ((complex16 *) valeur));
|
((complex16 *) valeur)); |
|
|
|
| free(vecteur_complexe);
|
free(vecteur_complexe); |
| }
|
} |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| free(pivot);
|
free(pivot); |
|
|
|
| break;
|
break; |
| }
|
} |
| }
|
} |
|
|
|
| return;
|
return; |
| }
|
} |
|
|
|
|
|
|
| void
|
void |
| rang(struct_processus *s_etat_processus, struct_matrice *s_matrice,
|
rang(struct_processus *s_etat_processus, struct_matrice *s_matrice, |
| integer8 *valeur)
|
integer8 *valeur) |
| {
|
{ |
| integer4 dimension_vecteur_pivot;
|
integer4 dimension_vecteur_pivot; |
| integer4 nombre_lignes_a;
|
integer4 nombre_lignes_a; |
| integer4 nombre_colonnes_a;
|
integer4 nombre_colonnes_a; |
| integer4 *pivot;
|
integer4 *pivot; |
| integer4 rang;
|
integer4 rang; |
| integer4 taille_matrice_f77;
|
integer4 taille_matrice_f77; |
|
|
|
| unsigned long i;
|
unsigned long i; |
| unsigned long j;
|
unsigned long j; |
| unsigned long k;
|
unsigned long k; |
|
|
|
| void *matrice_f77;
|
void *matrice_f77; |
|
|
|
| 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; |
| dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a)
|
dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a) |
| ? nombre_lignes_a : nombre_colonnes_a;
|
? nombre_lignes_a : nombre_colonnes_a; |
| taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
|
taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a; |
|
|
|
| if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
|
if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot * |
| sizeof(integer4))) == NULL)
|
sizeof(integer4))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| switch((*s_matrice).type)
|
switch((*s_matrice).type) |
| {
|
{ |
| case 'I' :
|
case 'I' : |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == 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(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_f77)[k++] = ((integer8 **)
|
((real8 *) matrice_f77)[k++] = ((integer8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| dimension_vecteur_pivot, 'R')) < 0)
|
dimension_vecteur_pivot, 'R')) < 0) |
| {
|
{ |
| free(pivot);
|
free(pivot); |
| free(matrice_f77);
|
free(matrice_f77); |
| return;
|
return; |
| }
|
} |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| (*valeur) = rang;
|
(*valeur) = rang; |
| break;
|
break; |
| }
|
} |
|
|
|
| case 'R' :
|
case 'R' : |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(real8))) == 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(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((real8 *) matrice_f77)[k++] = ((real8 **)
|
((real8 *) matrice_f77)[k++] = ((real8 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| dimension_vecteur_pivot, 'R')) < 0)
|
dimension_vecteur_pivot, 'R')) < 0) |
| {
|
{ |
| free(pivot);
|
free(pivot); |
| free(matrice_f77);
|
free(matrice_f77); |
| return;
|
return; |
| }
|
} |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| (*valeur) = rang;
|
(*valeur) = rang; |
| break;
|
break; |
| }
|
} |
|
|
|
| case 'C' :
|
case 'C' : |
| {
|
{ |
| if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
|
if ((matrice_f77 = (void *) malloc(taille_matrice_f77 * |
| sizeof(complex16))) == NULL)
|
sizeof(complex16))) == NULL) |
| {
|
{ |
| (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
| return;
|
return; |
| }
|
} |
|
|
|
| for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++) |
| {
|
{ |
| for(j = 0; j < (*s_matrice).nombre_lignes; j++)
|
for(j = 0; j < (*s_matrice).nombre_lignes; j++) |
| {
|
{ |
| ((complex16 *) matrice_f77)[k++] = ((complex16 **)
|
((complex16 *) matrice_f77)[k++] = ((complex16 **) |
| (*s_matrice).tableau)[j][i];
|
(*s_matrice).tableau)[j][i]; |
| }
|
} |
| }
|
} |
|
|
|
| if ((rang = calcul_rang(s_etat_processus, matrice_f77,
|
if ((rang = calcul_rang(s_etat_processus, matrice_f77, |
| nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
| dimension_vecteur_pivot, 'C')) < 0)
|
dimension_vecteur_pivot, 'C')) < 0) |
| {
|
{ |
| free(pivot);
|
free(pivot); |
| free(matrice_f77);
|
free(matrice_f77); |
| return;
|
return; |
| }
|
} |
|
|
|
| free(matrice_f77);
|
free(matrice_f77); |
| (*valeur) = rang;
|
(*valeur) = rang; |
| break;
|
break; |
| }
|
} |
| }
|
} |
|
|
|
| free(pivot);
|
free(pivot); |
|
|
|
| return;
|
return; |
| }
|
} |
|
|
|
| // vim: ts=4
|
// 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