rpl/src/algebre_lineaire4.c - diff

Return to algebre_lineaire4.c CVS log

Up to [local] / rpl / src

Diff for /rpl/src/algebre_lineaire4.c between versions 1.11 and 1.12

-version 1.11, 2010/07/14 14:19:32
+version 1.12, 2010/08/06 15:26:43
  Line 1
  /*
  ================================================================================
    RPL/2 (R) version 4.0.18
    Copyright (C) 1989-2010 Dr. BERTRAND Joël
    This file is part of RPL/2.
    RPL/2 is free software; you can redistribute it and/or modify it
    under the terms of the CeCILL V2 License as published by the french
    CEA, CNRS and INRIA.
    RPL/2 is distributed in the hope that it will be useful, but WITHOUT
    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
    FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
    for more details.
    You should have received a copy of the CeCILL License
    along with RPL/2. If not, write to info@cecill.info.
  ================================================================================
  */
- #include "rpl.conv.h"
+ #include "rpl-conv.h"
  /*
  ================================================================================
    Fonction calculant le nombre de condition d'une matrice
  ================================================================================
    Entrées : struct_matrice
  --------------------------------------------------------------------------------
    Sorties : nombre de condition de la matrice
  --------------------------------------------------------------------------------
    Effets de bord : néant
  ================================================================================
  */
  static integer4
  calcul_cond(struct_processus *s_etat_processus, void *matrice_f77,
          integer4 nombre_lignes_a, integer4 nombre_colonnes_a,
          integer4 *pivot, unsigned char type, real8 *cond)
  {
      integer4                    erreur;
      integer4                    *iwork;
      integer4                    longueur;
      integer4                    ordre;
      real8                       anorme;
      real8                       rcond;
      real8                       *rwork;
      unsigned char               norme;
      void                        *work;
      norme = '1';
      longueur = 1;
      if (type == 'R')
      {
          // work est NULL dans le cas de la norme '1'
          anorme = dlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
                  matrice_f77, &nombre_lignes_a, NULL, longueur);
          dgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77,
                  &nombre_lignes_a, pivot, &erreur);
          if (erreur < 0)
          {
              (*s_etat_processus).erreur_execution =
                      d_ex_routines_mathematiques;
              free(matrice_f77);
              return(-1);
          }
          if ((iwork = malloc(nombre_colonnes_a * sizeof(integer4))) == NULL)
          {
              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
              return(-1);
          }
          if ((work = malloc(4 * nombre_colonnes_a * sizeof(real8))) == NULL)
          {
              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
              return(-1);
          }
          ordre = (nombre_lignes_a > nombre_colonnes_a)
                  ? nombre_colonnes_a : nombre_lignes_a;
          dgecon_(&norme, &ordre, matrice_f77,
                  &nombre_lignes_a, &anorme, &rcond, work, iwork, &erreur,
                  longueur);
          free(work);
          free(iwork);
          if (erreur < 0)
          {
              (*s_etat_processus).erreur_execution =
                      d_ex_routines_mathematiques;
              free(matrice_f77);
              return(-1);
          }
      }
      else
      {
          // work est NULL dans le cas de la norme '1'
          anorme = zlange_(&norme, &nombre_lignes_a, &nombre_colonnes_a,
                  matrice_f77, &nombre_lignes_a, NULL, longueur);
          zgetrf_(&nombre_lignes_a, &nombre_colonnes_a, matrice_f77,
                  &nombre_lignes_a, pivot, &erreur);
          if (erreur < 0)
          {
              (*s_etat_processus).erreur_execution =
                      d_ex_routines_mathematiques;
              free(matrice_f77);
              return(-1);
          }
          if ((rwork = malloc(2 * nombre_colonnes_a * sizeof(real8))) == NULL)
          {
              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
              return(-1);
          }
          if ((work = malloc(2 * nombre_colonnes_a * sizeof(complex16))) == NULL)
          {
              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
              return(-1);
          }
          ordre = (nombre_lignes_a > nombre_colonnes_a)
                  ? nombre_colonnes_a : nombre_lignes_a;
          zgecon_(&norme, &ordre, matrice_f77,
                  &nombre_lignes_a, &anorme, &rcond, work, rwork, &erreur,
                  longueur);
          free(work);
          free(rwork);
          if (erreur < 0)
          {
              (*s_etat_processus).erreur_execution =
                      d_ex_routines_mathematiques;
              free(matrice_f77);
              return(-1);
          }
      }
      (*cond) = ((real8) 1 / rcond);
      return(0);
  }
  void
  cond(struct_processus *s_etat_processus,
          struct_matrice *s_matrice, real8 *condition)
  {
      integer4                    dimension_vecteur_pivot;
      integer4                    nombre_lignes_a;
      integer4                    nombre_colonnes_a;
      integer4                    *pivot;
      integer4                    rang;
      integer4                    taille_matrice_f77;
      real8                       cond;
      unsigned long               i;
      unsigned long               j;
      unsigned long               k;
      void                        *matrice_f77;
      nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
      nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
      dimension_vecteur_pivot = (nombre_lignes_a < nombre_colonnes_a)
              ? nombre_lignes_a : nombre_colonnes_a;
      taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
      if ((pivot = (integer4 *) malloc(dimension_vecteur_pivot *
              sizeof(integer4))) == NULL)
      {
          (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
          return;
      }
      switch((*s_matrice).type)
      {
          case 'I' :
          {
              if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
              {
                  for(j = 0; j < (*s_matrice).nombre_lignes; j++)
                  {
                      ((real8 *) matrice_f77)[k++] = ((integer8 **)
                              (*s_matrice).tableau)[j][i];
                  }
              }
              if ((rang = calcul_cond(s_etat_processus, matrice_f77,
                      nombre_lignes_a, nombre_colonnes_a, pivot,
                      'R', &cond)) < 0)
              {
                  free(pivot);
                  free(matrice_f77);
                  return;
              }
              free(matrice_f77);
              (*condition) = cond;
              break;
          }
          case 'R' :
          {
              if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
              {
                  for(j = 0; j < (*s_matrice).nombre_lignes; j++)
                  {
                      ((real8 *) matrice_f77)[k++] = ((real8 **)
                              (*s_matrice).tableau)[j][i];
                  }
              }
              if ((rang = calcul_cond(s_etat_processus, matrice_f77,
                      nombre_lignes_a, nombre_colonnes_a, pivot,
                      'R', &cond)) < 0)
              {
                  free(pivot);
                  free(matrice_f77);
                  return;
              }
              free(matrice_f77);
              (*condition) = cond;
              break;
          }
          case 'C' :
          {
              if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
                      sizeof(complex16))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
              {
                  for(j = 0; j < (*s_matrice).nombre_lignes; j++)
                  {
                      ((complex16 *) matrice_f77)[k++] = ((complex16 **)
                              (*s_matrice).tableau)[j][i];
                  }
              }
              if ((rang = calcul_cond(s_etat_processus, matrice_f77,
                      nombre_lignes_a, nombre_colonnes_a, pivot,
                      'C', &cond)) < 0)
              {
                  free(pivot);
                  free(matrice_f77);
                  return;
              }
              free(matrice_f77);
              (*condition) = cond;
              break;
          }
      }
      free(pivot);
      return;
  }
  /*
  ================================================================================
    Fonction effectuant une décomposition en valeurs singulières
  ================================================================================
    Entrées : struct_matrice
  --------------------------------------------------------------------------------
    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.
  --------------------------------------------------------------------------------
    Effets de bord : néant
  ================================================================================
  */
  void valeurs_singulieres(struct_processus *s_etat_processus,
          struct_matrice *s_matrice, struct_matrice *matrice_u,
          struct_vecteur *vecteur_s, struct_matrice *matrice_vh)
  {
      integer4                erreur;
      integer4                longueur;
      integer4                lwork;
      integer4                nombre_colonnes_a;
      integer4                nombre_lignes_a;
      integer4                nombre_valeurs_singulieres;
      integer4                taille_matrice_f77;
      real8                   *rwork;
      unsigned char           jobu;
      unsigned char           jobvh;
      unsigned long           i;
      unsigned long           j;
      unsigned long           k;
      void                    *matrice_f77;
      void                    *matrice_f77_u;
      void                    *matrice_f77_vh;
      void                    *vecteur_f77_s;
      void                    *work;
      longueur = 1;
      if (matrice_u != NULL)
      {
          jobu = 'A';
      }
      else
      {
          jobu = 'N';
      }
      if (matrice_vh != NULL)
      {
          jobvh = 'A';
      }
      else
      {
          jobvh = 'N';
      }
      nombre_lignes_a = (integer4) (*s_matrice).nombre_lignes;
      nombre_colonnes_a = (integer4) (*s_matrice).nombre_colonnes;
      taille_matrice_f77 = nombre_lignes_a * nombre_colonnes_a;
      nombre_valeurs_singulieres = (nombre_lignes_a < nombre_colonnes_a)
              ? nombre_lignes_a : nombre_colonnes_a;
      switch((*s_matrice).type)
      {
          case 'I' :
          {
              if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
              {
                  for(j = 0; j < (*s_matrice).nombre_lignes; j++)
                  {
                      ((real8 *) matrice_f77)[k++] = ((integer8 **)
                              (*s_matrice).tableau)[j][i];
                  }
              }
              lwork = -1;
              if ((work = malloc(sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              if (matrice_u != NULL)
              {
                  if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a *
                          sizeof(real8))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
              }
              else
              {
                  matrice_f77_u = NULL;
              }
              if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme =
                          d_es_allocation_memoire;
                  return;
              }
              if (matrice_vh != NULL)
              {
                  if ((matrice_f77_vh = malloc(nombre_colonnes_a
                          * nombre_colonnes_a * sizeof(real8))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
              }
              else
              {
                  matrice_f77_vh = NULL;
              }
              dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
                      matrice_f77, &nombre_lignes_a, vecteur_f77_s,
                      matrice_f77_u, &nombre_lignes_a,
                      matrice_f77_vh, &nombre_colonnes_a,
                      work, &lwork, &erreur, longueur, longueur);
              lwork = ((real8 *) work)[0];
              free(work);
              if ((work = malloc(lwork * sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
                      matrice_f77, &nombre_lignes_a, vecteur_f77_s,
                      matrice_f77_u, &nombre_lignes_a,
                      matrice_f77_vh, &nombre_colonnes_a,
                      work, &lwork, &erreur, longueur, longueur);
              free(work);
              free(matrice_f77);
              if (erreur != 0)
              {
                  if (erreur > 0)
                  {
                      (*s_etat_processus).exception = d_ep_decomposition_SVD;
                  }
                  else
                  {
                      (*s_etat_processus).erreur_execution =
                              d_ex_routines_mathematiques;
                  }
                  free(matrice_f77_u);
                  free(matrice_f77_vh);
                  free(vecteur_f77_s);
                  return;
              }
              if (matrice_u != NULL)
              {
                  (*matrice_u).nombre_lignes = nombre_lignes_a;
                  (*matrice_u).nombre_colonnes = nombre_lignes_a;
                  if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes *
                          sizeof(real8 *))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
                  for(i = 0; i < (*matrice_u).nombre_lignes; i++)
                  {
                      if ((((real8 **) (*matrice_u).tableau)[i] =
                              malloc((*matrice_u).nombre_colonnes *
                              sizeof(real8))) == NULL)
                      {
                          (*s_etat_processus).erreur_systeme =
                                  d_es_allocation_memoire;
                          return;
                      }
                  }
                  for(k = 0, i = 0; i < (*matrice_u).nombre_colonnes; i++)
                  {
                      for(j = 0; j < (*matrice_u).nombre_lignes; j++)
                      {
                          ((real8 **) (*matrice_u).tableau)[j][i] =
                                  ((real8 *) matrice_f77_u)[k++];
                      }
                  }
                  free(matrice_f77_u);
              }
              if (matrice_vh != NULL)
              {
                  (*matrice_vh).nombre_lignes = nombre_colonnes_a;
                  (*matrice_vh).nombre_colonnes = nombre_colonnes_a;
                  if (((*matrice_vh).tableau = malloc((*matrice_vh)
                          .nombre_lignes * sizeof(real8 *))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
                  for(i = 0; i < (*matrice_vh).nombre_lignes; i++)
                  {
                      if ((((real8 **) (*matrice_vh).tableau)[i] =
                              malloc((*matrice_vh).nombre_colonnes *
                              sizeof(real8))) == NULL)
                      {
                          (*s_etat_processus).erreur_systeme =
                                  d_es_allocation_memoire;
                          return;
                      }
                  }
                  for(k = 0, i = 0; i < (*matrice_vh).nombre_colonnes; i++)
                  {
                      for(j = 0; j < (*matrice_vh).nombre_lignes; j++)
                      {
                          ((real8 **) (*matrice_vh).tableau)[j][i] =
                                  ((real8 *) matrice_f77_vh)[k++];
                      }
                  }
                  free(matrice_f77_vh);
              }
              (*vecteur_s).taille = nombre_valeurs_singulieres;
              (*vecteur_s).type = 'R';
              (*vecteur_s).tableau = vecteur_f77_s;
              break;
          }
          case 'R' :
          {
              if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
              {
                  for(j = 0; j < (*s_matrice).nombre_lignes; j++)
                  {
                      ((real8 *) matrice_f77)[k++] = ((real8 **)
                              (*s_matrice).tableau)[j][i];
                  }
              }
              lwork = -1;
              if ((work = malloc(sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              if (matrice_u != NULL)
              {
                  if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a *
                          sizeof(real8))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
              }
              else
              {
                  matrice_f77_u = NULL;
              }
              if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme =
                          d_es_allocation_memoire;
                  return;
              }
              if (matrice_vh != NULL)
              {
                  if ((matrice_f77_vh = malloc(nombre_colonnes_a
                          * nombre_colonnes_a * sizeof(real8))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
              }
              else
              {
                  matrice_f77_vh = NULL;
              }
              dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
                      matrice_f77, &nombre_lignes_a, vecteur_f77_s,
                      matrice_f77_u, &nombre_lignes_a,
                      matrice_f77_vh, &nombre_colonnes_a,
                      work, &lwork, &erreur, longueur, longueur);
              lwork = ((real8 *) work)[0];
              free(work);
              if ((work = malloc(lwork * sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              dgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
                      matrice_f77, &nombre_lignes_a, vecteur_f77_s,
                      matrice_f77_u, &nombre_lignes_a,
                      matrice_f77_vh, &nombre_colonnes_a,
                      work, &lwork, &erreur, longueur, longueur);
              free(work);
              free(matrice_f77);
              if (erreur != 0)
              {
                  if (erreur > 0)
                  {
                      (*s_etat_processus).exception = d_ep_decomposition_SVD;
                  }
                  else
                  {
                      (*s_etat_processus).erreur_execution =
                              d_ex_routines_mathematiques;
                  }
                  free(matrice_f77_u);
                  free(matrice_f77_vh);
                  free(vecteur_f77_s);
                  return;
              }
              if (matrice_u != NULL)
              {
                  (*matrice_u).nombre_lignes = nombre_lignes_a;
                  (*matrice_u).nombre_colonnes = nombre_lignes_a;
                  if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes *
                          sizeof(real8 *))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
                  for(i = 0; i < (*matrice_u).nombre_lignes; i++)
                  {
                      if ((((real8 **) (*matrice_u).tableau)[i] =
                              malloc((*matrice_u).nombre_colonnes *
                              sizeof(real8))) == NULL)
                      {
                          (*s_etat_processus).erreur_systeme =
                                  d_es_allocation_memoire;
                          return;
                      }
                  }
                  for(k = 0, i = 0; i < (*matrice_u).nombre_colonnes; i++)
                  {
                      for(j = 0; j < (*matrice_u).nombre_lignes; j++)
                      {
                          ((real8 **) (*matrice_u).tableau)[j][i] =
                                  ((real8 *) matrice_f77_u)[k++];
                      }
                  }
                  free(matrice_f77_u);
              }
              if (matrice_vh != NULL)
              {
                  (*matrice_vh).nombre_lignes = nombre_colonnes_a;
                  (*matrice_vh).nombre_colonnes = nombre_colonnes_a;
                  if (((*matrice_vh).tableau = malloc((*matrice_vh)
                          .nombre_lignes * sizeof(real8 *))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
                  for(i = 0; i < (*matrice_vh).nombre_lignes; i++)
                  {
                      if ((((real8 **) (*matrice_vh).tableau)[i] =
                              malloc((*matrice_vh).nombre_colonnes *
                              sizeof(real8))) == NULL)
                      {
                          (*s_etat_processus).erreur_systeme =
                                  d_es_allocation_memoire;
                          return;
                      }
                  }
                  for(k = 0, i = 0; i < (*matrice_vh).nombre_colonnes; i++)
                  {
                      for(j = 0; j < (*matrice_vh).nombre_lignes; j++)
                      {
                          ((real8 **) (*matrice_vh).tableau)[j][i] =
                                  ((real8 *) matrice_f77_vh)[k++];
                      }
                  }
                  free(matrice_f77_vh);
              }
              (*vecteur_s).taille = nombre_valeurs_singulieres;
              (*vecteur_s).type = 'R';
              (*vecteur_s).tableau = vecteur_f77_s;
              break;
          }
          case 'C' :
          {
              if ((matrice_f77 = (void *) malloc(taille_matrice_f77 *
                      sizeof(complex16))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              for(k = 0, i = 0; i < (*s_matrice).nombre_colonnes; i++)
              {
                  for(j = 0; j < (*s_matrice).nombre_lignes; j++)
                  {
                      ((complex16 *) matrice_f77)[k++] = ((complex16 **)
                              (*s_matrice).tableau)[j][i];
                  }
              }
              lwork = -1;
              if ((work = malloc(sizeof(complex16))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              if (matrice_u != NULL)
              {
                  if ((matrice_f77_u = malloc(nombre_lignes_a * nombre_lignes_a *
                          sizeof(complex16))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
              }
              else
              {
                  matrice_f77_u = NULL;
              }
              if ((vecteur_f77_s = malloc(nombre_valeurs_singulieres *
                      sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme =
                          d_es_allocation_memoire;
                  return;
              }
              if (matrice_vh != NULL)
              {
                  if ((matrice_f77_vh = malloc(nombre_colonnes_a
                          * nombre_colonnes_a * sizeof(complex16))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
              }
              else
              {
                  matrice_f77_vh = NULL;
              }
              if ((rwork = malloc(5 * nombre_valeurs_singulieres * sizeof(real8)))
                      == NULL)
              {
                  (*s_etat_processus).erreur_systeme =
                          d_es_allocation_memoire;
                  return;
              }
              zgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
                      matrice_f77, &nombre_lignes_a, vecteur_f77_s,
                      matrice_f77_u, &nombre_lignes_a,
                      matrice_f77_vh, &nombre_colonnes_a,
                      work, &lwork, rwork, &erreur, longueur, longueur);
              lwork = ((real8 *) work)[0];
              free(work);
              if ((work = malloc(lwork * sizeof(real8))) == NULL)
              {
                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                  return;
              }
              zgesvd_(&jobu, &jobvh, &nombre_lignes_a, &nombre_colonnes_a,
                      matrice_f77, &nombre_lignes_a, vecteur_f77_s,
                      matrice_f77_u, &nombre_lignes_a,
                      matrice_f77_vh, &nombre_colonnes_a,
                      work, &lwork, rwork, &erreur, longueur, longueur);
              free(work);
              free(rwork);
              free(matrice_f77);
              if (erreur != 0)
              {
                  if (erreur > 0)
                  {
                      (*s_etat_processus).exception = d_ep_decomposition_SVD;
                  }
                  else
                  {
                      (*s_etat_processus).erreur_execution =
                              d_ex_routines_mathematiques;
                  }
                  free(matrice_f77_u);
                  free(matrice_f77_vh);
                  free(vecteur_f77_s);
                  return;
              }
              if (matrice_u != NULL)
              {
                  (*matrice_u).nombre_lignes = nombre_lignes_a;
                  (*matrice_u).nombre_colonnes = nombre_lignes_a;
                  if (((*matrice_u).tableau = malloc((*matrice_u).nombre_lignes *
                          sizeof(complex16 *))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
                  for(i = 0; i < (*matrice_u).nombre_lignes; i++)
                  {
                      if ((((complex16 **) (*matrice_u).tableau)[i] =
                              malloc((*matrice_u).nombre_colonnes *
                              sizeof(complex16))) == NULL)
                      {
                          (*s_etat_processus).erreur_systeme =
                                  d_es_allocation_memoire;
                          return;
                      }
                  }
                  for(k = 0, i = 0; i < (*matrice_u).nombre_colonnes; i++)
                  {
                      for(j = 0; j < (*matrice_u).nombre_lignes; j++)
                      {
                          ((complex16 **) (*matrice_u).tableau)[j][i] =
                                  ((complex16 *) matrice_f77_u)[k++];
                      }
                  }
                  free(matrice_f77_u);
              }
              if (matrice_vh != NULL)
              {
                  (*matrice_vh).nombre_lignes = nombre_colonnes_a;
                  (*matrice_vh).nombre_colonnes = nombre_colonnes_a;
                  if (((*matrice_vh).tableau = malloc((*matrice_vh)
                          .nombre_lignes * sizeof(complex16 *))) == NULL)
                  {
                      (*s_etat_processus).erreur_systeme =
                              d_es_allocation_memoire;
                      return;
                  }
                  for(i = 0; i < (*matrice_vh).nombre_lignes; i++)
                  {
                      if ((((complex16 **) (*matrice_vh).tableau)[i] =
                              malloc((*matrice_vh).nombre_colonnes *
                              sizeof(complex16))) == NULL)
                      {
                          (*s_etat_processus).erreur_systeme =
                                  d_es_allocation_memoire;
                          return;
                      }
                  }
                  for(k = 0, i = 0; i < (*matrice_vh).nombre_colonnes; i++)
                  {
                      for(j = 0; j < (*matrice_vh).nombre_lignes; j++)
                      {
                          ((complex16 **) (*matrice_vh).tableau)[j][i] =
                                  ((complex16 *) matrice_f77_vh)[k++];
                      }
                  }
                  free(matrice_f77_vh);
              }
              (*vecteur_s).taille = nombre_valeurs_singulieres;
              (*vecteur_s).type = 'R';
              (*vecteur_s).tableau = vecteur_f77_s;
              break;
          }
      }
      return;
  }
  // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>

Removed from v.1.11
changed lines
	Added in v.1.12