version 1.1.1.1, 2010/01/26 15:22:45
|
version 1.17, 2011/03/06 16:44:07
|
Line 1
|
Line 1
|
/* |
/* |
================================================================================ |
================================================================================ |
RPL/2 (R) version 4.0.9 |
RPL/2 (R) version 4.0.21 |
Copyright (C) 1989-2010 Dr. BERTRAND Joël |
Copyright (C) 1989-2011 Dr. BERTRAND Joël |
|
|
This file is part of RPL/2. |
This file is part of RPL/2. |
|
|
Line 20
|
Line 20
|
*/ |
*/ |
|
|
|
|
#include "rpl.conv.h" |
#include "rpl-conv.h"
|
|
|
|
|
/* |
/*
|
================================================================================ |
================================================================================
|
Fonction calculant le nombre de condition d'une matrice |
Fonction calculant le nombre de condition d'une matrice
|
================================================================================ |
================================================================================
|
Entrées : struct_matrice |
Entrées : struct_matrice
|
-------------------------------------------------------------------------------- |
--------------------------------------------------------------------------------
|
Sorties : nombre de condition de la matrice |
Sorties : nombre de condition de la matrice
|
-------------------------------------------------------------------------------- |
--------------------------------------------------------------------------------
|
Effets de bord : néant |
Effets de bord : néant
|
================================================================================ |
================================================================================
|
*/ |
*/
|
|
|
static integer4 |
static integer4
|
calcul_cond(struct_processus *s_etat_processus, void *matrice_f77, |
calcul_cond(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, |
integer4 *pivot, unsigned char type, real8 *cond)
|
unsigned char type, real8 *cond) |
{
|
{ |
integer4 erreur;
|
integer4 erreur; |
integer4 *iwork;
|
integer4 *iwork; |
integer4 longueur;
|
integer4 longueur; |
integer4 ordre;
|
integer4 ordre; |
|
|
real8 anorme;
|
real8 anorme; |
real8 rcond;
|
real8 rcond; |
real8 *rwork;
|
real8 *rwork; |
|
|
unsigned char norme;
|
unsigned char norme; |
|
|
void *work;
|
void *work; |
|
|
norme = '1';
|
norme = '1'; |
longueur = 1;
|
longueur = 1; |
|
|
if (type == 'R')
|
if (type == 'R') |
{
|
{ |
// work est NULL dans le cas de la norme '1'
|
// work est NULL dans le cas de la norme '1' |
anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
|
anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, NULL, longueur);
|
matrice_f77, &nombre_lignes_a, NULL, longueur); |
|
|
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); |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
// work est NULL dans le cas de la norme '1'
|
// work est NULL dans le cas de la norme '1' |
anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
|
anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, NULL, longueur);
|
matrice_f77, &nombre_lignes_a, NULL, longueur); |
|
|
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); |
free(rwork);
|
free(rwork); |
|
|
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); |
}
|
} |
}
|
} |
|
|
(*cond) = ((real8) 1 / rcond);
|
(*cond) = ((real8) 1 / rcond); |
return(0);
|
return(0); |
}
|
} |
|
|
|
|
void
|
void |
cond(struct_processus *s_etat_processus,
|
cond(struct_processus *s_etat_processus, |
struct_matrice *s_matrice, real8 *condition)
|
struct_matrice *s_matrice, real8 *condition) |
{
|
{ |
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; |
|
|
real8 cond;
|
real8 cond; |
|
|
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_cond(s_etat_processus, matrice_f77,
|
if ((rang = calcul_cond(s_etat_processus, matrice_f77, |
nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
'R', &cond)) < 0)
|
dimension_vecteur_pivot, 'R', &cond)) < 0) |
{
|
{ |
free(pivot);
|
free(pivot); |
free(matrice_f77);
|
free(matrice_f77); |
return;
|
return; |
}
|
} |
|
|
free(matrice_f77);
|
free(matrice_f77); |
(*condition) = cond;
|
(*condition) = cond; |
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_cond(s_etat_processus, matrice_f77,
|
if ((rang = calcul_cond(s_etat_processus, matrice_f77, |
nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
'R', &cond)) < 0)
|
dimension_vecteur_pivot, 'R', &cond)) < 0) |
{
|
{ |
free(pivot);
|
free(pivot); |
free(matrice_f77);
|
free(matrice_f77); |
return;
|
return; |
}
|
} |
|
|
free(matrice_f77);
|
free(matrice_f77); |
(*condition) = cond;
|
(*condition) = cond; |
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_cond(s_etat_processus, matrice_f77,
|
if ((rang = calcul_cond(s_etat_processus, matrice_f77, |
nombre_lignes_a, nombre_colonnes_a, pivot,
|
nombre_lignes_a, nombre_colonnes_a, pivot, |
'C', &cond)) < 0)
|
dimension_vecteur_pivot, 'C', &cond)) < 0) |
{
|
{ |
free(pivot);
|
free(pivot); |
free(matrice_f77);
|
free(matrice_f77); |
return;
|
return; |
}
|
} |
|
|
free(matrice_f77);
|
free(matrice_f77); |
(*condition) = cond;
|
(*condition) = cond; |
break;
|
break; |
}
|
} |
}
|
} |
|
|
free(pivot);
|
free(pivot); |
|
|
return;
|
return; |
}
|
} |
|
|
|
|
/*
|
/* |
================================================================================
|
================================================================================ |
Fonction effectuant une décomposition en valeurs singulières
|
Fonction effectuant une décomposition en valeurs singulières |
================================================================================
|
================================================================================ |
Entrées : struct_matrice
|
Entrées : struct_matrice |
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
Sorties : valeurs singulières dans le vecteur S. Si les pointeurs sur U
|
Sorties : valeurs singulières dans le vecteur S. Si les pointeurs sur U |
et VH ne sont pas nul, les matrices U et VH sont aussi calculées.
|
et VH ne sont pas nul, les matrices U et VH sont aussi calculées. |
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------- |
Effets de bord : néant
|
Effets de bord : néant |
================================================================================
|
================================================================================ |
*/
|
*/ |
|
|
void valeurs_singulieres(struct_processus *s_etat_processus,
|
void valeurs_singulieres(struct_processus *s_etat_processus, |
struct_matrice *s_matrice, struct_matrice *matrice_u,
|
struct_matrice *s_matrice, struct_matrice *matrice_u, |
struct_vecteur *vecteur_s, struct_matrice *matrice_vh)
|
struct_vecteur *vecteur_s, struct_matrice *matrice_vh) |
{
|
{ |
integer4 erreur;
|
integer4 erreur; |
integer4 longueur;
|
integer4 longueur; |
integer4 lwork;
|
integer4 lwork; |
integer4 nombre_colonnes_a;
|
integer4 nombre_colonnes_a; |
integer4 nombre_lignes_a;
|
integer4 nombre_lignes_a; |
integer4 nombre_valeurs_singulieres;
|
integer4 nombre_valeurs_singulieres; |
integer4 taille_matrice_f77;
|
integer4 taille_matrice_f77; |
|
|
real8 *rwork;
|
real8 *rwork; |
|
|
unsigned char jobu;
|
unsigned char jobu; |
unsigned char jobvh;
|
unsigned char jobvh; |
|
|
unsigned long i;
|
unsigned long i; |
unsigned long j;
|
unsigned long j; |
unsigned long k;
|
unsigned long k; |
|
|
void *matrice_f77;
|
void *matrice_f77; |
void *matrice_f77_u;
|
void *matrice_f77_u; |
void *matrice_f77_vh;
|
void *matrice_f77_vh; |
void *vecteur_f77_s;
|
void *vecteur_f77_s; |
void *work;
|
void *work; |
|
|
longueur = 1;
|
longueur = 1; |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
jobu = 'A';
|
jobu = 'A'; |
}
|
} |
else
|
else |
{
|
{ |
jobu = 'N';
|
jobu = 'N'; |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
jobvh = 'A';
|
jobvh = 'A'; |
}
|
} |
else
|
else |
{
|
{ |
jobvh = 'N';
|
jobvh = 'N'; |
}
|
} |
|
|
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; |
nombre_valeurs_singulieres = (nombre_lignes_a < nombre_colonnes_a)
|
nombre_valeurs_singulieres = (nombre_lignes_a < nombre_colonnes_a) |
? nombre_lignes_a : nombre_colonnes_a;
|
? 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]; |
}
|
} |
}
|
} |
|
|
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; |
}
|
} |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a *
|
if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a * |
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; |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
matrice_f77_u = NULL;
|
matrice_f77_u = NULL; |
}
|
} |
|
|
if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres *
|
if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres * |
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; |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
if ((matrice_f77_vh = malloc(nombre_colonnes_a
|
if ((matrice_f77_vh = malloc(nombre_colonnes_a |
* nombre_colonnes_a * sizeof(real8))) == NULL)
|
* 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; |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
matrice_f77_vh = NULL;
|
matrice_f77_vh = NULL; |
}
|
} |
|
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, vecteur_f77_s,
|
matrice_f77, &nombre_lignes_a, vecteur_f77_s, |
matrice_f77_u, &nombre_lignes_a,
|
matrice_f77_u, &nombre_lignes_a, |
matrice_f77_vh, &nombre_colonnes_a,
|
matrice_f77_vh, &nombre_colonnes_a, |
work, &lwork, &erreur, longueur, longueur);
|
work, &lwork, &erreur, longueur, longueur); |
|
|
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; |
}
|
} |
|
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, vecteur_f77_s,
|
matrice_f77, &nombre_lignes_a, vecteur_f77_s, |
matrice_f77_u, &nombre_lignes_a,
|
matrice_f77_u, &nombre_lignes_a, |
matrice_f77_vh, &nombre_colonnes_a,
|
matrice_f77_vh, &nombre_colonnes_a, |
work, &lwork, &erreur, longueur, longueur);
|
work, &lwork, &erreur, longueur, longueur); |
|
|
free(work);
|
free(work); |
free(matrice_f77);
|
free(matrice_f77); |
|
|
if (erreur != 0)
|
if (erreur != 0) |
{
|
{ |
if (erreur > 0)
|
if (erreur > 0) |
{
|
{ |
(*s_etat_processus).exception = d_ep_decomposition_SVD;
|
(*s_etat_processus).exception = d_ep_decomposition_SVD; |
}
|
} |
else
|
else |
{
|
{ |
(*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
}
|
} |
|
|
free(matrice_f77_u);
|
free(matrice_f77_u); |
free(matrice_f77_vh);
|
free(matrice_f77_vh); |
free(vecteur_f77_s);
|
free(vecteur_f77_s); |
return;
|
return; |
}
|
} |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
(*matrice_u).nombre_lignes = nombre_lignes_a;
|
(*matrice_u).nombre_lignes = nombre_lignes_a; |
(*matrice_u).nombre_colonnes = nombre_lignes_a;
|
(*matrice_u).nombre_colonnes = nombre_lignes_a; |
|
|
if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes *
|
if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes * |
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(i = 0; i < (*matrice_u).nombre_lignes; i++)
|
for(i = 0; i < (*matrice_u).nombre_lignes; i++) |
{
|
{ |
if ((((real8 **) (*matrice_u).tableau)[i] =
|
if ((((real8 **) (*matrice_u).tableau)[i] = |
malloc((*matrice_u).nombre_colonnes *
|
malloc((*matrice_u).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 < (*matrice_u).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*matrice_u).nombre_colonnes; i++) |
{
|
{ |
for(j = 0; j < (*matrice_u).nombre_lignes; j++)
|
for(j = 0; j < (*matrice_u).nombre_lignes; j++) |
{
|
{ |
((real8 **) (*matrice_u).tableau)[j][i] =
|
((real8 **) (*matrice_u).tableau)[j][i] = |
((real8 *) matrice_f77_u)[k++];
|
((real8 *) matrice_f77_u)[k++]; |
}
|
} |
}
|
} |
|
|
free(matrice_f77_u);
|
free(matrice_f77_u); |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
(*matrice_vh).nombre_lignes = nombre_colonnes_a;
|
(*matrice_vh).nombre_lignes = nombre_colonnes_a; |
(*matrice_vh).nombre_colonnes = nombre_colonnes_a;
|
(*matrice_vh).nombre_colonnes = nombre_colonnes_a; |
|
|
if (((*matrice_vh).tableau = malloc((*matrice_vh)
|
if (((*matrice_vh).tableau = malloc((*matrice_vh) |
.nombre_lignes * sizeof(real8 *))) == NULL)
|
.nombre_lignes * sizeof(real8 *))) == NULL) |
{
|
{ |
(*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
d_es_allocation_memoire;
|
d_es_allocation_memoire; |
return;
|
return; |
}
|
} |
|
|
for(i = 0; i < (*matrice_vh).nombre_lignes; i++)
|
for(i = 0; i < (*matrice_vh).nombre_lignes; i++) |
{
|
{ |
if ((((real8 **) (*matrice_vh).tableau)[i] =
|
if ((((real8 **) (*matrice_vh).tableau)[i] = |
malloc((*matrice_vh).nombre_colonnes *
|
malloc((*matrice_vh).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 < (*matrice_vh).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*matrice_vh).nombre_colonnes; i++) |
{
|
{ |
for(j = 0; j < (*matrice_vh).nombre_lignes; j++)
|
for(j = 0; j < (*matrice_vh).nombre_lignes; j++) |
{
|
{ |
((real8 **) (*matrice_vh).tableau)[j][i] =
|
((real8 **) (*matrice_vh).tableau)[j][i] = |
((real8 *) matrice_f77_vh)[k++];
|
((real8 *) matrice_f77_vh)[k++]; |
}
|
} |
}
|
} |
|
|
free(matrice_f77_vh);
|
free(matrice_f77_vh); |
}
|
} |
|
|
(*vecteur_s).taille = nombre_valeurs_singulieres;
|
(*vecteur_s).taille = nombre_valeurs_singulieres; |
(*vecteur_s).type = 'R';
|
(*vecteur_s).type = 'R'; |
(*vecteur_s).tableau = vecteur_f77_s;
|
(*vecteur_s).tableau = vecteur_f77_s; |
|
|
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]; |
}
|
} |
}
|
} |
|
|
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; |
}
|
} |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a *
|
if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a * |
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; |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
matrice_f77_u = NULL;
|
matrice_f77_u = NULL; |
}
|
} |
|
|
if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres *
|
if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres * |
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; |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
if ((matrice_f77_vh = malloc(nombre_colonnes_a
|
if ((matrice_f77_vh = malloc(nombre_colonnes_a |
* nombre_colonnes_a * sizeof(real8))) == NULL)
|
* 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; |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
matrice_f77_vh = NULL;
|
matrice_f77_vh = NULL; |
}
|
} |
|
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, vecteur_f77_s,
|
matrice_f77, &nombre_lignes_a, vecteur_f77_s, |
matrice_f77_u, &nombre_lignes_a,
|
matrice_f77_u, &nombre_lignes_a, |
matrice_f77_vh, &nombre_colonnes_a,
|
matrice_f77_vh, &nombre_colonnes_a, |
work, &lwork, &erreur, longueur, longueur);
|
work, &lwork, &erreur, longueur, longueur); |
|
|
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; |
}
|
} |
|
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
|
dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, vecteur_f77_s,
|
matrice_f77, &nombre_lignes_a, vecteur_f77_s, |
matrice_f77_u, &nombre_lignes_a,
|
matrice_f77_u, &nombre_lignes_a, |
matrice_f77_vh, &nombre_colonnes_a,
|
matrice_f77_vh, &nombre_colonnes_a, |
work, &lwork, &erreur, longueur, longueur);
|
work, &lwork, &erreur, longueur, longueur); |
|
|
free(work);
|
free(work); |
free(matrice_f77);
|
free(matrice_f77); |
|
|
if (erreur != 0)
|
if (erreur != 0) |
{
|
{ |
if (erreur > 0)
|
if (erreur > 0) |
{
|
{ |
(*s_etat_processus).exception = d_ep_decomposition_SVD;
|
(*s_etat_processus).exception = d_ep_decomposition_SVD; |
}
|
} |
else
|
else |
{
|
{ |
(*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
}
|
} |
|
|
free(matrice_f77_u);
|
free(matrice_f77_u); |
free(matrice_f77_vh);
|
free(matrice_f77_vh); |
free(vecteur_f77_s);
|
free(vecteur_f77_s); |
return;
|
return; |
}
|
} |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
(*matrice_u).nombre_lignes = nombre_lignes_a;
|
(*matrice_u).nombre_lignes = nombre_lignes_a; |
(*matrice_u).nombre_colonnes = nombre_lignes_a;
|
(*matrice_u).nombre_colonnes = nombre_lignes_a; |
|
|
if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes *
|
if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes * |
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(i = 0; i < (*matrice_u).nombre_lignes; i++)
|
for(i = 0; i < (*matrice_u).nombre_lignes; i++) |
{
|
{ |
if ((((real8 **) (*matrice_u).tableau)[i] =
|
if ((((real8 **) (*matrice_u).tableau)[i] = |
malloc((*matrice_u).nombre_colonnes *
|
malloc((*matrice_u).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 < (*matrice_u).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*matrice_u).nombre_colonnes; i++) |
{
|
{ |
for(j = 0; j < (*matrice_u).nombre_lignes; j++)
|
for(j = 0; j < (*matrice_u).nombre_lignes; j++) |
{
|
{ |
((real8 **) (*matrice_u).tableau)[j][i] =
|
((real8 **) (*matrice_u).tableau)[j][i] = |
((real8 *) matrice_f77_u)[k++];
|
((real8 *) matrice_f77_u)[k++]; |
}
|
} |
}
|
} |
|
|
free(matrice_f77_u);
|
free(matrice_f77_u); |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
(*matrice_vh).nombre_lignes = nombre_colonnes_a;
|
(*matrice_vh).nombre_lignes = nombre_colonnes_a; |
(*matrice_vh).nombre_colonnes = nombre_colonnes_a;
|
(*matrice_vh).nombre_colonnes = nombre_colonnes_a; |
|
|
if (((*matrice_vh).tableau = malloc((*matrice_vh)
|
if (((*matrice_vh).tableau = malloc((*matrice_vh) |
.nombre_lignes * sizeof(real8 *))) == NULL)
|
.nombre_lignes * sizeof(real8 *))) == NULL) |
{
|
{ |
(*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
d_es_allocation_memoire;
|
d_es_allocation_memoire; |
return;
|
return; |
}
|
} |
|
|
for(i = 0; i < (*matrice_vh).nombre_lignes; i++)
|
for(i = 0; i < (*matrice_vh).nombre_lignes; i++) |
{
|
{ |
if ((((real8 **) (*matrice_vh).tableau)[i] =
|
if ((((real8 **) (*matrice_vh).tableau)[i] = |
malloc((*matrice_vh).nombre_colonnes *
|
malloc((*matrice_vh).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 < (*matrice_vh).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*matrice_vh).nombre_colonnes; i++) |
{
|
{ |
for(j = 0; j < (*matrice_vh).nombre_lignes; j++)
|
for(j = 0; j < (*matrice_vh).nombre_lignes; j++) |
{
|
{ |
((real8 **) (*matrice_vh).tableau)[j][i] =
|
((real8 **) (*matrice_vh).tableau)[j][i] = |
((real8 *) matrice_f77_vh)[k++];
|
((real8 *) matrice_f77_vh)[k++]; |
}
|
} |
}
|
} |
|
|
free(matrice_f77_vh);
|
free(matrice_f77_vh); |
}
|
} |
|
|
(*vecteur_s).taille = nombre_valeurs_singulieres;
|
(*vecteur_s).taille = nombre_valeurs_singulieres; |
(*vecteur_s).type = 'R';
|
(*vecteur_s).type = 'R'; |
(*vecteur_s).tableau = vecteur_f77_s;
|
(*vecteur_s).tableau = vecteur_f77_s; |
|
|
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]; |
}
|
} |
}
|
} |
|
|
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; |
}
|
} |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a *
|
if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a * |
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; |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
matrice_f77_u = NULL;
|
matrice_f77_u = NULL; |
}
|
} |
|
|
if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres *
|
if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres * |
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; |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
if ((matrice_f77_vh = malloc(nombre_colonnes_a
|
if ((matrice_f77_vh = malloc(nombre_colonnes_a |
* nombre_colonnes_a * sizeof(complex16))) == NULL)
|
* nombre_colonnes_a * sizeof(complex16))) == NULL) |
{
|
{ |
(*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
d_es_allocation_memoire;
|
d_es_allocation_memoire; |
return;
|
return; |
}
|
} |
}
|
} |
else
|
else |
{
|
{ |
matrice_f77_vh = NULL;
|
matrice_f77_vh = NULL; |
}
|
} |
|
|
if ((rwork = malloc(5 * nombre_valeurs_singulieres * sizeof(real8)))
|
if ((rwork = malloc(5 * nombre_valeurs_singulieres * sizeof(real8))) |
== NULL)
|
== NULL) |
{
|
{ |
(*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
d_es_allocation_memoire;
|
d_es_allocation_memoire; |
return;
|
return; |
}
|
} |
|
|
zgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
|
zgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, vecteur_f77_s,
|
matrice_f77, &nombre_lignes_a, vecteur_f77_s, |
matrice_f77_u, &nombre_lignes_a,
|
matrice_f77_u, &nombre_lignes_a, |
matrice_f77_vh, &nombre_colonnes_a,
|
matrice_f77_vh, &nombre_colonnes_a, |
work, &lwork, rwork, &erreur, longueur, longueur);
|
work, &lwork, rwork, &erreur, longueur, longueur); |
|
|
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; |
}
|
} |
|
|
zgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
|
zgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a, |
matrice_f77, &nombre_lignes_a, vecteur_f77_s,
|
matrice_f77, &nombre_lignes_a, vecteur_f77_s, |
matrice_f77_u, &nombre_lignes_a,
|
matrice_f77_u, &nombre_lignes_a, |
matrice_f77_vh, &nombre_colonnes_a,
|
matrice_f77_vh, &nombre_colonnes_a, |
work, &lwork, rwork, &erreur, longueur, longueur);
|
work, &lwork, rwork, &erreur, longueur, longueur); |
|
|
free(work);
|
free(work); |
free(rwork);
|
free(rwork); |
free(matrice_f77);
|
free(matrice_f77); |
|
|
if (erreur != 0)
|
if (erreur != 0) |
{
|
{ |
if (erreur > 0)
|
if (erreur > 0) |
{
|
{ |
(*s_etat_processus).exception = d_ep_decomposition_SVD;
|
(*s_etat_processus).exception = d_ep_decomposition_SVD; |
}
|
} |
else
|
else |
{
|
{ |
(*s_etat_processus).erreur_execution =
|
(*s_etat_processus).erreur_execution = |
d_ex_routines_mathematiques;
|
d_ex_routines_mathematiques; |
}
|
} |
|
|
free(matrice_f77_u);
|
free(matrice_f77_u); |
free(matrice_f77_vh);
|
free(matrice_f77_vh); |
free(vecteur_f77_s);
|
free(vecteur_f77_s); |
return;
|
return; |
}
|
} |
|
|
if (matrice_u != NULL)
|
if (matrice_u != NULL) |
{
|
{ |
(*matrice_u).nombre_lignes = nombre_lignes_a;
|
(*matrice_u).nombre_lignes = nombre_lignes_a; |
(*matrice_u).nombre_colonnes = nombre_lignes_a;
|
(*matrice_u).nombre_colonnes = nombre_lignes_a; |
|
|
if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes *
|
if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes * |
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(i = 0; i < (*matrice_u).nombre_lignes; i++)
|
for(i = 0; i < (*matrice_u).nombre_lignes; i++) |
{
|
{ |
if ((((complex16 **) (*matrice_u).tableau)[i] =
|
if ((((complex16 **) (*matrice_u).tableau)[i] = |
malloc((*matrice_u).nombre_colonnes *
|
malloc((*matrice_u).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 < (*matrice_u).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*matrice_u).nombre_colonnes; i++) |
{
|
{ |
for(j = 0; j < (*matrice_u).nombre_lignes; j++)
|
for(j = 0; j < (*matrice_u).nombre_lignes; j++) |
{
|
{ |
((complex16 **) (*matrice_u).tableau)[j][i] =
|
((complex16 **) (*matrice_u).tableau)[j][i] = |
((complex16 *) matrice_f77_u)[k++];
|
((complex16 *) matrice_f77_u)[k++]; |
}
|
} |
}
|
} |
|
|
free(matrice_f77_u);
|
free(matrice_f77_u); |
}
|
} |
|
|
if (matrice_vh != NULL)
|
if (matrice_vh != NULL) |
{
|
{ |
(*matrice_vh).nombre_lignes = nombre_colonnes_a;
|
(*matrice_vh).nombre_lignes = nombre_colonnes_a; |
(*matrice_vh).nombre_colonnes = nombre_colonnes_a;
|
(*matrice_vh).nombre_colonnes = nombre_colonnes_a; |
|
|
if (((*matrice_vh).tableau = malloc((*matrice_vh)
|
if (((*matrice_vh).tableau = malloc((*matrice_vh) |
.nombre_lignes * sizeof(complex16 *))) == NULL)
|
.nombre_lignes * sizeof(complex16 *))) == NULL) |
{
|
{ |
(*s_etat_processus).erreur_systeme =
|
(*s_etat_processus).erreur_systeme = |
d_es_allocation_memoire;
|
d_es_allocation_memoire; |
return;
|
return; |
}
|
} |
|
|
for(i = 0; i < (*matrice_vh).nombre_lignes; i++)
|
for(i = 0; i < (*matrice_vh).nombre_lignes; i++) |
{
|
{ |
if ((((complex16 **) (*matrice_vh).tableau)[i] =
|
if ((((complex16 **) (*matrice_vh).tableau)[i] = |
malloc((*matrice_vh).nombre_colonnes *
|
malloc((*matrice_vh).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 < (*matrice_vh).nombre_colonnes; i++)
|
for(k = 0, i = 0; i < (*matrice_vh).nombre_colonnes; i++) |
{
|
{ |
for(j = 0; j < (*matrice_vh).nombre_lignes; j++)
|
for(j = 0; j < (*matrice_vh).nombre_lignes; j++) |
{
|
{ |
((complex16 **) (*matrice_vh).tableau)[j][i] =
|
((complex16 **) (*matrice_vh).tableau)[j][i] = |
((complex16 *) matrice_f77_vh)[k++];
|
((complex16 *) matrice_f77_vh)[k++]; |
}
|
} |
}
|
} |
|
|
free(matrice_f77_vh);
|
free(matrice_f77_vh); |
}
|
} |
|
|
(*vecteur_s).taille = nombre_valeurs_singulieres;
|
(*vecteur_s).taille = nombre_valeurs_singulieres; |
(*vecteur_s).type = 'R';
|
(*vecteur_s).type = 'R'; |
(*vecteur_s).tableau = vecteur_f77_s;
|
(*vecteur_s).tableau = vecteur_f77_s; |
|
|
break;
|
break; |
}
|
} |
}
|
} |
|
|
return;
|
return; |
}
|
} |
|
|
// vim: ts=4
|
// vim: ts=4 |
|