stepan
/
dynare
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

v4 mex: cleanups related to Blas and Lapack function calls 

git-svn-id: https://www.dynare.org/svn/dynare/dynare_v4@1894 ac1d8469-bf42-47a9-8791-bf33cf982152
time-shift
sebastien 2008-06-23 21:58:45 +00:00
parent 67d98a4a7b
commit 66c5c66e2f
4 changed files with 25 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
mex/sources/build.m
View File

@ -24,7 +24,7 @@ if strcmpi('GLNX86', computer) || strcmpi('GLNXA64', computer) ...
LAPACK_PATH = '-lmwlapack';
if VERSION <= 7.4
BLAS_PATH = LAPACK_PATH; % On <= 7.4, BLAS in included in LAPACK
COMPILE_OPTIONS = [ COMPILE_OPTIONS ' -DMWTYPES_NOT_DEFINED -DNO_BLAS_H' ];
COMPILE_OPTIONS = [ COMPILE_OPTIONS ' -DMWTYPES_NOT_DEFINED -DNO_BLAS_H -DNO_LAPACK_H' ];
else
BLAS_PATH = '-lmwblas';
end
@ -34,7 +34,7 @@ elseif strcmpi('PCWIN', computer)
LAPACK_PATH = ['"' LIBRARY_PATH 'libmwlapack.lib"'];
if VERSION <= 7.4
BLAS_PATH = LAPACK_PATH; % On <= 7.4, BLAS in included in LAPACK
COMPILE_OPTIONS = [ COMPILE_OPTIONS ' -DMWTYPES_NOT_DEFINED -DNO_BLAS_H' ];
COMPILE_OPTIONS = [ COMPILE_OPTIONS ' -DMWTYPES_NOT_DEFINED -DNO_BLAS_H -DNO_LAPACK_H' ];
else
BLAS_PATH = ['"' LIBRARY_PATH 'libmwblas.lib"'];
end

24
mex/sources/kronecker/A_times_B_kronecker_C.cc
View File

@ -9,7 +9,6 @@
*/
#include <string.h>
#include "mex.h"
#include "matrix.h"
#ifdef MWTYPES_NOT_DEFINED
typedef int mwIndex;
@ -17,18 +16,15 @@ typedef int mwSize;
#endif
#ifdef NO_BLAS_H
# if defined(__linux__)
# define DGEMM dgemm_
# else
# define DGEMM dgemm
# endif
extern "C"{
int DGEMM(char*, char*, int*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int*);
# ifdef __linux__
# define dgemm dgemm_
# endif
extern "C" {
int dgemm(char*, char*, int*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int*);
}
#else
# include "blas.h"
# define DGEMM dgemm
#endif
#else /* NO_BLAS_H */
# include "blas.h"
#endif /* NO_BLAS_H */
void full_A_times_kronecker_B_C(double *A, double *B, double *C, double *D,
int mA, int nA, int mB, int nB, int mC, int nC)
@ -43,7 +39,7 @@ void full_A_times_kronecker_B_C(double *A, double *B, double *C, double *D,
ka = 0 ;
for(unsigned long int row=0; row<mB; row++)
{
DGEMM(transpose, transpose, &mA, &nC, &mC, &B[mB*col+row], &A[ka], &mA, &C[0], &mC, &one, &D[kd], &mA);
dgemm(transpose, transpose, &mA, &nC, &mC, &B[mB*col+row], &A[ka], &mA, &C[0], &mC, &one, &D[kd], &mA);
ka += shiftA;
}
kd += shiftD;
@ -63,7 +59,7 @@ void full_A_times_kronecker_B_B(double *A, double *B, double *D, int mA, int nA,
ka = 0 ;
for(unsigned long int row=0; row<mB; row++)
{
DGEMM(transpose, transpose, &mA, &nB, &mB, &B[mB*col+row], &A[ka], &mA, &B[0], &mB, &one, &D[kd], &mA);
dgemm(transpose, transpose, &mA, &nB, &mB, &B[mB*col+row], &A[ka], &mA, &B[0], &mB, &one, &D[kd], &mA);
ka += shiftA;
}
kd += shiftD;

1
mex/sources/kronecker/sparse_hessian_times_B_kronecker_C.cc
View File

@ -9,7 +9,6 @@
** Dynare Team, 2007.
*/
#include <string.h>
#include "matrix.h"
#include "mex.h"
#ifdef MWTYPES_NOT_DEFINED

25
mex/sources/mjdgges/mjdgges.c
View File

@ -1,14 +1,15 @@
#include <string.h>
#include "mex.h"
#if defined(__linux__)
# define DGGES dgges_
#else
# define DGGES dgges
#endif
/* GAUSS interface */
void mjdgges(double *a, double *b, double *z, double *n, double *sdim, double *eval_r, double *eval_i, double *info);
#ifdef NO_LAPACK_H
# ifdef __linux__
# define dgges dgges_
# endif
void dgges(char *, char *, char *, int (*)(), int *, double *, int *, double *, int *, int *, double *, double *, double *,
double *, int *, double *, int *, double *, int *, int *, int *);
#else /* NO_LAPACK_H */
# include "lapack.h"
#endif /* NO_LAPACK_H */
double criterium;
@ -25,17 +26,17 @@ void mjdgges(double *a, double *b, double *z, double *n, double *sdim, double *e
int *bwork;
one = 1;
i_n = (long int)*n;
i_n = (int)*n;
alphar = mxCalloc(i_n,sizeof(double));
alphai = mxCalloc(i_n,sizeof(double));
beta = mxCalloc(i_n,sizeof(double));
lwork = 16*i_n+16;
work = mxCalloc(lwork,sizeof(double));
bwork = mxCalloc(i_n,sizeof(long int));
bwork = mxCalloc(i_n,sizeof(int));
/* made necessary by bug in Lapack */
junk = mxCalloc(i_n*i_n,sizeof(double));
DGGES( "N", "V", "S", (int *)my_criteria, &i_n, a, &i_n, b, &i_n, &i_sdim, alphar, alphai, beta, junk, &i_n, z, &i_n, work, &lwork, bwork, &i_info );
dgges("N", "V", "S", my_criteria, &i_n, a, &i_n, b, &i_n, &i_sdim, alphar, alphai, beta, junk, &i_n, z, &i_n, work, &lwork, bwork, &i_info);
*sdim = i_sdim;
*info = i_info;
@ -81,7 +82,7 @@ void mexFunction( int nlhs, mxArray *plhs[],
if (!mxIsDouble(prhs[0]) || mxIsComplex(prhs[0]) ||
!mxIsDouble(prhs[1]) || mxIsComplex(prhs[1]) ||
(m1 != n1) || (m2!= n1) || (m2 != n2)) {
mexErrMsgTxt("MYDGGES requires two square real matrices of the same dimension.");
mexErrMsgTxt("MJDGGES requires two square real matrices of the same dimension.");
}
/* Create a matrix for the return argument */