blas-stub.c

#ifndef LAPACK_STUB_H

#define LAPACK_STUB_H

#include <stdlib.h>

#define min(a,b)            (((a) < (b)) ? (a) : (b))


/** LAPACK Fortran subroutine DGETRF. */
/*
  void COINUTILS_LAPACK_FUNC(dgetrf,DGETRF)(int *m, int *n,
                        double *A, int *ldA, int *ipiv, int *info);
 */

extern void dgetrf_64_(long *m, long *n, double *A, long *ldA, long *ipiv, long *info);
extern void dgetrs_64_(char *trans, long *n, long *nrhs, const double *A, long *ldA, long *ipiv, double *B, long *ldB, long *info, int trans_len);
;

void dgetrf_(int *m, int *n,
             double *A, int *ldA, int *ipiv, int *info)
{
    int ipiv_len = min(*m,*n);
    long *ipiv_ = (long *) malloc(ipiv_len * sizeof(long));

    dgetrf_64_((long *) m, (long *) n, A, (long *) ldA, ipiv_, (long *) info);

    for (int i=0; i<ipiv_len; ++i)
        ipiv[i] = (int) ipiv_[i];

    free(ipiv_);
    return;
}

  /** LAPACK Fortran subroutine DGETRS. */
/*
void COINUTILS_LAPACK_FUNC(dgetrs,DGETRS)(char *trans, int *n,
                        int *nrhs, const double *A, int *ldA,
                        int *ipiv, double *B, int *ldB, int *info,
                        int trans_len);
*/
void dgetrs_(char *trans, int *n,
             int *nrhs, const double *A, int *ldA,
             int *ipiv, double *B, int *ldB, int *info,
             int trans_len)
{
    int ipiv_len = *n;
    long *ipiv_ = (long *) malloc(ipiv_len * sizeof(long));

    dgetrs_64_(trans, (long *) n, (long *) nrhs, A, (long *) ldA, ipiv_, B, (long *) ldB, (long *) info, trans_len);

    for (int i=0; i<ipiv_len; ++i)
        ipiv[i] = (int) ipiv_[i];

    free(ipiv_);
    return;
}

void dsyev_() {
    return;
}

#endif