Page MenuHomec4science
Files F121976623

matrix.c
No OneTemporary
Actions

File Metadata

Created
Tue, Jul 15, 04:10

matrix.c
View Options

/**
* @file matrix.c
*
* @author Guillaume Anciaux <guillaume.anciaux@epfl.ch>
*
* @date Tue Sep 09 15:15:46 2014
*
* @brief This is a wrapper to lapack matrix routines
*
* @section LICENSE
*
* Copyright INRIA and CEA
*
* The LibMultiScale is a C++ parallel framework for the multiscale
* coupling methods dedicated to material simulations. This framework
* provides an API which makes it possible to program coupled simulations
* and integration of already existing codes.
*
* This Project was initiated in a collaboration between INRIA Futurs Bordeaux
* within ScAlApplix team and CEA/DPTA Ile de France.
* The project is now continued at the Ecole Polytechnique Fédérale de Lausanne
* within the LSMS/ENAC laboratory.
*
* This software is governed by the CeCILL-C license under French law and
* abiding by the rules of distribution of free software. You can use,
* modify and/ or redistribute the software under the terms of the CeCILL-C
* license as circulated by CEA, CNRS and INRIA at the following URL
* "http://www.cecill.info".
*
* As a counterpart to the access to the source code and rights to copy,
* modify and redistribute granted by the license, users are provided only
* with a limited warranty and the software's author, the holder of the
* economic rights, and the successive licensors have only limited
* liability.
*
* In this respect, the user's attention is drawn to the risks associated
* with loading, using, modifying and/or developing or reproducing the
* software by the user in light of its specific status of free software,
* that may mean that it is complicated to manipulate, and that also
* therefore means that it is reserved for developers and experienced
* professionals having in-depth computer knowledge. Users are therefore
* encouraged to load and test the software's suitability as regards their
* requirements in conditions enabling the security of their systems and/or
* data to be ensured and, more generally, to use and operate it in the
* same conditions as regards security.
*
* The fact that you are presently reading this means that you have had
* knowledge of the CeCILL-C license and that you accept its terms.
*
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "matrix_blaswrapper.h"
/*****************************************************************/
/* fonctions de multiplications */
/*****************************************************************/
int * Multiplication(double * A,int m1,int n1,double * B,int m2,int n2,double * C)
{
char trans = 'N';
int k = n1;
double unf = 1.0f,zero= 0.0f;
if (n1 != m2)exit(-1);
dgemm_(&trans,&trans, &m1, &n2,&k,&unf,A, &m1, B, &k,&zero,C, &m1);
return 0;
}
/*****************************************************************/
/* fonctions d'inversion */
/*****************************************************************/
int inverseFull(double * A, int * pivot,int n){
int ok;
//int ispec = 1;
int ldwork = 100*n;
double * work = malloc(sizeof(double)*ldwork);
dgetri_(&n,A,&n,pivot,work,&ldwork,&ok);
free(work);
return ok;
}
/*****************************************************************/
/* fonctions de factorisation*/
/*****************************************************************/
/* je definit un pivot qui resera le meme tant que je ne refait pas la
facto LU */
int * factoLUFull(double * A,int n)
{
double moy_err;
int ok,c=1,i;
char trans = 'N';
double unf = 1.0f,zero= 0.0f;
double * B = (double *)malloc(sizeof(double)*n);
double * C = (double *)malloc(sizeof(double)*n);
int * pivot=NULL;
double * sav_A = (double *)malloc(sizeof(double)*n*n);
pivot = (int *)malloc(sizeof(int)*n);
for(i=0;i<n;++i)
{
B[i]=1.0f;
}
memcpy(sav_A,A,sizeof(double)*n*n);
/* memset(C,0,sizeof(double)*n); */
dgesv_(&n, &c, A, &n, pivot, B, &n,&ok);
for(i=0;i<n;++i)
{
B[i]=1.0f;
}
dgetrs_(&trans,&n,&c, A,&n,pivot,B,&n,&ok);
dgemv_(&trans, &n, &n,&unf, sav_A, &n, B, &c,&zero,C, &c );
for(moy_err=0,i=0;i<n;++i)
{
moy_err +=fabs(1.0f-C[i]);
}
moy_err /= n;
if (moy_err>0)
printf("FactoLU resoud avec erreur a %.40e\n",moy_err);
free(C);
free(sav_A);
return pivot;
}
#ifndef AIX
int * factoLUBand(double * A,int kl,int ku,int n)
{
double moy_err;
int ok,i,j,un=1;
int dim=2*kl+ku+1;
char trans = 'N';
double * B = (double *)malloc(sizeof(double)*n);
double * sav_A = (double *)malloc(sizeof(double)*n*dim);
double * C = (double *)malloc(sizeof(double)*n);
double zero=0.0f,alpha=1.0f;
int * pivot=NULL;
pivot = (int *)malloc(sizeof(int)*n);
memcpy(sav_A,A,sizeof(double)*n*dim);
memset(C,0,sizeof(double)*n);
for(j=0;j < n ; ++j)
{
B[j] = 1.0f;
}
dgbsv_(&n,&kl,&ku,&un,A,&dim,pivot,B,&n,&ok);
printf("test erreur facto LU : %d\n",ok);
for(j=0;j < n ; ++j)
{
B[j] = 1.0f;
}
dgbtrs_(&trans, &n, &kl,&ku,&un,A,&dim,pivot,
B,&n,&ok);
dgbmv_(&trans,&n,&n,&kl,&ku,&alpha,sav_A+kl,&dim,B,&un,&zero,C,&un);
for(moy_err=0,i=0;i<n;++i)
{
moy_err +=fabs(1.0f-C[i]);
}
moy_err /= n;
if (moy_err>0)
printf("FactoLU resoud avec erreur a %.40e\n",moy_err);
free(sav_A);
free(C);
free(B);
return pivot;
}
#endif
/*****************************************************************/
/* fonctions de resolution de system*/
/*****************************************************************/
int solveFullMatrix(double * A,double * B,int n,int * pivot)
{
int ok,c=1;
char trans = 'N';
dgetrs_(&trans,&n,&c, A,&n,pivot,B,&n,&ok);
return 0;
}
#ifndef AIX
int solveBandMatrix(double * AB,double * B,int kl,int ku,int n,int * pivot)
{
int ok,un=1;
char trans = 'N';
int dim=2*kl+ku+1;
// printf("solving\n");
dgbtrs_(&trans, &n, &kl,&ku,&un,AB,&dim,pivot,
B,&n,&ok);
return 0;
}
#endif
int solveDiagMatrix(double * A,double * R,int n)
{
int i;
for(i=0;i<n;++i)
{
R[i] = R[i]/A[i];
}
return 0;
}
/* fonctions sur les vecteurs uniquement (fonction BLAS) */
void dscal_(int * N, double * alpha, double * X,
int * INCX,int* INFO);
int scaleArray(double * vector,int N,double alpha){
int i = 1;
int ok;
dscal_(&N,&alpha,vector,&i,&ok);
return ok;
}

Event Timeline

c4science · Help