Commit 36fdfe68 authored by Davis King's avatar Davis King

Added a copy of CBLAS so we can use it when linking against a BLAS that

doesn't have it.
parent 64c7e966
#
# This is a CMake makefile. You can find the cmake utility and
# information about it at http://www.cmake.org
#
cmake_minimum_required(VERSION 2.8.4)
project(cblas)
enable_language (Fortran)
set(CMAKE_POSITION_INDEPENDENT_CODE True)
add_definitions(-DADD_ -DF77_INT=ptrdiff_t)
add_library(cblas STATIC
cblas_caxpy.c
#cblas_ccopy.c
cblas_cdotc_sub.c
cblas_cdotu_sub.c
#cblas_cgbmv.c
cblas_cgemm.c
cblas_cgemv.c
cblas_cgerc.c
cblas_cgeru.c
#cblas_chbmv.c
#cblas_chemm.c
#cblas_chemv.c
#cblas_cher2.c
#cblas_cher2k.c
#cblas_cher.c
#cblas_cherk.c
#cblas_chpmv.c
#cblas_chpr2.c
#cblas_chpr.c
cblas_cscal.c
#cblas_csscal.c
#cblas_cswap.c
#cblas_csymm.c
#cblas_csyr2k.c
#cblas_csyrk.c
#cblas_ctbmv.c
#cblas_ctbsv.c
#cblas_ctpmv.c
#cblas_ctpsv.c
#cblas_ctrmm.c
#cblas_ctrmv.c
cblas_ctrsm.c
#cblas_ctrsv.c
#cblas_dasum.c
cblas_daxpy.c
#cblas_dcopy.c
cblas_ddot.c
#cblas_dgbmv.c
cblas_dgemm.c
cblas_dgemv.c
cblas_dger.c
#cblas_dnrm2.c
#cblas_drot.c
#cblas_drotg.c
#cblas_drotm.c
#cblas_drotmg.c
#cblas_dsbmv.c
cblas_dscal.c
#cblas_dsdot.c
#cblas_dspmv.c
#cblas_dspr2.c
#cblas_dspr.c
#cblas_dswap.c
#cblas_dsymm.c
#cblas_dsymv.c
#cblas_dsyr2.c
#cblas_dsyr2k.c
#cblas_dsyr.c
#cblas_dsyrk.c
#cblas_dtbmv.c
#cblas_dtbsv.c
#cblas_dtpmv.c
#cblas_dtpsv.c
#cblas_dtrmm.c
#cblas_dtrmv.c
cblas_dtrsm.c
#cblas_dtrsv.c
#cblas_dzasum.c
#cblas_dznrm2.c
#cblas_icamax.c
#cblas_idamax.c
#cblas_isamax.c
#cblas_izamax.c
#cblas_sasum.c
cblas_saxpy.c
#cblas_scasum.c
#cblas_scnrm2.c
#cblas_scopy.c
cblas_sdot.c
#cblas_sdsdot.c
#cblas_sgbmv.c
cblas_sgemm.c
cblas_sgemv.c
cblas_sger.c
#cblas_snrm2.c
#cblas_srot.c
#cblas_srotg.c
#cblas_srotm.c
#cblas_srotmg.c
#cblas_ssbmv.c
cblas_sscal.c
#cblas_sspmv.c
#cblas_sspr2.c
#cblas_sspr.c
#cblas_sswap.c
#cblas_ssymm.c
#cblas_ssymv.c
#cblas_ssyr2.c
#cblas_ssyr2k.c
#cblas_ssyr.c
#cblas_ssyrk.c
#cblas_stbmv.c
#cblas_stbsv.c
#cblas_stpmv.c
#cblas_stpsv.c
#cblas_strmm.c
#cblas_strmv.c
cblas_strsm.c
#cblas_strsv.c
cblas_xerbla.c
cblas_zaxpy.c
#cblas_zcopy.c
cblas_zdotc_sub.c
cblas_zdotu_sub.c
#cblas_zdscal.c
#cblas_zgbmv.c
cblas_zgemm.c
cblas_zgemv.c
cblas_zgerc.c
cblas_zgeru.c
#cblas_zhbmv.c
#cblas_zhemm.c
#cblas_zhemv.c
#cblas_zher2.c
#cblas_zher2k.c
#cblas_zher.c
#cblas_zherk.c
#cblas_zhpmv.c
#cblas_zhpr2.c
#cblas_zhpr.c
cblas_zscal.c
#cblas_zswap.c
#cblas_zsymm.c
#cblas_zsyr2k.c
#cblas_zsyrk.c
#cblas_ztbmv.c
#cblas_ztbsv.c
#cblas_ztpmv.c
#cblas_ztpsv.c
#cblas_ztrmm.c
#cblas_ztrmv.c
cblas_ztrsm.c
#cblas_ztrsv.c
cdotcsub.f
cdotusub.f
dasumsub.f
ddotsub.f
dnrm2sub.f
dsdotsub.f
dzasumsub.f
dznrm2sub.f
icamaxsub.f
idamaxsub.f
isamaxsub.f
izamaxsub.f
sasumsub.f
scasumsub.f
scnrm2sub.f
sdotsub.f
sdsdotsub.f
snrm2sub.f
zdotcsub.f
zdotusub.f
)
This folder contains a copy of CBLAS (from http://www.netlib.org/blas/) which
has been setup so you can compile it with CMake. It also only compiles the
part of CBLAS needed by dlib.
Most BLAS libraries come with CBLAS, however, some don't. In particular, if
you are using the BLAS that comes with MATLAB then you will need this CBLAS
code linked into your own to get dlib working with MATLAB's built in BLAS.
#ifndef CBLAS_H
#define CBLAS_H
#include <stddef.h>
/*
* Enumerated and derived types
*/
#define CBLAS_INDEX size_t /* this may vary between platforms */
enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102};
enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113};
enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};
#ifdef __cplusplus
extern "C" {
#endif
/*
* ===========================================================================
* Prototypes for level 1 BLAS functions (complex are recast as routines)
* ===========================================================================
*/
float cblas_sdsdot(const int N, const float alpha, const float *X,
const int incX, const float *Y, const int incY);
double cblas_dsdot(const int N, const float *X, const int incX, const float *Y,
const int incY);
float cblas_sdot(const int N, const float *X, const int incX,
const float *Y, const int incY);
double cblas_ddot(const int N, const double *X, const int incX,
const double *Y, const int incY);
/*
* Functions having prefixes Z and C only
*/
void cblas_cdotu_sub(const int N, const void *X, const int incX,
const void *Y, const int incY, void *dotu);
void cblas_cdotc_sub(const int N, const void *X, const int incX,
const void *Y, const int incY, void *dotc);
void cblas_zdotu_sub(const int N, const void *X, const int incX,
const void *Y, const int incY, void *dotu);
void cblas_zdotc_sub(const int N, const void *X, const int incX,
const void *Y, const int incY, void *dotc);
/*
* Functions having prefixes S D SC DZ
*/
float cblas_snrm2(const int N, const float *X, const int incX);
float cblas_sasum(const int N, const float *X, const int incX);
double cblas_dnrm2(const int N, const double *X, const int incX);
double cblas_dasum(const int N, const double *X, const int incX);
float cblas_scnrm2(const int N, const void *X, const int incX);
float cblas_scasum(const int N, const void *X, const int incX);
double cblas_dznrm2(const int N, const void *X, const int incX);
double cblas_dzasum(const int N, const void *X, const int incX);
/*
* Functions having standard 4 prefixes (S D C Z)
*/
CBLAS_INDEX cblas_isamax(const int N, const float *X, const int incX);
CBLAS_INDEX cblas_idamax(const int N, const double *X, const int incX);
CBLAS_INDEX cblas_icamax(const int N, const void *X, const int incX);
CBLAS_INDEX cblas_izamax(const int N, const void *X, const int incX);
/*
* ===========================================================================
* Prototypes for level 1 BLAS routines
* ===========================================================================
*/
/*
* Routines with standard 4 prefixes (s, d, c, z)
*/
void cblas_sswap(const int N, float *X, const int incX,
float *Y, const int incY);
void cblas_scopy(const int N, const float *X, const int incX,
float *Y, const int incY);
void cblas_saxpy(const int N, const float alpha, const float *X,
const int incX, float *Y, const int incY);
void cblas_dswap(const int N, double *X, const int incX,
double *Y, const int incY);
void cblas_dcopy(const int N, const double *X, const int incX,
double *Y, const int incY);
void cblas_daxpy(const int N, const double alpha, const double *X,
const int incX, double *Y, const int incY);
void cblas_cswap(const int N, void *X, const int incX,
void *Y, const int incY);
void cblas_ccopy(const int N, const void *X, const int incX,
void *Y, const int incY);
void cblas_caxpy(const int N, const void *alpha, const void *X,
const int incX, void *Y, const int incY);
void cblas_zswap(const int N, void *X, const int incX,
void *Y, const int incY);
void cblas_zcopy(const int N, const void *X, const int incX,
void *Y, const int incY);
void cblas_zaxpy(const int N, const void *alpha, const void *X,
const int incX, void *Y, const int incY);
/*
* Routines with S and D prefix only
*/
void cblas_srotg(float *a, float *b, float *c, float *s);
void cblas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P);
void cblas_srot(const int N, float *X, const int incX,
float *Y, const int incY, const float c, const float s);
void cblas_srotm(const int N, float *X, const int incX,
float *Y, const int incY, const float *P);
void cblas_drotg(double *a, double *b, double *c, double *s);
void cblas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P);
void cblas_drot(const int N, double *X, const int incX,
double *Y, const int incY, const double c, const double s);
void cblas_drotm(const int N, double *X, const int incX,
double *Y, const int incY, const double *P);
/*
* Routines with S D C Z CS and ZD prefixes
*/
void cblas_sscal(const int N, const float alpha, float *X, const int incX);
void cblas_dscal(const int N, const double alpha, double *X, const int incX);
void cblas_cscal(const int N, const void *alpha, void *X, const int incX);
void cblas_zscal(const int N, const void *alpha, void *X, const int incX);
void cblas_csscal(const int N, const float alpha, void *X, const int incX);
void cblas_zdscal(const int N, const double alpha, void *X, const int incX);
/*
* ===========================================================================
* Prototypes for level 2 BLAS
* ===========================================================================
*/
/*
* Routines with standard 4 prefixes (S, D, C, Z)
*/
void cblas_sgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const float alpha, const float *A, const int lda,
const float *X, const int incX, const float beta,
float *Y, const int incY);
void cblas_sgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU, const float alpha,
const float *A, const int lda, const float *X,
const int incX, const float beta, float *Y, const int incY);
void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *A, const int lda,
float *X, const int incX);
void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const float *A, const int lda,
float *X, const int incX);
void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *Ap, float *X, const int incX);
void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *A, const int lda, float *X,
const int incX);
void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const float *A, const int lda,
float *X, const int incX);
void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *Ap, float *X, const int incX);
void cblas_dgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const double alpha, const double *A, const int lda,
const double *X, const int incX, const double beta,
double *Y, const int incY);
void cblas_dgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU, const double alpha,
const double *A, const int lda, const double *X,
const int incX, const double beta, double *Y, const int incY);
void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *A, const int lda,
double *X, const int incX);
void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const double *A, const int lda,
double *X, const int incX);
void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *Ap, double *X, const int incX);
void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *A, const int lda, double *X,
const int incX);
void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const double *A, const int lda,
double *X, const int incX);
void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *Ap, double *X, const int incX);
void cblas_cgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY);
void cblas_cgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU, const void *alpha,
const void *A, const int lda, const void *X,
const int incX, const void *beta, void *Y, const int incY);
void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda,
void *X, const int incX);
void cblas_ctbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX);
void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX);
void cblas_ctrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda, void *X,
const int incX);
void cblas_ctbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX);
void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX);
void cblas_zgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY);
void cblas_zgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU, const void *alpha,
const void *A, const int lda, const void *X,
const int incX, const void *beta, void *Y, const int incY);
void cblas_ztrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda,
void *X, const int incX);
void cblas_ztbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX);
void cblas_ztpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX);
void cblas_ztrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda, void *X,
const int incX);
void cblas_ztbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX);
void cblas_ztpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX);
/*
* Routines with S and D prefixes only
*/
void cblas_ssymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *A,
const int lda, const float *X, const int incX,
const float beta, float *Y, const int incY);
void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const int K, const float alpha, const float *A,
const int lda, const float *X, const int incX,
const float beta, float *Y, const int incY);
void cblas_sspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *Ap,
const float *X, const int incX,
const float beta, float *Y, const int incY);
void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
const float alpha, const float *X, const int incX,
const float *Y, const int incY, float *A, const int lda);
void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, float *A, const int lda);
void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, float *Ap);
void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, const float *Y, const int incY, float *A,
const int lda);
void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, const float *Y, const int incY, float *A);
void cblas_dsymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *A,
const int lda, const double *X, const int incX,
const double beta, double *Y, const int incY);
void cblas_dsbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const int K, const double alpha, const double *A,
const int lda, const double *X, const int incX,
const double beta, double *Y, const int incY);
void cblas_dspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *Ap,
const double *X, const int incX,
const double beta, double *Y, const int incY);
void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
const double alpha, const double *X, const int incX,
const double *Y, const int incY, double *A, const int lda);
void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, double *A, const int lda);
void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, double *Ap);
void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, const double *Y, const int incY, double *A,
const int lda);
void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, const double *Y, const int incY, double *A);
/*
* Routines with C and Z prefixes only
*/
void cblas_chemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const void *alpha, const void *A,
const int lda, const void *X, const int incX,
const void *beta, void *Y, const int incY);
void cblas_chbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const int K, const void *alpha, const void *A,
const int lda, const void *X, const int incX,
const void *beta, void *Y, const int incY);
void cblas_chpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const void *alpha, const void *Ap,
const void *X, const int incX,
const void *beta, void *Y, const int incY);
void cblas_cgeru(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda);
void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda);
void cblas_cher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const void *X, const int incX,
void *A, const int lda);
void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const void *X,
const int incX, void *A);
void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda);
void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *Ap);
void cblas_zhemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const void *alpha, const void *A,
const int lda, const void *X, const int incX,
const void *beta, void *Y, const int incY);
void cblas_zhbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const int K, const void *alpha, const void *A,
const int lda, const void *X, const int incX,
const void *beta, void *Y, const int incY);
void cblas_zhpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const void *alpha, const void *Ap,
const void *X, const int incX,
const void *beta, void *Y, const int incY);
void cblas_zgeru(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda);
void cblas_zgerc(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda);
void cblas_zher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const void *X, const int incX,
void *A, const int lda);
void cblas_zhpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const void *X,
const int incX, void *A);
void cblas_zher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda);
void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *Ap);
/*
* ===========================================================================
* Prototypes for level 3 BLAS
* ===========================================================================
*/
/*
* Routines with standard 4 prefixes (S, D, C, Z)
*/
void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const float alpha, const float *A,
const int lda, const float *B, const int ldb,
const float beta, float *C, const int ldc);
void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const float alpha, const float *A, const int lda,
const float *B, const int ldb, const float beta,
float *C, const int ldc);
void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const float alpha, const float *A, const int lda,
const float beta, float *C, const int ldc);
void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const float alpha, const float *A, const int lda,
const float *B, const int ldb, const float beta,
float *C, const int ldc);
void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const float alpha, const float *A, const int lda,
float *B, const int ldb);
void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const float alpha, const float *A, const int lda,
float *B, const int ldb);
void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const double alpha, const double *A,
const int lda, const double *B, const int ldb,
const double beta, double *C, const int ldc);
void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const double alpha, const double *A, const int lda,
const double *B, const int ldb, const double beta,
double *C, const int ldc);
void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const double alpha, const double *A, const int lda,
const double beta, double *C, const int ldc);
void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const double alpha, const double *A, const int lda,
const double *B, const int ldb, const double beta,
double *C, const int ldc);
void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const double alpha, const double *A, const int lda,
double *B, const int ldb);
void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const double alpha, const double *A, const int lda,
double *B, const int ldb);
void cblas_cgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const void *alpha, const void *A,
const int lda, const void *B, const int ldb,
const void *beta, void *C, const int ldc);
void cblas_csymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc);
void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *beta, void *C, const int ldc);
void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc);
void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb);
void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb);
void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const void *alpha, const void *A,
const int lda, const void *B, const int ldb,
const void *beta, void *C, const int ldc);
void cblas_zsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc);
void cblas_zsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *beta, void *C, const int ldc);
void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc);
void cblas_ztrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb);
void cblas_ztrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb);
/*
* Routines with prefixes C and Z only
*/
void cblas_chemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc);
void cblas_cherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const float alpha, const void *A, const int lda,
const float beta, void *C, const int ldc);
void cblas_cher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const float beta,
void *C, const int ldc);
void cblas_zhemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc);
void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const double alpha, const void *A, const int lda,
const double beta, void *C, const int ldc);
void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const double beta,
void *C, const int ldc);
void cblas_xerbla(int p, const char *rout, const char *form, ...);
#ifdef __cplusplus
}
#endif
#endif
/*
* cblas_caxpy.c
*
* The program is a C interface to caxpy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_caxpy( const int N, const void *alpha, const void *X,
const int incX, void *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_caxpy( &F77_N, alpha, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_ccopy.c
*
* The program is a C interface to ccopy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ccopy( const int N, const void *X,
const int incX, void *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_ccopy( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_cdotc_sub.c
*
* The program is a C interface to cdotc.
* It calls the fortran wrapper before calling cdotc.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cdotc_sub( const int N, const void *X, const int incX,
const void *Y, const int incY,void *dotc)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_cdotc_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotc);
}
/*
* cblas_cdotu_sub.f
*
* The program is a C interface to cdotu.
* It calls the forteran wrapper before calling cdotu.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cdotu_sub( const int N, const void *X,
const int incX, const void *Y, const int incY,void *dotu)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_cdotu_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotu);
}
/*
* cblas_cgbmv.c
* The program is a C interface of cgbmv
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
F77_INT F77_KL=KL,F77_KU=KU;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_KL KL
#define F77_KU KU
#define F77_incX incx
#define F77_incY incY
#endif
int n=0, i=0, incx=incX;
const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
float ALPHA[2],BETA[2];
int tincY, tincx;
float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_cgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, alpha,
A, &F77_lda, X, &F77_incX, beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
TA = 'N';
if (M > 0)
{
n = M << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if( incY > 0 )
tincY = incY;
else
tincY = -incY;
y++;
if (N > 0)
{
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
}
}
else x = (float *) X;
}
else
{
cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
if (TransA == CblasConjTrans)
F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, ALPHA,
A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
else
F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, alpha,
A ,&F77_lda, x,&F77_incX, beta, Y, &F77_incY);
if (TransA == CblasConjTrans)
{
if (x != X) free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
}
else cblas_xerbla(1, "cblas_cgbmv", "Illegal Order setting, %d\n", order);
}
/*
*
* cblas_cgemm.c
* This program is a C interface to cgemm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const void *alpha, const void *A,
const int lda, const void *B, const int ldb,
const void *beta, void *C, const int ldc)
{
char TA, TB;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_TB;
#else
#define F77_TA &TA
#define F77_TB &TB
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_cgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, alpha, A,
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(2, "cblas_cgemm", "Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_cgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B,
&F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_cgemm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_cgemv.c
* The program is a C interface of cgemv
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#define F77_incY incY
#endif
int n=0, i=0, incx=incX;
const float *xx= (const float *)X;
float ALPHA[2],BETA[2];
int tincY, tincx;
float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
const float *stx = x;
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_cgemv(F77_TA, &F77_M, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
ALPHA[0]= *( (const float *) alpha );
ALPHA[1]= -( *( (const float *) alpha+1) );
BETA[0]= *( (const float *) beta );
BETA[1]= -( *( (const float *) beta+1 ) );
TA = 'N';
if (M > 0)
{
n = M << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
F77_incX = 1;
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
if (N > 0)
{
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
}
stx = x;
}
else stx = (const float *)X;
}
else
{
cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
if (TransA == CblasConjTrans)
F77_cgemv(F77_TA, &F77_N, &F77_M, ALPHA, A, &F77_lda, stx,
&F77_incX, BETA, Y, &F77_incY);
else
F77_cgemv(F77_TA, &F77_N, &F77_M, alpha, A, &F77_lda, x,
&F77_incX, beta, Y, &F77_incY);
if (TransA == CblasConjTrans)
{
if (x != (const float *)X) free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
}
else cblas_xerbla(1, "cblas_cgemv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_cgerc.c
* The program is a C interface to cgerc.
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda)
{
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_incX incX
#define F77_incY incy
#define F77_lda lda
#endif
int n, i, tincy, incy=incY;
float *y=(float *)Y, *yy=(float *)Y, *ty, *st;
if (order == CblasColMajor)
{
F77_cgerc( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
} else if (order == CblasRowMajor)
{
if (N > 0)
{
n = N << 1;
y = malloc(n*sizeof(float));
ty = y;
if( incY > 0 ) {
i = incY << 1;
tincy = 2;
st= y+n;
} else {
i = incY *(-2);
tincy = -2;
st = y-2;
y +=(n-2);
}
do
{
*y = *yy;
y[1] = -yy[1];
y += tincy ;
yy += i;
}
while (y != st);
y = ty;
#ifdef F77_INT
F77_incY = 1;
#else
incy = 1;
#endif
}
else y = (float *) Y;
F77_cgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
&F77_lda);
if(Y!=y)
free(y);
} else cblas_xerbla(1, "cblas_cgerc", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_cgeru.c
* The program is a C interface to cgeru.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cgeru(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda)
{
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
F77_cgeru( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
}
else if (order == CblasRowMajor)
{
F77_cgeru( &F77_N, &F77_M, alpha, Y, &F77_incY, X, &F77_incX, A,
&F77_lda);
}
else cblas_xerbla(1, "cblas_cgeru","Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_chbmv.c
* The program is a C interface to chbmv
*
* Keita Teranishi 5/18/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
#include <stdio.h>
#include <stdlib.h>
void cblas_chbmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo,const int N,const int K,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
float ALPHA[2],BETA[2];
int tincY, tincx;
float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
&F77_incX, beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
} else
x = (float *) X;
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chbmv(F77_UL, &F77_N, &F77_K, ALPHA,
A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
}
else
{
cblas_xerbla(1, "cblas_chbmv","Illegal Order setting, %d\n", order);
return;
}
if ( order == CblasRowMajor )
{
if(X!=x)
free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
return;
}
/*
*
* cblas_chemm.c
* This program is a C interface to chemm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_chemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc)
{
char SD, UL;
#ifdef F77_CHAR
F77_CHAR F77_SD, F77_UL;
#else
#define F77_SD &SD
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_chemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_chemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_chemm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_chemv.c
* The program is a C interface to chemv
*
* Keita Teranishi 5/18/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_chemv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#define F77_incY incY
#endif
int n=0, i=0, incx=incX;
const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
float ALPHA[2],BETA[2];
int tincY, tincx;
float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chemv(F77_UL, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
} else
x = (float *) X;
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chemv(F77_UL, &F77_N, ALPHA, A, &F77_lda, x, &F77_incX,
BETA, Y, &F77_incY);
}
else
{
cblas_xerbla(1, "cblas_chemv","Illegal Order setting, %d\n", order);
return;
}
if ( order == CblasRowMajor )
{
if ( X != x )
free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
return;
}
/*
* cblas_cher.c
* The program is a C interface to cher.
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const void *X, const int incX
,void *A, const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#endif
int n, i, tincx, incx=incX;
float *x=(float *)X, *xx=(float *)X, *tx, *st;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_cher","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_cher(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_cher","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
}
else x = (float *) X;
F77_cher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda);
} else
{
cblas_xerbla(1, "cblas_cher","Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
return;
}
/*
* cblas_cher2.c
* The program is a C interface to cher2.
*
* Keita Teranishi 3/23/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#define F77_incY incy
#endif
int n, i, j, tincx, tincy, incx=incX, incy=incY;
float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
*yy=(float *)Y, *tx, *ty, *stx, *sty;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_cher2(F77_UL, &F77_N, alpha, X, &F77_incX,
Y, &F77_incY, A, &F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
y = malloc(n*sizeof(float));
tx = x;
ty = y;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
stx= x+n;
} else {
i = incX *(-2);
tincx = -2;
stx = x-2;
x +=(n-2);
}
if( incY > 0 ) {
j = incY << 1;
tincy = 2;
sty= y+n;
} else {
j = incY *(-2);
tincy = -2;
sty = y-2;
y +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != stx);
do
{
*y = *yy;
y[1] = -yy[1];
y += tincy ;
yy += j;
}
while (y != sty);
x=tx;
y=ty;
#ifdef F77_INT
F77_incX = 1;
F77_incY = 1;
#else
incx = 1;
incy = 1;
#endif
} else
{
x = (float *) X;
y = (float *) Y;
}
F77_cher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
&F77_incX, A, &F77_lda);
} else
{
cblas_xerbla(1, "cblas_cher2","Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
if(Y!=y)
free(y);
return;
}
/*
*
* cblas_cher2k.c
* This program is a C interface to cher2k.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const float beta,
void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
float ALPHA[2];
const float *alp=(float *)alpha;
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_cher2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(2, "cblas_cher2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='C';
else
{
cblas_xerbla(3, "cblas_cher2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
F77_cher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_cher2k", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_cherk.c
* This program is a C interface to cherk.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const float alpha, const void *A, const int lda,
const float beta, void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
&beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='C';
else
{
cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
&beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_cherk", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_chpmv.c
* The program is a C interface of chpmv
*
* Keita Teranishi 5/18/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_chpmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo,const int N,
const void *alpha, const void *AP,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
float ALPHA[2],BETA[2];
int tincY, tincx;
float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chpmv(F77_UL, &F77_N, alpha, AP, X,
&F77_incX, beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
} else
x = (float *) X;
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n", Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chpmv(F77_UL, &F77_N, ALPHA,
AP, x, &F77_incX, BETA, Y, &F77_incY);
}
else
{
cblas_xerbla(1, "cblas_chpmv","Illegal Order setting, %d\n", order);
return;
}
if ( order == CblasRowMajor )
{
if(X!=x)
free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
return;
}
/*
* cblas_chpr.c
* The program is a C interface to chpr.
*
* Keita Teranishi 3/23/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const void *X,
const int incX, void *A)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incx
#endif
int n, i, tincx, incx=incX;
float *x=(float *)X, *xx=(float *)X, *tx, *st;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
tx = x;
if( incX > 0 ) {
i = incX << 1;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
}
else x = (float *) X;
F77_chpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
} else
{
cblas_xerbla(1, "cblas_chpr","Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
return;
}
/*
* cblas_chpr2.c
* The program is a C interface to chpr2.
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N,const void *alpha, const void *X,
const int incX,const void *Y, const int incY, void *Ap)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incx
#define F77_incY incy
#endif
int n, i, j, tincx, tincy, incx=incX, incy=incY;
float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
*yy=(float *)Y, *tx, *ty, *stx, *sty;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_chpr2(F77_UL, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, Ap);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(float));
y = malloc(n*sizeof(float));
tx = x;
ty = y;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
stx= x+n;
} else {
i = incX *(-2);
tincx = -2;
stx = x-2;
x +=(n-2);
}
if( incY > 0 ) {
j = incY << 1;
tincy = 2;
sty= y+n;
} else {
j = incY *(-2);
tincy = -2;
sty = y-2;
y +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != stx);
do
{
*y = *yy;
y[1] = -yy[1];
y += tincy ;
yy += j;
}
while (y != sty);
x=tx;
y=ty;
#ifdef F77_INT
F77_incX = 1;
F77_incY = 1;
#else
incx = 1;
incy = 1;
#endif
} else
{
x = (float *) X;
y = (void *) Y;
}
F77_chpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
} else
{
cblas_xerbla(1, "cblas_chpr2","Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
if(Y!=y)
free(y);
return;
}
/*
* cblas_cscal.c
*
* The program is a C interface to cscal.f.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cscal( const int N, const void *alpha, void *X,
const int incX)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_cscal( &F77_N, alpha, X, &F77_incX);
}
/*
* cblas_csscal.c
*
* The program is a C interface to csscal.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_csscal( const int N, const float alpha, void *X,
const int incX)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_csscal( &F77_N, &alpha, X, &F77_incX);
}
/*
* cblas_cswap.c
*
* The program is a C interface to cswap.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_cswap( const int N, void *X, const int incX, void *Y,
const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_cswap( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
*
* cblas_csymm.c
* This program is a C interface to csymm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_csymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc)
{
char SD, UL;
#ifdef F77_CHAR
F77_CHAR F77_SD, F77_UL;
#else
#define F77_SD &SD
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_csymm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_csymm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_csymm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_csymm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_csymm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_csymm", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_csyr2k.c
* This program is a C interface to csyr2k.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_csyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_csyr2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_csyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_csyr2k", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_csyrk.c
* This program is a C interface to csyrk.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *beta, void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_csyrk", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_ctbmv.c
* The program is a C interface to ctbmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
float *st=0, *x=(float *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctbmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if(incX > 0)
tincX = incX;
else
tincX = -incX;
i = tincX << 1;
n = i * N;
x++;
st = x + n;
do
{
*x = -(*x);
x+= i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ctbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ctbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_ctbsv.c
* The program is a C interface to ctbsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
float *st=0,*x=(float *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if ( incX > 0 )
tincX = incX;
else
tincX = -incX;
n = N*2*(tincX);
x++;
st=x+n;
i = tincX << 1;
do
{
*x = -(*x);
x+=i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x+= i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ctbsv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_ctpmv.c
* The program is a C interface to ctpmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
int n, i=0, tincX;
float *st=0,*x=(float *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if(incX > 0)
tincX = incX;
else
tincX = -incX;
i = tincX << 1;
n = i * N;
x++;
st = x + n;
do
{
*x = -(*x);
x += i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ctpmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_ctpsv.c
* The program is a C interface to ctpsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
int n, i=0, tincX;
float *st=0, *x=(float*)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if ( incX > 0 )
tincX = incX;
else
tincX = -incX;
n = N*2*(tincX);
x++;
st=x+n;
i = tincX << 1;
do
{
*x = -(*x);
x+=i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ctpsv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ctrmm.c
* This program is a C interface to ctrmm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight ) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper ) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans ) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else cblas_xerbla(5, "cblas_ctrmm",
"Illegal Diag setting, %d\n", Diag);
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A, &F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight ) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper ) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans ) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ctrmm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_ctrmm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_ctrmv.c
* The program is a C interface to ctrmv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda,
void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
float *st=0,*x=(float *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if(incX > 0)
tincX = incX;
else
tincX = -incX;
i = tincX << 1;
n = i * N;
st = x + n;
do
{
x[1] = -x[1];
x+= i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
x[1] = -x[1];
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ctrmv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ctrsm.c
* This program is a C interface to ctrsm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A,
&F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A,
&F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_ctrsm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_ctrsv.c
* The program is a C interface to ctrsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ctrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda, void *X,
const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
float *st=0,*x=(float *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ctrsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if ( incX > 0 )
tincX = incX;
else
tincX = -incX;
n = N*2*(tincX);
x++;
st=x+n;
i = tincX << 1;
do
{
*x = -(*x);
x+=i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ctrsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ctrsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ctrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ctrsv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dasum.c
*
* The program is a C interface to dasum.
* It calls the fortran wrapper before calling dasum.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
double cblas_dasum( const int N, const double *X, const int incX)
{
double asum;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_dasum_sub( &F77_N, X, &F77_incX, &asum);
return asum;
}
/*
* cblas_daxpy.c
*
* The program is a C interface to daxpy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_daxpy( const int N, const double alpha, const double *X,
const int incX, double *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_daxpy( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_dcopy.c
*
* The program is a C interface to dcopy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dcopy( const int N, const double *X,
const int incX, double *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_dcopy( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_ddot.c
*
* The program is a C interface to ddot.
* It calls the fortran wrapper before calling ddot.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
double cblas_ddot( const int N, const double *X,
const int incX, const double *Y, const int incY)
{
double dot;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_ddot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
return dot;
}
/*
*
* cblas_dgbmv.c
* This program is a C interface to dgbmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU,
const double alpha, const double *A, const int lda,
const double *X, const int incX, const double beta,
double *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
F77_INT F77_KL=KL,F77_KU=KU;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_KL KL
#define F77_KU KU
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_dgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, &alpha,
A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(2, "cblas_dgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_dgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha,
A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_dgbmv", "Illegal Order setting, %d\n", order);
}
/*
*
* cblas_dgemm.c
* This program is a C interface to dgemm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const double alpha, const double *A,
const int lda, const double *B, const int ldb,
const double beta, double *C, const int ldc)
{
char TA, TB;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_TB;
#else
#define F77_TA &TA
#define F77_TB &TB
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_dgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A,
&F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B,
&F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_dgemm", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_dgemv.c
* This program is a C interface to dgemv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const double alpha, const double *A, const int lda,
const double *X, const int incX, const double beta,
double *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_dgemv(F77_TA, &F77_M, &F77_N, &alpha, A, &F77_lda, X, &F77_incX,
&beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(2, "cblas_dgemv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_dgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_dgemv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_dger.c
* This program is a C interface to dger.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
const double alpha, const double *X, const int incX,
const double *Y, const int incY, double *A, const int lda)
{
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
F77_dger( &F77_M, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
}
else if (order == CblasRowMajor)
{
F77_dger( &F77_N, &F77_M ,&alpha, Y, &F77_incY, X, &F77_incX, A,
&F77_lda);
}
else cblas_xerbla(1, "cblas_dger", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dnrm2.c
*
* The program is a C interface to dnrm2.
* It calls the fortranwrapper before calling dnrm2.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
double cblas_dnrm2( const int N, const double *X, const int incX)
{
double nrm2;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_dnrm2_sub( &F77_N, X, &F77_incX, &nrm2);
return nrm2;
}
/*
* cblas_drot.c
*
* The program is a C interface to drot.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_drot(const int N, double *X, const int incX,
double *Y, const int incY, const double c, const double s)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_drot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s);
return;
}
/*
* cblas_drotg.c
*
* The program is a C interface to drotg.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_drotg( double *a, double *b, double *c, double *s)
{
F77_drotg(a,b,c,s);
}
#include "cblas.h"
#include "cblas_f77.h"
void cblas_drotm( const int N, double *X, const int incX, double *Y,
const int incY, const double *P)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_drotm( &F77_N, X, &F77_incX, Y, &F77_incY, P);
}
/*
* cblas_drotmg.c
*
* The program is a C interface to drotmg.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_drotmg( double *d1, double *d2, double *b1,
const double b2, double *p)
{
F77_drotmg(d1,d2,b1,&b2,p);
}
/*
*
* cblas_dsbmv.c
* This program is a C interface to dsbmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsbmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N, const int K,
const double alpha, const double *A, const int lda,
const double *X, const int incX, const double beta,
double *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha,
A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_dsbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dscal.c
*
* The program is a C interface to dscal.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dscal( const int N, const double alpha, double *X,
const int incX)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_dscal( &F77_N, &alpha, X, &F77_incX);
}
/*
* cblas_dsdot.c
*
* The program is a C interface to dsdot.
* It calls fthe fortran wrapper before calling dsdot.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
double cblas_dsdot( const int N, const float *X,
const int incX, const float *Y, const int incY)
{
double dot;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_dsdot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
return dot;
}
/*
*
* cblas_dspmv.c
* This program is a C interface to dspmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dspmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N,
const double alpha, const double *AP,
const double *X, const int incX, const double beta,
double *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dspmv(F77_UL, &F77_N, &alpha, AP, X,
&F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dspmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dspmv(F77_UL, &F77_N, &alpha,
AP, X,&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_dspmv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_dspr.c
* This program is a C interface to dspr.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, double *Ap)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dspr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
} else cblas_xerbla(1, "cblas_dspr", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dspr2.c
* The program is a C interface to dspr2.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, const double *Y, const int incY, double *A)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dspr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
} else cblas_xerbla(1, "cblas_dspr2", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dswap.c
*
* The program is a C interface to dswap.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dswap( const int N, double *X, const int incX, double *Y,
const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_dswap( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
*
* cblas_dsymm.c
* This program is a C interface to dsymm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const double alpha, const double *A, const int lda,
const double *B, const int ldb, const double beta,
double *C, const int ldc)
{
char SD, UL;
#ifdef F77_CHAR
F77_CHAR F77_SD, F77_UL;
#else
#define F77_SD &SD
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_dsymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda,
B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_dsymm","Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_dsymm","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_dsymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B,
&F77_ldb, &beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_dsymm","Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_dsymv.c
* This program is a C interface to dsymv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsymv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N,
const double alpha, const double *A, const int lda,
const double *X, const int incX, const double beta,
double *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dsymv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsymv(F77_UL, &F77_N, &alpha,
A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_dsymv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_dsyr.c
* This program is a C interface to dsyr.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, double *A, const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_lda=lda;
#else
#define F77_N N
#define F77_incX incX
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dsyr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
} else cblas_xerbla(1, "cblas_dsyr", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_dsyr2.c
* This program is a C interface to dsyr2.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const double *X,
const int incX, const double *Y, const int incY, double *A,
const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77_lda=lda;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dsyr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
} else cblas_xerbla(1, "cblas_dsyr2", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_dsyr2k.c
* This program is a C interface to dsyr2k.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const double alpha, const double *A, const int lda,
const double *B, const int ldb, const double beta,
double *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_dsyr2k","Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_dsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B,
&F77_ldb, &beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_dsyr2k","Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_dsyrk.c
* This program is a C interface to dsyrk.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const double alpha, const double *A, const int lda,
const double beta, double *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
&beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_dsyrk","Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_dsyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
&beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_dsyrk","Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_dtbmv.c
* The program is a C interface to dtbmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const double *A, const int lda,
double *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_dtbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_dtbmv", "Illegal Order setting, %d\n", order);
}
/*
* cblas_dtbsv.c
* The program is a C interface to dtbsv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const double *A, const int lda,
double *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dtbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_dtbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_dtbsv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dtpmv.c
* The program is a C interface to dtpmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *Ap, double *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dtpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_dtpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
}
else cblas_xerbla(1, "cblas_dtpmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dtpsv.c
* The program is a C interface to dtpsv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *Ap, double *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dtpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_dtpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
}
else cblas_xerbla(1, "cblas_dtpsv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_dtrmm.c
* This program is a C interface to dtrmm.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const double alpha, const double *A, const int lda,
double *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_dtrmm","Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_dtrmm","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_dtrmm","Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_dtrmm","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_dtrmm", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_dtrmv.c
* This program is a C interface to sgemv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *A, const int lda,
double *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dtrmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
} else cblas_xerbla(1, "cblas_dtrmv", "Illegal order setting, %d\n", order);
return;
}
/*
*
* cblas_dtrsm.c
* This program is a C interface to dtrsm.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const double alpha, const double *A, const int lda,
double *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if ( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
return;
}
if ( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower) UL='L';
else
{
cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
return;
}
if ( TransA == CblasTrans ) TA='T';
else if ( TransA == CblasConjTrans) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
return;
}
if ( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit) DI='N';
else
{
cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha,
A, &F77_lda, B, &F77_ldb);
}
else if (Order == CblasRowMajor)
{
if ( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
return;
}
if ( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower) UL='U';
else
{
cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
return;
}
if ( TransA == CblasTrans ) TA='T';
else if ( TransA == CblasConjTrans) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
return;
}
if ( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit) DI='N';
else
{
cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
&F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_dtrsm","Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_dtrsv.c
* The program is a C interface to dtrsv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const double *A, const int lda, double *X,
const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_dtrsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_dtrsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_dtrsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_dtrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_dtrsv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_dzasum.c
*
* The program is a C interface to dzasum.
* It calls the fortran wrapper before calling dzasum.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
double cblas_dzasum( const int N, const void *X, const int incX)
{
double asum;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_dzasum_sub( &F77_N, X, &F77_incX, &asum);
return asum;
}
/*
* cblas_dznrm2.c
*
* The program is a C interface to dznrm2.
* It calls the fortran wrapper before calling dznrm2.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
double cblas_dznrm2( const int N, const void *X, const int incX)
{
double nrm2;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_dznrm2_sub( &F77_N, X, &F77_incX, &nrm2);
return nrm2;
}
/*
* cblas_f77.h
* Written by Keita Teranishi
*
* Updated by Jeff Horner
* Merged cblas_f77.h and cblas_fortran_header.h
*/
#ifndef CBLAS_F77_H
#define CBLAS_f77_H
#ifdef CRAY
#include <fortran.h>
#define F77_CHAR _fcd
#define C2F_CHAR(a) ( _cptofcd( (a), 1 ) )
#define C2F_STR(a, i) ( _cptofcd( (a), (i) ) )
#define F77_STRLEN(a) (_fcdlen)
#endif
#ifdef WeirdNEC
#define F77_INT long
#endif
#ifdef F77_CHAR
#define FCHAR F77_CHAR
#else
#define FCHAR char *
#endif
#ifdef F77_INT
#define FINT const F77_INT *
#define FINT2 F77_INT *
#else
#define FINT const int *
#define FINT2 int *
#endif
#if defined(ADD_)
/*
* Level 1 BLAS
*/
#define F77_xerbla xerbla_
#define F77_srotg srotg_
#define F77_srotmg srotmg_
#define F77_srot srot_
#define F77_srotm srotm_
#define F77_drotg drotg_
#define F77_drotmg drotmg_
#define F77_drot drot_
#define F77_drotm drotm_
#define F77_sswap sswap_
#define F77_scopy scopy_
#define F77_saxpy saxpy_
#define F77_isamax_sub isamaxsub_
#define F77_dswap dswap_
#define F77_dcopy dcopy_
#define F77_daxpy daxpy_
#define F77_idamax_sub idamaxsub_
#define F77_cswap cswap_
#define F77_ccopy ccopy_
#define F77_caxpy caxpy_
#define F77_icamax_sub icamaxsub_
#define F77_zswap zswap_
#define F77_zcopy zcopy_
#define F77_zaxpy zaxpy_
#define F77_izamax_sub izamaxsub_
#define F77_sdot_sub sdotsub_
#define F77_ddot_sub ddotsub_
#define F77_dsdot_sub dsdotsub_
#define F77_sscal sscal_
#define F77_dscal dscal_
#define F77_cscal cscal_
#define F77_zscal zscal_
#define F77_csscal csscal_
#define F77_zdscal zdscal_
#define F77_cdotu_sub cdotusub_
#define F77_cdotc_sub cdotcsub_
#define F77_zdotu_sub zdotusub_
#define F77_zdotc_sub zdotcsub_
#define F77_snrm2_sub snrm2sub_
#define F77_sasum_sub sasumsub_
#define F77_dnrm2_sub dnrm2sub_
#define F77_dasum_sub dasumsub_
#define F77_scnrm2_sub scnrm2sub_
#define F77_scasum_sub scasumsub_
#define F77_dznrm2_sub dznrm2sub_
#define F77_dzasum_sub dzasumsub_
#define F77_sdsdot_sub sdsdotsub_
/*
* Level 2 BLAS
*/
#define F77_ssymv ssymv_
#define F77_ssbmv ssbmv_
#define F77_sspmv sspmv_
#define F77_sger sger_
#define F77_ssyr ssyr_
#define F77_sspr sspr_
#define F77_ssyr2 ssyr2_
#define F77_sspr2 sspr2_
#define F77_dsymv dsymv_
#define F77_dsbmv dsbmv_
#define F77_dspmv dspmv_
#define F77_dger dger_
#define F77_dsyr dsyr_
#define F77_dspr dspr_
#define F77_dsyr2 dsyr2_
#define F77_dspr2 dspr2_
#define F77_chemv chemv_
#define F77_chbmv chbmv_
#define F77_chpmv chpmv_
#define F77_cgeru cgeru_
#define F77_cgerc cgerc_
#define F77_cher cher_
#define F77_chpr chpr_
#define F77_cher2 cher2_
#define F77_chpr2 chpr2_
#define F77_zhemv zhemv_
#define F77_zhbmv zhbmv_
#define F77_zhpmv zhpmv_
#define F77_zgeru zgeru_
#define F77_zgerc zgerc_
#define F77_zher zher_
#define F77_zhpr zhpr_
#define F77_zher2 zher2_
#define F77_zhpr2 zhpr2_
#define F77_sgemv sgemv_
#define F77_sgbmv sgbmv_
#define F77_strmv strmv_
#define F77_stbmv stbmv_
#define F77_stpmv stpmv_
#define F77_strsv strsv_
#define F77_stbsv stbsv_
#define F77_stpsv stpsv_
#define F77_dgemv dgemv_
#define F77_dgbmv dgbmv_
#define F77_dtrmv dtrmv_
#define F77_dtbmv dtbmv_
#define F77_dtpmv dtpmv_
#define F77_dtrsv dtrsv_
#define F77_dtbsv dtbsv_
#define F77_dtpsv dtpsv_
#define F77_cgemv cgemv_
#define F77_cgbmv cgbmv_
#define F77_ctrmv ctrmv_
#define F77_ctbmv ctbmv_
#define F77_ctpmv ctpmv_
#define F77_ctrsv ctrsv_
#define F77_ctbsv ctbsv_
#define F77_ctpsv ctpsv_
#define F77_zgemv zgemv_
#define F77_zgbmv zgbmv_
#define F77_ztrmv ztrmv_
#define F77_ztbmv ztbmv_
#define F77_ztpmv ztpmv_
#define F77_ztrsv ztrsv_
#define F77_ztbsv ztbsv_
#define F77_ztpsv ztpsv_
/*
* Level 3 BLAS
*/
#define F77_chemm chemm_
#define F77_cherk cherk_
#define F77_cher2k cher2k_
#define F77_zhemm zhemm_
#define F77_zherk zherk_
#define F77_zher2k zher2k_
#define F77_sgemm sgemm_
#define F77_ssymm ssymm_
#define F77_ssyrk ssyrk_
#define F77_ssyr2k ssyr2k_
#define F77_strmm strmm_
#define F77_strsm strsm_
#define F77_dgemm dgemm_
#define F77_dsymm dsymm_
#define F77_dsyrk dsyrk_
#define F77_dsyr2k dsyr2k_
#define F77_dtrmm dtrmm_
#define F77_dtrsm dtrsm_
#define F77_cgemm cgemm_
#define F77_csymm csymm_
#define F77_csyrk csyrk_
#define F77_csyr2k csyr2k_
#define F77_ctrmm ctrmm_
#define F77_ctrsm ctrsm_
#define F77_zgemm zgemm_
#define F77_zsymm zsymm_
#define F77_zsyrk zsyrk_
#define F77_zsyr2k zsyr2k_
#define F77_ztrmm ztrmm_
#define F77_ztrsm ztrsm_
#elif defined(UPCASE)
/*
* Level 1 BLAS
*/
#define F77_xerbla XERBLA
#define F77_srotg SROTG
#define F77_srotmg SROTMG
#define F77_srot SROT
#define F77_srotm SROTM
#define F77_drotg DROTG
#define F77_drotmg DROTMG
#define F77_drot DROT
#define F77_drotm DROTM
#define F77_sswap SSWAP
#define F77_scopy SCOPY
#define F77_saxpy SAXPY
#define F77_isamax_sub ISAMAXSUB
#define F77_dswap DSWAP
#define F77_dcopy DCOPY
#define F77_daxpy DAXPY
#define F77_idamax_sub IDAMAXSUB
#define F77_cswap CSWAP
#define F77_ccopy CCOPY
#define F77_caxpy CAXPY
#define F77_icamax_sub ICAMAXSUB
#define F77_zswap ZSWAP
#define F77_zcopy ZCOPY
#define F77_zaxpy ZAXPY
#define F77_izamax_sub IZAMAXSUB
#define F77_sdot_sub SDOTSUB
#define F77_ddot_sub DDOTSUB
#define F77_dsdot_sub DSDOTSUB
#define F77_sscal SSCAL
#define F77_dscal DSCAL
#define F77_cscal CSCAL
#define F77_zscal ZSCAL
#define F77_csscal CSSCAL
#define F77_zdscal ZDSCAL
#define F77_cdotu_sub CDOTUSUB
#define F77_cdotc_sub CDOTCSUB
#define F77_zdotu_sub ZDOTUSUB
#define F77_zdotc_sub ZDOTCSUB
#define F77_snrm2_sub SNRM2SUB
#define F77_sasum_sub SASUMSUB
#define F77_dnrm2_sub DNRM2SUB
#define F77_dasum_sub DASUMSUB
#define F77_scnrm2_sub SCNRM2SUB
#define F77_scasum_sub SCASUMSUB
#define F77_dznrm2_sub DZNRM2SUB
#define F77_dzasum_sub DZASUMSUB
#define F77_sdsdot_sub SDSDOTSUB
/*
* Level 2 BLAS
*/
#define F77_ssymv SSYMV
#define F77_ssbmv SSBMV
#define F77_sspmv SSPMV
#define F77_sger SGER
#define F77_ssyr SSYR
#define F77_sspr SSPR
#define F77_ssyr2 SSYR2
#define F77_sspr2 SSPR2
#define F77_dsymv DSYMV
#define F77_dsbmv DSBMV
#define F77_dspmv DSPMV
#define F77_dger DGER
#define F77_dsyr DSYR
#define F77_dspr DSPR
#define F77_dsyr2 DSYR2
#define F77_dspr2 DSPR2
#define F77_chemv CHEMV
#define F77_chbmv CHBMV
#define F77_chpmv CHPMV
#define F77_cgeru CGERU
#define F77_cgerc CGERC
#define F77_cher CHER
#define F77_chpr CHPR
#define F77_cher2 CHER2
#define F77_chpr2 CHPR2
#define F77_zhemv ZHEMV
#define F77_zhbmv ZHBMV
#define F77_zhpmv ZHPMV
#define F77_zgeru ZGERU
#define F77_zgerc ZGERC
#define F77_zher ZHER
#define F77_zhpr ZHPR
#define F77_zher2 ZHER2
#define F77_zhpr2 ZHPR2
#define F77_sgemv SGEMV
#define F77_sgbmv SGBMV
#define F77_strmv STRMV
#define F77_stbmv STBMV
#define F77_stpmv STPMV
#define F77_strsv STRSV
#define F77_stbsv STBSV
#define F77_stpsv STPSV
#define F77_dgemv DGEMV
#define F77_dgbmv DGBMV
#define F77_dtrmv DTRMV
#define F77_dtbmv DTBMV
#define F77_dtpmv DTPMV
#define F77_dtrsv DTRSV
#define F77_dtbsv DTBSV
#define F77_dtpsv DTPSV
#define F77_cgemv CGEMV
#define F77_cgbmv CGBMV
#define F77_ctrmv CTRMV
#define F77_ctbmv CTBMV
#define F77_ctpmv CTPMV
#define F77_ctrsv CTRSV
#define F77_ctbsv CTBSV
#define F77_ctpsv CTPSV
#define F77_zgemv ZGEMV
#define F77_zgbmv ZGBMV
#define F77_ztrmv ZTRMV
#define F77_ztbmv ZTBMV
#define F77_ztpmv ZTPMV
#define F77_ztrsv ZTRSV
#define F77_ztbsv ZTBSV
#define F77_ztpsv ZTPSV
/*
* Level 3 BLAS
*/
#define F77_chemm CHEMM
#define F77_cherk CHERK
#define F77_cher2k CHER2K
#define F77_zhemm ZHEMM
#define F77_zherk ZHERK
#define F77_zher2k ZHER2K
#define F77_sgemm SGEMM
#define F77_ssymm SSYMM
#define F77_ssyrk SSYRK
#define F77_ssyr2k SSYR2K
#define F77_strmm STRMM
#define F77_strsm STRSM
#define F77_dgemm DGEMM
#define F77_dsymm DSYMM
#define F77_dsyrk DSYRK
#define F77_dsyr2k DSYR2K
#define F77_dtrmm DTRMM
#define F77_dtrsm DTRSM
#define F77_cgemm CGEMM
#define F77_csymm CSYMM
#define F77_csyrk CSYRK
#define F77_csyr2k CSYR2K
#define F77_ctrmm CTRMM
#define F77_ctrsm CTRSM
#define F77_zgemm ZGEMM
#define F77_zsymm ZSYMM
#define F77_zsyrk ZSYRK
#define F77_zsyr2k ZSYR2K
#define F77_ztrmm ZTRMM
#define F77_ztrsm ZTRSM
#elif defined(NOCHANGE)
/*
* Level 1 BLAS
*/
#define F77_xerbla xerbla
#define F77_srotg srotg
#define F77_srotmg srotmg
#define F77_srot srot
#define F77_srotm srotm
#define F77_drotg drotg
#define F77_drotmg drotmg
#define F77_drot drot
#define F77_drotm drotm
#define F77_sswap sswap
#define F77_scopy scopy
#define F77_saxpy saxpy
#define F77_isamax_sub isamaxsub
#define F77_dswap dswap
#define F77_dcopy dcopy
#define F77_daxpy daxpy
#define F77_idamax_sub idamaxsub
#define F77_cswap cswap
#define F77_ccopy ccopy
#define F77_caxpy caxpy
#define F77_icamax_sub icamaxsub
#define F77_zswap zswap
#define F77_zcopy zcopy
#define F77_zaxpy zaxpy
#define F77_izamax_sub izamaxsub
#define F77_sdot_sub sdotsub
#define F77_ddot_sub ddotsub
#define F77_dsdot_sub dsdotsub
#define F77_sscal sscal
#define F77_dscal dscal
#define F77_cscal cscal
#define F77_zscal zscal
#define F77_csscal csscal
#define F77_zdscal zdscal
#define F77_cdotu_sub cdotusub
#define F77_cdotc_sub cdotcsub
#define F77_zdotu_sub zdotusub
#define F77_zdotc_sub zdotcsub
#define F77_snrm2_sub snrm2sub
#define F77_sasum_sub sasumsub
#define F77_dnrm2_sub dnrm2sub
#define F77_dasum_sub dasumsub
#define F77_scnrm2_sub scnrm2sub
#define F77_scasum_sub scasumsub
#define F77_dznrm2_sub dznrm2sub
#define F77_dzasum_sub dzasumsub
#define F77_sdsdot_sub sdsdotsub
/*
* Level 2 BLAS
*/
#define F77_ssymv ssymv
#define F77_ssbmv ssbmv
#define F77_sspmv sspmv
#define F77_sger sger
#define F77_ssyr ssyr
#define F77_sspr sspr
#define F77_ssyr2 ssyr2
#define F77_sspr2 sspr2
#define F77_dsymv dsymv
#define F77_dsbmv dsbmv
#define F77_dspmv dspmv
#define F77_dger dger
#define F77_dsyr dsyr
#define F77_dspr dspr
#define F77_dsyr2 dsyr2
#define F77_dspr2 dspr2
#define F77_chemv chemv
#define F77_chbmv chbmv
#define F77_chpmv chpmv
#define F77_cgeru cgeru
#define F77_cgerc cgerc
#define F77_cher cher
#define F77_chpr chpr
#define F77_cher2 cher2
#define F77_chpr2 chpr2
#define F77_zhemv zhemv
#define F77_zhbmv zhbmv
#define F77_zhpmv zhpmv
#define F77_zgeru zgeru
#define F77_zgerc zgerc
#define F77_zher zher
#define F77_zhpr zhpr
#define F77_zher2 zher2
#define F77_zhpr2 zhpr2
#define F77_sgemv sgemv
#define F77_sgbmv sgbmv
#define F77_strmv strmv
#define F77_stbmv stbmv
#define F77_stpmv stpmv
#define F77_strsv strsv
#define F77_stbsv stbsv
#define F77_stpsv stpsv
#define F77_dgemv dgemv
#define F77_dgbmv dgbmv
#define F77_dtrmv dtrmv
#define F77_dtbmv dtbmv
#define F77_dtpmv dtpmv
#define F77_dtrsv dtrsv
#define F77_dtbsv dtbsv
#define F77_dtpsv dtpsv
#define F77_cgemv cgemv
#define F77_cgbmv cgbmv
#define F77_ctrmv ctrmv
#define F77_ctbmv ctbmv
#define F77_ctpmv ctpmv
#define F77_ctrsv ctrsv
#define F77_ctbsv ctbsv
#define F77_ctpsv ctpsv
#define F77_zgemv zgemv
#define F77_zgbmv zgbmv
#define F77_ztrmv ztrmv
#define F77_ztbmv ztbmv
#define F77_ztpmv ztpmv
#define F77_ztrsv ztrsv
#define F77_ztbsv ztbsv
#define F77_ztpsv ztpsv
/*
* Level 3 BLAS
*/
#define F77_chemm chemm
#define F77_cherk cherk
#define F77_cher2k cher2k
#define F77_zhemm zhemm
#define F77_zherk zherk
#define F77_zher2k zher2k
#define F77_sgemm sgemm
#define F77_ssymm ssymm
#define F77_ssyrk ssyrk
#define F77_ssyr2k ssyr2k
#define F77_strmm strmm
#define F77_strsm strsm
#define F77_dgemm dgemm
#define F77_dsymm dsymm
#define F77_dsyrk dsyrk
#define F77_dsyr2k dsyr2k
#define F77_dtrmm dtrmm
#define F77_dtrsm dtrsm
#define F77_cgemm cgemm
#define F77_csymm csymm
#define F77_csyrk csyrk
#define F77_csyr2k csyr2k
#define F77_ctrmm ctrmm
#define F77_ctrsm ctrsm
#define F77_zgemm zgemm
#define F77_zsymm zsymm
#define F77_zsyrk zsyrk
#define F77_zsyr2k zsyr2k
#define F77_ztrmm ztrmm
#define F77_ztrsm ztrsm
#endif
#ifdef __cplusplus
extern "C" {
#endif
void F77_xerbla(FCHAR, void *);
/*
* Level 1 Fortran Prototypes
*/
/* Single Precision */
void F77_srot(FINT, float *, FINT, float *, FINT, const float *, const float *);
void F77_srotg(float *,float *,float *,float *);
void F77_srotm( FINT, float *, FINT, float *, FINT, const float *);
void F77_srotmg(float *,float *,float *,const float *, float *);
void F77_sswap( FINT, float *, FINT, float *, FINT);
void F77_scopy( FINT, const float *, FINT, float *, FINT);
void F77_saxpy( FINT, const float *, const float *, FINT, float *, FINT);
void F77_sdot_sub(FINT, const float *, FINT, const float *, FINT, float *);
void F77_sdsdot_sub( FINT, const float *, const float *, FINT, const float *, FINT, float *);
void F77_sscal( FINT, const float *, float *, FINT);
void F77_snrm2_sub( FINT, const float *, FINT, float *);
void F77_sasum_sub( FINT, const float *, FINT, float *);
void F77_isamax_sub( FINT, const float * , FINT, FINT2);
/* Double Precision */
void F77_drot(FINT, double *, FINT, double *, FINT, const double *, const double *);
void F77_drotg(double *,double *,double *,double *);
void F77_drotm( FINT, double *, FINT, double *, FINT, const double *);
void F77_drotmg(double *,double *,double *,const double *, double *);
void F77_dswap( FINT, double *, FINT, double *, FINT);
void F77_dcopy( FINT, const double *, FINT, double *, FINT);
void F77_daxpy( FINT, const double *, const double *, FINT, double *, FINT);
void F77_dswap( FINT, double *, FINT, double *, FINT);
void F77_dsdot_sub(FINT, const float *, FINT, const float *, FINT, double *);
void F77_ddot_sub( FINT, const double *, FINT, const double *, FINT, double *);
void F77_dscal( FINT, const double *, double *, FINT);
void F77_dnrm2_sub( FINT, const double *, FINT, double *);
void F77_dasum_sub( FINT, const double *, FINT, double *);
void F77_idamax_sub( FINT, const double * , FINT, FINT2);
/* Single Complex Precision */
void F77_cswap( FINT, void *, FINT, void *, FINT);
void F77_ccopy( FINT, const void *, FINT, void *, FINT);
void F77_caxpy( FINT, const void *, const void *, FINT, void *, FINT);
void F77_cswap( FINT, void *, FINT, void *, FINT);
void F77_cdotc_sub( FINT, const void *, FINT, const void *, FINT, void *);
void F77_cdotu_sub( FINT, const void *, FINT, const void *, FINT, void *);
void F77_cscal( FINT, const void *, void *, FINT);
void F77_icamax_sub( FINT, const void *, FINT, FINT2);
void F77_csscal( FINT, const float *, void *, FINT);
void F77_scnrm2_sub( FINT, const void *, FINT, float *);
void F77_scasum_sub( FINT, const void *, FINT, float *);
/* Double Complex Precision */
void F77_zswap( FINT, void *, FINT, void *, FINT);
void F77_zcopy( FINT, const void *, FINT, void *, FINT);
void F77_zaxpy( FINT, const void *, const void *, FINT, void *, FINT);
void F77_zswap( FINT, void *, FINT, void *, FINT);
void F77_zdotc_sub( FINT, const void *, FINT, const void *, FINT, void *);
void F77_zdotu_sub( FINT, const void *, FINT, const void *, FINT, void *);
void F77_zdscal( FINT, const double *, void *, FINT);
void F77_zscal( FINT, const void *, void *, FINT);
void F77_dznrm2_sub( FINT, const void *, FINT, double *);
void F77_dzasum_sub( FINT, const void *, FINT, double *);
void F77_izamax_sub( FINT, const void *, FINT, FINT2);
/*
* Level 2 Fortran Prototypes
*/
/* Single Precision */
void F77_sgemv(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_sgbmv(FCHAR, FINT, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_ssymv(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_ssbmv(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_sspmv(FCHAR, FINT, const float *, const float *, const float *, FINT, const float *, float *, FINT);
void F77_strmv( FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT);
void F77_stbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT);
void F77_strsv( FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT);
void F77_stbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT);
void F77_stpmv( FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT);
void F77_stpsv( FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT);
void F77_sger( FINT, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT);
void F77_ssyr(FCHAR, FINT, const float *, const float *, FINT, float *, FINT);
void F77_sspr(FCHAR, FINT, const float *, const float *, FINT, float *);
void F77_sspr2(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *);
void F77_ssyr2(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT);
/* Double Precision */
void F77_dgemv(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dgbmv(FCHAR, FINT, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dsymv(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dsbmv(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dspmv(FCHAR, FINT, const double *, const double *, const double *, FINT, const double *, double *, FINT);
void F77_dtrmv( FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT);
void F77_dtbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT);
void F77_dtrsv( FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT);
void F77_dtbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT);
void F77_dtpmv( FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT);
void F77_dtpsv( FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT);
void F77_dger( FINT, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT);
void F77_dsyr(FCHAR, FINT, const double *, const double *, FINT, double *, FINT);
void F77_dspr(FCHAR, FINT, const double *, const double *, FINT, double *);
void F77_dspr2(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *);
void F77_dsyr2(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT);
/* Single Complex Precision */
void F77_cgemv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_cgbmv(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_chemv(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_chbmv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_chpmv(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT);
void F77_ctrmv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
void F77_ctbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
void F77_ctpmv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT);
void F77_ctrsv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
void F77_ctbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
void F77_ctpsv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT);
void F77_cgerc( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
void F77_cgeru( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
void F77_cher(FCHAR, FINT, const float *, const void *, FINT, void *, FINT);
void F77_cher2(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
void F77_chpr(FCHAR, FINT, const float *, const void *, FINT, void *);
void F77_chpr2(FCHAR, FINT, const float *, const void *, FINT, const void *, FINT, void *);
/* Double Complex Precision */
void F77_zgemv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_zgbmv(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_zhemv(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_zhbmv(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT);
void F77_zhpmv(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT);
void F77_ztrmv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
void F77_ztbmv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
void F77_ztpmv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT);
void F77_ztrsv( FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT);
void F77_ztbsv( FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT);
void F77_ztpsv( FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT);
void F77_zgerc( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
void F77_zgeru( FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
void F77_zher(FCHAR, FINT, const double *, const void *, FINT, void *, FINT);
void F77_zher2(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT);
void F77_zhpr(FCHAR, FINT, const double *, const void *, FINT, void *);
void F77_zhpr2(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void *);
/*
* Level 3 Fortran Prototypes
*/
/* Single Precision */
void F77_sgemm(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_ssymm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_ssyrk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT);
void F77_ssyr2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_strmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
void F77_strsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
/* Double Precision */
void F77_dgemm(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dsymm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dsyrk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT);
void F77_dsyr2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_dtrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
void F77_dtrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
/* Single Complex Precision */
void F77_cgemm(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_csymm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_chemm(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_csyrk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT);
void F77_cherk(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT);
void F77_csyr2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_cher2k(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT);
void F77_ctrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
void F77_ctrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT);
/* Double Complex Precision */
void F77_zgemm(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_zsymm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_zhemm(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_zsyrk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT);
void F77_zherk(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT);
void F77_zsyr2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_zher2k(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT);
void F77_ztrmm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
void F77_ztrsm(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT);
#ifdef __cplusplus
}
#endif
#endif /* CBLAS_F77_H */
/*
* cblas_icamax.c
*
* The program is a C interface to icamax.
* It calls the fortran wrapper before calling icamax.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
CBLAS_INDEX cblas_icamax( const int N, const void *X, const int incX)
{
F77_INT iamax;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_icamax_sub( &F77_N, X, &F77_incX, &iamax);
return iamax ? iamax-1 : 0;
}
/*
* cblas_idamax.c
*
* The program is a C interface to idamax.
* It calls the fortran wrapper before calling idamax.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
CBLAS_INDEX cblas_idamax( const int N, const double *X, const int incX)
{
F77_INT iamax;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_idamax_sub( &F77_N, X, &F77_incX, &iamax);
return iamax ? iamax-1 : 0;
}
/*
* cblas_isamax.c
*
* The program is a C interface to isamax.
* It calls the fortran wrapper before calling isamax.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
CBLAS_INDEX cblas_isamax( const int N, const float *X, const int incX)
{
F77_INT iamax;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_isamax_sub( &F77_N, X, &F77_incX, &iamax);
return iamax ? iamax-1 : 0;
}
/*
* cblas_izamax.c
*
* The program is a C interface to izamax.
* It calls the fortran wrapper before calling izamax.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
CBLAS_INDEX cblas_izamax( const int N, const void *X, const int incX)
{
F77_INT iamax;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_izamax_sub( &F77_N, X, &F77_incX, &iamax);
return (iamax ? iamax-1 : 0);
}
/*
* cblas_sasum.c
*
* The program is a C interface to sasum.
* It calls the fortran wrapper before calling sasum.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
float cblas_sasum( const int N, const float *X, const int incX)
{
float asum;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_sasum_sub( &F77_N, X, &F77_incX, &asum);
return asum;
}
/*
* cblas_saxpy.c
*
* The program is a C interface to saxpy.
* It calls the fortran wrapper before calling saxpy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_saxpy( const int N, const float alpha, const float *X,
const int incX, float *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_saxpy( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_scasum.c
*
* The program is a C interface to scasum.
* It calls the fortran wrapper before calling scasum.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
float cblas_scasum( const int N, const void *X, const int incX)
{
float asum;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_scasum_sub( &F77_N, X, &F77_incX, &asum);
return asum;
}
/*
* cblas_scnrm2.c
*
* The program is a C interface to scnrm2.
* It calls the fortran wrapper before calling scnrm2.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
float cblas_scnrm2( const int N, const void *X, const int incX)
{
float nrm2;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_scnrm2_sub( &F77_N, X, &F77_incX, &nrm2);
return nrm2;
}
/*
* cblas_scopy.c
*
* The program is a C interface to scopy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_scopy( const int N, const float *X,
const int incX, float *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_scopy( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_sdot.c
*
* The program is a C interface to sdot.
* It calls the fortran wrapper before calling sdot.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
float cblas_sdot( const int N, const float *X,
const int incX, const float *Y, const int incY)
{
float dot;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_sdot_sub( &F77_N, X, &F77_incX, Y, &F77_incY, &dot);
return dot;
}
/*
* cblas_sdsdot.c
*
* The program is a C interface to sdsdot.
* It calls the fortran wrapper before calling sdsdot.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
float cblas_sdsdot( const int N, const float alpha, const float *X,
const int incX, const float *Y, const int incY)
{
float dot;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_sdsdot_sub( &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, &dot);
return dot;
}
/*
*
* cblas_sgbmv.c
* This program is a C interface to sgbmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU,
const float alpha, const float *A, const int lda,
const float *X, const int incX, const float beta,
float *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
F77_INT F77_KL=KL,F77_KU=KU;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_KL KL
#define F77_KU KU
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_sgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, &alpha,
A, &F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(2, "cblas_sgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_sgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, &alpha,
A ,&F77_lda, X, &F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_sgbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_sgemm.c
* This program is a C interface to sgemm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const float alpha, const float *A,
const int lda, const float *B, const int ldb,
const float beta, float *C, const int ldc)
{
char TA, TB;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_TB;
#else
#define F77_TA &TA
#define F77_TB &TB
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_sgemm",
"Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(3, "cblas_sgemm",
"Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_sgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(2, "cblas_sgemm",
"Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_sgemm",
"Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_sgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
} else
cblas_xerbla(1, "cblas_sgemm",
"Illegal Order setting, %d\n", Order);
}
/*
*
* cblas_sgemv.c
* This program is a C interface to sgemv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const float alpha, const float *A, const int lda,
const float *X, const int incX, const float beta,
float *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_sgemv","Illegal TransA setting, %d\n", TransA);
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_sgemv(F77_TA, &F77_M, &F77_N, &alpha, A, &F77_lda, X, &F77_incX,
&beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(2, "cblas_sgemv", "Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_sgemv(F77_TA, &F77_N, &F77_M, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_sgemv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_sger.c
* This program is a C interface to sger.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
const float alpha, const float *X, const int incX,
const float *Y, const int incY, float *A, const int lda)
{
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
F77_sger( &F77_M, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
}
else if (order == CblasRowMajor)
{
F77_sger( &F77_N, &F77_M, &alpha, Y, &F77_incY, X, &F77_incX, A,
&F77_lda);
}
else cblas_xerbla(1, "cblas_sger", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_snrm2.c
*
* The program is a C interface to snrm2.
* It calls the fortran wrapper before calling snrm2.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
float cblas_snrm2( const int N, const float *X, const int incX)
{
float nrm2;
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_snrm2_sub( &F77_N, X, &F77_incX, &nrm2);
return nrm2;
}
/*
* cblas_srot.c
*
* The program is a C interface to srot.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_srot( const int N, float *X, const int incX, float *Y,
const int incY, const float c, const float s)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_srot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s);
}
/*
* cblas_srotg.c
*
* The program is a C interface to srotg.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_srotg( float *a, float *b, float *c, float *s)
{
F77_srotg(a,b,c,s);
}
/*
* cblas_srotm.c
*
* The program is a C interface to srotm.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_srotm( const int N, float *X, const int incX, float *Y,
const int incY, const float *P)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_srotm( &F77_N, X, &F77_incX, Y, &F77_incY, P);
}
/*
* cblas_srotmg.c
*
* The program is a C interface to srotmg.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_srotmg( float *d1, float *d2, float *b1,
const float b2, float *p)
{
F77_srotmg(d1,d2,b1,&b2,p);
}
/*
*
* cblas_ssbmv.c
* This program is a C interface to ssbmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const int K, const float alpha, const float *A,
const int lda, const float *X, const int incX,
const float beta, float *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ssbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_ssbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_sscal.c
*
* The program is a C interface to sscal.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sscal( const int N, const float alpha, float *X,
const int incX)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_sscal( &F77_N, &alpha, X, &F77_incX);
}
/*
*
* cblas_sspmv.c
* This program is a C interface to sspmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sspmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N,
const float alpha, const float *AP,
const float *X, const int incX, const float beta,
float *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_sspmv(F77_UL, &F77_N, &alpha, AP, X,
&F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_sspmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_sspmv(F77_UL, &F77_N, &alpha,
AP, X,&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_sspmv", "Illegal Order setting, %d\n", order);
}
/*
*
* cblas_sspr.c
* This program is a C interface to sspr.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, float *Ap)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_sspr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_sspr(F77_UL, &F77_N, &alpha, X, &F77_incX, Ap);
} else cblas_xerbla(1, "cblas_sspr", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_sspr2.c
* This program is a C interface to sspr2.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, const float *Y, const int incY, float *A)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_sspr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_sspr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A);
} else cblas_xerbla(1, "cblas_sspr2", "Illegal Order setting, %d\n", order);
}
/*
* cblas_sswap.c
*
* The program is a C interface to sswap.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_sswap( const int N, float *X, const int incX, float *Y,
const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_sswap( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
*
* cblas_ssymm.c
* This program is a C interface to ssymm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const float alpha, const float *A, const int lda,
const float *B, const int ldb, const float beta,
float *C, const int ldc)
{
char SD, UL;
#ifdef F77_CHAR
F77_CHAR F77_SD, F77_UL;
#else
#define F77_SD &SD
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_ssymm",
"Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_ssymm",
"Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_ssymm(F77_SD, F77_UL, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_ssymm",
"Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ssymm",
"Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_ssymm(F77_SD, F77_UL, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else cblas_xerbla(1, "cblas_ssymm",
"Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_ssymv.c
* This program is a C interface to ssymv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssymv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N,
const float alpha, const float *A, const int lda,
const float *X, const int incX, const float beta,
float *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#define F77_incY incY
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssymv(F77_UL, &F77_N, &alpha, A, &F77_lda, X,
&F77_incX, &beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ssymv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssymv(F77_UL, &F77_N, &alpha,
A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY);
}
else cblas_xerbla(1, "cblas_ssymv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ssyr.c
* This program is a C interface to ssyr.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, float *A, const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_lda=lda;
#else
#define F77_N N
#define F77_incX incX
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ssyr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssyr(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
} else cblas_xerbla(1, "cblas_ssyr", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ssyr2.c
* This program is a C interface to ssyr2.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const float alpha, const float *X,
const int incX, const float *Y, const int incY, float *A,
const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77_lda=lda;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasLower) UL = 'U';
else if (Uplo == CblasUpper) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
} else cblas_xerbla(1, "cblas_ssyr2", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ssyr2k.c
* This program is a C interface to ssyr2k.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const float alpha, const float *A, const int lda,
const float *B, const int ldb, const float beta,
float *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_ssyr2k",
"Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_ssyr2k",
"Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ssyr2k",
"Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_ssyr2k",
"Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_ssyr2k(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else cblas_xerbla(1, "cblas_ssyr2k",
"Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_ssyrk.c
* This program is a C interface to ssyrk.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const float alpha, const float *A, const int lda,
const float beta, float *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_ssyrk",
"Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_ssyrk",
"Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ssyrk",
"Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_ssyrk",
"Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
} else cblas_xerbla(1, "cblas_ssyrk",
"Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_stbmv.c
* This program is a C interface to stbmv.
* Written by Keita Teranishi
* 3/3/1998
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const float *A, const int lda,
float *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_stbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_stbsv.c
* The program is a C interface to stbsv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const float *A, const int lda,
float *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_stbsv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_stpmv.c
* This program is a C interface to stpmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *Ap, float *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
}
else cblas_xerbla(1, "cblas_stpmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_stpsv.c
* The program is a C interface to stpsv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *Ap, float *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_stpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_stpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_stpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_stpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
}
else cblas_xerbla(1, "cblas_stpsv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_strmm.c
* This program is a C interface to strmm.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const float alpha, const float *A, const int lda,
float *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_strmm","Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_strmm","Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_strmm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_strmm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_strmm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_strmm","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
&F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_strmm", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_strmv.c
* This program is a C interface to strmv.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *A, const int lda,
float *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_strmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_strmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_strmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_strmv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_strsm.c
* This program is a C interface to strsm.
* Written by Keita Teranishi
* 4/6/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const float alpha, const float *A, const int lda,
float *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_strsm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_strsm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_strsm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_strsm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, &F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_strsm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_strsv.c
* The program is a C interface to strsv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const float *A, const int lda, float *X,
const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_strsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans) TA = 'N';
else
{
cblas_xerbla(3, "cblas_strsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_strsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_strsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else cblas_xerbla(1, "cblas_strsv", "Illegal Order setting, %d\n", order);
return;
}
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_xerbla(int info, const char *rout, const char *form, ...)
{
char empty[1] = "";
va_list argptr;
va_start(argptr, form);
{
if (strstr(rout,"gemm") != 0)
{
if (info == 5 ) info = 4;
else if (info == 4 ) info = 5;
else if (info == 11) info = 9;
else if (info == 9 ) info = 11;
}
else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
{
if (info == 5 ) info = 4;
else if (info == 4 ) info = 5;
}
else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0)
{
if (info == 7 ) info = 6;
else if (info == 6 ) info = 7;
}
else if (strstr(rout,"gemv") != 0)
{
if (info == 4) info = 3;
else if (info == 3) info = 4;
}
else if (strstr(rout,"gbmv") != 0)
{
if (info == 4) info = 3;
else if (info == 3) info = 4;
else if (info == 6) info = 5;
else if (info == 5) info = 6;
}
else if (strstr(rout,"ger") != 0)
{
if (info == 3) info = 2;
else if (info == 2) info = 3;
else if (info == 8) info = 6;
else if (info == 6) info = 8;
}
else if ( (strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0)
&& strstr(rout,"her2k") == 0 )
{
if (info == 8) info = 6;
else if (info == 6) info = 8;
}
}
if (info)
fprintf(stderr, "Parameter %d to routine %s was incorrect\n", info, rout);
vfprintf(stderr, form, argptr);
va_end(argptr);
if (info && !info)
F77_xerbla(empty, &info); /* Force link of our F77 error handler */
exit(-1);
}
/*
* cblas_zaxpy.c
*
* The program is a C interface to zaxpy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zaxpy( const int N, const void *alpha, const void *X,
const int incX, void *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_zaxpy( &F77_N, alpha, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_zcopy.c
*
* The program is a C interface to zcopy.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zcopy( const int N, const void *X,
const int incX, void *Y, const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_zcopy( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
* cblas_zdotc_sub.c
*
* The program is a C interface to zdotc.
* It calls the fortran wrapper before calling zdotc.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zdotc_sub( const int N, const void *X, const int incX,
const void *Y, const int incY, void *dotc)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_zdotc_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotc);
return;
}
/*
* cblas_zdotu_sub.c
*
* The program is a C interface to zdotu.
* It calls the fortran wrapper before calling zdotu.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zdotu_sub( const int N, const void *X, const int incX,
const void *Y, const int incY, void *dotu)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_zdotu_sub( &F77_N, X, &F77_incX, Y, &F77_incY, dotu);
return;
}
/*
* cblas_zdscal.c
*
* The program is a C interface to zdscal.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zdscal( const int N, const double alpha, void *X,
const int incX)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_zdscal( &F77_N, &alpha, X, &F77_incX);
}
/*
* cblas_zgbmv.c
* The program is a C interface of zgbmv
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zgbmv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const int KL, const int KU,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
F77_INT F77_KL=KL,F77_KU=KU;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_KL KL
#define F77_KU KU
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
double ALPHA[2],BETA[2];
int tincY, tincx;
double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_zgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, alpha,
A, &F77_lda, X, &F77_incX, beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
TA = 'N';
if (M > 0)
{
n = M << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if( incY > 0 )
tincY = incY;
else
tincY = -incY;
y++;
if (N > 0)
{
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
}
}
else x = (double *) X;
}
else
{
cblas_xerbla(2, "cblas_zgbmv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
if (TransA == CblasConjTrans)
F77_zgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, ALPHA,
A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
else
F77_zgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, alpha,
A ,&F77_lda, x,&F77_incX, beta, Y, &F77_incY);
if (TransA == CblasConjTrans)
{
if (x != X) free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
}
else cblas_xerbla(1, "cblas_zgbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_zgemm.c
* This program is a C interface to zgemm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
const int K, const void *alpha, const void *A,
const int lda, const void *B, const int ldb,
const void *beta, void *C, const int ldc)
{
char TA, TB;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_TB;
#else
#define F77_TA &TA
#define F77_TB &TB
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if(TransA == CblasTrans) TA='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TB='T';
else if ( TransB == CblasConjTrans ) TB='C';
else if ( TransB == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_zgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, alpha, A,
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if(TransA == CblasTrans) TB='T';
else if ( TransA == CblasConjTrans ) TB='C';
else if ( TransA == CblasNoTrans ) TB='N';
else
{
cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA);
return;
}
if(TransB == CblasTrans) TA='T';
else if ( TransB == CblasConjTrans ) TA='C';
else if ( TransB == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(2, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
F77_TB = C2F_CHAR(&TB);
#endif
F77_zgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B,
&F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_zgemm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_zgemv.c
* The program is a C interface of zgemv
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zgemv(const enum CBLAS_ORDER order,
const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char TA;
#ifdef F77_CHAR
F77_CHAR F77_TA;
#else
#define F77_TA &TA
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
double ALPHA[2],BETA[2];
int tincY, tincx;
double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
F77_zgemv(F77_TA, &F77_M, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
TA = 'N';
if (M > 0)
{
n = M << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
if (N > 0)
{
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
}
}
else x = (double *) X;
}
else
{
cblas_xerbla(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA);
return;
}
#ifdef F77_CHAR
F77_TA = C2F_CHAR(&TA);
#endif
if (TransA == CblasConjTrans)
F77_zgemv(F77_TA, &F77_N, &F77_M, ALPHA, A, &F77_lda, x,
&F77_incX, BETA, Y, &F77_incY);
else
F77_zgemv(F77_TA, &F77_N, &F77_M, alpha, A, &F77_lda, x,
&F77_incX, beta, Y, &F77_incY);
if (TransA == CblasConjTrans)
{
if (x != (double *)X) free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
}
else cblas_xerbla(1, "cblas_zgemv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_zgerc.c
* The program is a C interface to zgerc.
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zgerc(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda)
{
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_incX incX
#define F77_incY incy
#define F77_lda lda
#endif
int n, i, tincy, incy=incY;
double *y=(double *)Y, *yy=(double *)Y, *ty, *st;
if (order == CblasColMajor)
{
F77_zgerc( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
} else if (order == CblasRowMajor)
{
if (N > 0)
{
n = N << 1;
y = malloc(n*sizeof(double));
ty = y;
if( incY > 0 ) {
i = incY << 1;
tincy = 2;
st= y+n;
} else {
i = incY *(-2);
tincy = -2;
st = y-2;
y +=(n-2);
}
do
{
*y = *yy;
y[1] = -yy[1];
y += tincy ;
yy += i;
}
while (y != st);
y = ty;
#ifdef F77_INT
F77_incY = 1;
#else
incy = 1;
#endif
}
else y = (double *) Y;
F77_zgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
&F77_lda);
if(Y!=y)
free(y);
} else cblas_xerbla(1, "cblas_zgerc", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_zgeru.c
* The program is a C interface to zgeru.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zgeru(const enum CBLAS_ORDER order, const int M, const int N,
const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda)
{
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_M M
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#define F77_lda lda
#endif
if (order == CblasColMajor)
{
F77_zgeru( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
&F77_lda);
}
else if (order == CblasRowMajor)
{
F77_zgeru( &F77_N, &F77_M, alpha, Y, &F77_incY, X, &F77_incX, A,
&F77_lda);
}
else cblas_xerbla(1, "cblas_zgeru", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_zhbmv.c
* The program is a C interface to zhbmv
*
* Keita Teranishi 5/18/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
#include <stdio.h>
#include <stdlib.h>
void cblas_zhbmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo,const int N,const int K,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
double ALPHA[2],BETA[2];
int tincY, tincx;
double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
&F77_incX, beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
} else
x = (double *) X;
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhbmv(F77_UL, &F77_N, &F77_K, ALPHA,
A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
}
else
{
cblas_xerbla(1, "cblas_zhbmv","Illegal Order setting, %d\n", order);
return;
}
if ( order == CblasRowMajor )
{
if(X!=x)
free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
return;
}
/*
*
* cblas_zhemm.c
* This program is a C interface to zhemm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zhemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc)
{
char SD, UL;
#ifdef F77_CHAR
F77_CHAR F77_SD, F77_UL;
#else
#define F77_SD &SD
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_zhemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_zhemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
&F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_zhemm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_zhemv.c
* The program is a C interface to zhemv
*
* Keita Teranishi 5/18/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zhemv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo, const int N,
const void *alpha, const void *A, const int lda,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
double ALPHA[2],BETA[2];
int tincY, tincx;
double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_zhemv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhemv(F77_UL, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
} else
x = (double *) X;
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhemv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhemv(F77_UL, &F77_N, ALPHA, A, &F77_lda, x, &F77_incX,
BETA, Y, &F77_incY);
}
else
{
cblas_xerbla(1, "cblas_zhemv","Illegal Order setting, %d\n", order);
return;
}
if ( order == CblasRowMajor )
{
if ( X != x )
free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
return;
}
/*
* cblas_zher.c
* The program is a C interface to zher.
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const void *X, const int incX
,void *A, const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#endif
int n, i, tincx, incx=incX;
double *x=(double *)X, *xx=(double *)X, *tx, *st;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zher","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zher(F77_UL, &F77_N, &alpha, X, &F77_incX, A, &F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zher","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
}
else x = (double *) X;
F77_zher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda);
} else cblas_xerbla(1, "cblas_zher", "Illegal Order setting, %d\n", order);
if(X!=x)
free(x);
return;
}
/*
* cblas_zher2.c
* The program is a C interface to zher2.
*
* Keita Teranishi 3/23/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const void *alpha, const void *X, const int incX,
const void *Y, const int incY, void *A, const int lda)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incx
#define F77_incY incy
#endif
int n, i, j, tincx, tincy, incx=incX, incy=incY;
double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
*yy=(double *)Y, *tx, *ty, *stx, *sty;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zher2(F77_UL, &F77_N, alpha, X, &F77_incX,
Y, &F77_incY, A, &F77_lda);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
y = malloc(n*sizeof(double));
tx = x;
ty = y;
if( incX > 0 ) {
i = incX << 1 ;
tincx = 2;
stx= x+n;
} else {
i = incX *(-2);
tincx = -2;
stx = x-2;
x +=(n-2);
}
if( incY > 0 ) {
j = incY << 1;
tincy = 2;
sty= y+n;
} else {
j = incY *(-2);
tincy = -2;
sty = y-2;
y +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != stx);
do
{
*y = *yy;
y[1] = -yy[1];
y += tincy ;
yy += j;
}
while (y != sty);
x=tx;
y=ty;
#ifdef F77_INT
F77_incX = 1;
F77_incY = 1;
#else
incx = 1;
incy = 1;
#endif
} else
{
x = (double *) X;
y = (double *) Y;
}
F77_zher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
&F77_incX, A, &F77_lda);
}
else
{
cblas_xerbla(1, "cblas_zher2", "Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
if(Y!=y)
free(y);
return;
}
/*
*
* cblas_zher2k.c
* This program is a C interface to zher2k.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const double beta,
void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
double ALPHA[2];
const double *alp=(double *)alpha;
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_zher2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='C';
else
{
cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
F77_zher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
} else cblas_xerbla(1, "cblas_zher2k", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_zherk.c
* This program is a C interface to zherk.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const double alpha, const void *A, const int lda,
const double beta, void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
&beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='C';
else
{
cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda,
&beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_zherk", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_zhpmv.c
* The program is a C interface of zhpmv
*
* Keita Teranishi 5/18/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zhpmv(const enum CBLAS_ORDER order,
const enum CBLAS_UPLO Uplo,const int N,
const void *alpha, const void *AP,
const void *X, const int incX, const void *beta,
void *Y, const int incY)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incx
#define F77_incY incY
#endif
int n, i=0, incx=incX;
const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
double ALPHA[2],BETA[2];
int tincY, tincx;
double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhpmv","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhpmv(F77_UL, &F77_N, alpha, AP, X,
&F77_incX, beta, Y, &F77_incY);
}
else if (order == CblasRowMajor)
{
ALPHA[0]= *alp;
ALPHA[1]= -alp[1];
BETA[0]= *bet;
BETA[1]= -bet[1];
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
if(incY > 0)
tincY = incY;
else
tincY = -incY;
y++;
i = tincY << 1;
n = i * N ;
st = y + n;
do {
*y = -(*y);
y += i;
} while(y != st);
y -= n;
} else
x = (double *) X;
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhpmv","Illegal Uplo setting, %d\n", Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhpmv(F77_UL, &F77_N, ALPHA,
AP, x, &F77_incX, BETA, Y, &F77_incY);
}
else
{
cblas_xerbla(1, "cblas_zhpmv","Illegal Order setting, %d\n", order);
return;
}
if ( order == CblasRowMajor )
{
if(X!=x)
free(x);
if (N > 0)
{
do
{
*y = -(*y);
y += i;
}
while (y != st);
}
}
return;
}
/*
* cblas_zhpr.c
* The program is a C interface to zhpr.
*
* Keita Teranishi 3/23/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zhpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N, const double alpha, const void *X,
const int incX, void *A)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incx
#endif
int n, i, tincx, incx=incX;
double *x=(double *)X, *xx=(double *)X, *tx, *st;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhpr","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhpr","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
tx = x;
if( incX > 0 ) {
i = incX << 1;
tincx = 2;
st= x+n;
} else {
i = incX *(-2);
tincx = -2;
st = x-2;
x +=(n-2);
}
do
{
*x = *xx;
x[1] = -xx[1];
x += tincx ;
xx += i;
}
while (x != st);
x=tx;
#ifdef F77_INT
F77_incX = 1;
#else
incx = 1;
#endif
}
else x = (double *) X;
F77_zhpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
} else
{
cblas_xerbla(1, "cblas_zhpr","Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
return;
}
/*
* cblas_zhpr2.c
* The program is a C interface to zhpr2.
*
* Keita Teranishi 5/20/98
*
*/
#include <stdio.h>
#include <stdlib.h>
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const int N,const void *alpha, const void *X,
const int incX,const void *Y, const int incY, void *Ap)
{
char UL;
#ifdef F77_CHAR
F77_CHAR F77_UL;
#else
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incx
#define F77_incY incy
#endif
int n, i, j, incx=incX, incy=incY;
double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
*yy=(double *)Y, *stx, *sty;
if (order == CblasColMajor)
{
if (Uplo == CblasLower) UL = 'L';
else if (Uplo == CblasUpper) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n",Uplo );
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
F77_zhpr2(F77_UL, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, Ap);
} else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
#endif
if (N > 0)
{
n = N << 1;
x = malloc(n*sizeof(double));
y = malloc(n*sizeof(double));
stx = x + n;
sty = y + n;
if( incX > 0 )
i = incX << 1;
else
i = incX *(-2);
if( incY > 0 )
j = incY << 1;
else
j = incY *(-2);
do
{
*x = *xx;
x[1] = -xx[1];
x += 2;
xx += i;
} while (x != stx);
do
{
*y = *yy;
y[1] = -yy[1];
y += 2;
yy += j;
}
while (y != sty);
x -= n;
y -= n;
#ifdef F77_INT
if(incX > 0 )
F77_incX = 1;
else
F77_incX = -1;
if(incY > 0 )
F77_incY = 1;
else
F77_incY = -1;
#else
if(incX > 0 )
incx = 1;
else
incx = -1;
if(incY > 0 )
incy = 1;
else
incy = -1;
#endif
} else
{
x = (double *) X;
y = (void *) Y;
}
F77_zhpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
}
else
{
cblas_xerbla(1, "cblas_zhpr2","Illegal Order setting, %d\n", order);
return;
}
if(X!=x)
free(x);
if(Y!=y)
free(y);
return;
}
/*
* cblas_zscal.c
*
* The program is a C interface to zscal.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zscal( const int N, const void *alpha, void *X,
const int incX)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
F77_zscal( &F77_N, alpha, X, &F77_incX);
}
/*
* cblas_zswap.c
*
* The program is a C interface to zswap.
*
* Written by Keita Teranishi. 2/11/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zswap( const int N, void *X, const int incX, void *Y,
const int incY)
{
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
#else
#define F77_N N
#define F77_incX incX
#define F77_incY incY
#endif
F77_zswap( &F77_N, X, &F77_incX, Y, &F77_incY);
}
/*
*
* cblas_zsymm.c
* This program is a C interface to zsymm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const int M, const int N,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc)
{
char SD, UL;
#ifdef F77_CHAR
F77_CHAR F77_SD, F77_UL;
#else
#define F77_SD &SD
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_zsymm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_zsymm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_zsymm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_SD = C2F_CHAR(&SD);
#endif
F77_zsymm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_zsymm", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_zsyr2k.c
* This program is a C interface to zsyr2k.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *B, const int ldb, const void *beta,
void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldb ldb
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_zsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
B, &F77_ldb, beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_zsyr2k", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_zsyr2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_zsyr2k", "Illegal Order setting, %d\n", Order);
return;
}
/*
*
* cblas_zsyrk.c
* This program is a C interface to zsyrk.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_zsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *beta, void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_zsyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_zsyrk", "Illegal Trans setting, %d\n", Trans);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_zsyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_zsyrk", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_ztbmv.c
* The program is a C interface to ztbmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
double *st=0, *x=(double *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztbmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if(incX > 0)
tincX = incX;
else
tincX = -incX;
i = tincX << 1;
n = i * N;
x++;
st = x + n;
do
{
*x = -(*x);
x+= i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ztbmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ztbmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_ztbsv.c
* The program is a C interface to ztbsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const int K, const void *A, const int lda,
void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
double *st=0,*x=(double *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if ( incX > 0 )
tincX = incX;
else
tincX = -incX;
n = N*2*(tincX);
x++;
st=x+n;
i = tincX << 1;
do
{
*x = -(*x);
x+=i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x+= i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ztbsv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_ztpmv.c
* The program is a C interface to ztpmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
int n, i=0, tincX;
double *st=0,*x=(double *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ztpmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if(incX > 0)
tincX = incX;
else
tincX = -incX;
i = tincX << 1;
n = i * N;
x++;
st = x + n;
do
{
*x = -(*x);
x += i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ztpmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztpmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ztpmv", "Illegal Order setting, %d\n", order);
return;
}
/*
* cblas_ztpsv.c
* The program is a C interface to ztpsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *Ap, void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_incX=incX;
#else
#define F77_N N
#define F77_incX incX
#endif
int n, i=0, tincX;
double *st=0, *x=(double*)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ztpsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if ( incX > 0 )
tincX = incX;
else
tincX = -incX;
n = N*2*(tincX);
x++;
st=x+n;
i = tincX << 1;
do
{
*x = -(*x);
x+=i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ztpsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztpsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ztpsv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ztrmm.c
* This program is a C interface to ztrmm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight ) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper ) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans ) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A, &F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight ) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_ztrmm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper ) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ztrmm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans ) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ztrmm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ztrmm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_ztrmm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_ztrmv.c
* The program is a C interface to ztrmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda,
void *X, const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
double *st=0,*x=(double *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ztrmv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if(incX > 0)
tincX = incX;
else
tincX = -incX;
i = tincX << 1;
n = i * N;
x++;
st = x + n;
do
{
*x = -(*x);
x += i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ztrmv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztrmv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ztrmv", "Illegal Order setting, %d\n", order);
return;
}
/*
*
* cblas_ztrsm.c
* This program is a C interface to ztrsm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
const enum CBLAS_DIAG Diag, const int M, const int N,
const void *alpha, const void *A, const int lda,
void *B, const int ldb)
{
char UL, TA, SD, DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if( Order == CblasColMajor )
{
if( Side == CblasRight) SD='R';
else if ( Side == CblasLeft ) SD='L';
else
{
cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A,
&F77_lda, B, &F77_ldb);
} else if (Order == CblasRowMajor)
{
if( Side == CblasRight) SD='L';
else if ( Side == CblasLeft ) SD='R';
else
{
cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side);
return;
}
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo);
return;
}
if( TransA == CblasTrans) TA ='T';
else if ( TransA == CblasConjTrans ) TA='C';
else if ( TransA == CblasNoTrans ) TA='N';
else
{
cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA);
return;
}
if( Diag == CblasUnit ) DI='U';
else if ( Diag == CblasNonUnit ) DI='N';
else
{
cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_SD = C2F_CHAR(&SD);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A,
&F77_lda, B, &F77_ldb);
}
else cblas_xerbla(1, "cblas_ztrsm", "Illegal Order setting, %d\n", Order);
return;
}
/*
* cblas_ztrsv.c
* The program is a C interface to ztrsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void cblas_ztrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
const int N, const void *A, const int lda, void *X,
const int incX)
{
char TA;
char UL;
char DI;
#ifdef F77_CHAR
F77_CHAR F77_TA, F77_UL, F77_DI;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
int n, i=0, tincX;
double *st=0,*x=(double *)X;
if (order == CblasColMajor)
{
if (Uplo == CblasUpper) UL = 'U';
else if (Uplo == CblasLower) UL = 'L';
else
{
cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'N';
else if (TransA == CblasTrans) TA = 'T';
else if (TransA == CblasConjTrans) TA = 'C';
else
{
cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
}
else if (order == CblasRowMajor)
{
if (Uplo == CblasUpper) UL = 'L';
else if (Uplo == CblasLower) UL = 'U';
else
{
cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo);
return;
}
if (TransA == CblasNoTrans) TA = 'T';
else if (TransA == CblasTrans) TA = 'N';
else if (TransA == CblasConjTrans)
{
TA = 'N';
if ( N > 0)
{
if ( incX > 0 )
tincX = incX;
else
tincX = -incX;
n = N*2*(tincX);
x++;
st=x+n;
i = tincX << 1;
do
{
*x = -(*x);
x+=i;
}
while (x != st);
x -= n;
}
}
else
{
cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA);
return;
}
if (Diag == CblasUnit) DI = 'U';
else if (Diag == CblasNonUnit) DI = 'N';
else
{
cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag);
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TA = C2F_CHAR(&TA);
F77_DI = C2F_CHAR(&DI);
#endif
F77_ztrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
&F77_incX);
if (TransA == CblasConjTrans)
{
if (N > 0)
{
do
{
*x = -(*x);
x += i;
}
while (x != st);
}
}
}
else cblas_xerbla(1, "cblas_ztrsv", "Illegal Order setting, %d\n", order);
return;
}
c cdotcsub.f
c
c The program is a fortran wrapper for cdotc.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine cdotcsub(n,x,incx,y,incy,dotc)
c
external cdotc
complex cdotc,dotc
integer n,incx,incy
complex x(*),y(*)
c
dotc=cdotc(n,x,incx,y,incy)
return
end
c cdotusub.f
c
c The program is a fortran wrapper for cdotu.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine cdotusub(n,x,incx,y,incy,dotu)
c
external cdotu
complex cdotu,dotu
integer n,incx,incy
complex x(*),y(*)
c
dotu=cdotu(n,x,incx,y,incy)
return
end
c dasumsun.f
c
c The program is a fortran wrapper for dasum..
c Witten by Keita Teranishi. 2/11/1998
c
subroutine dasumsub(n,x,incx,asum)
c
external dasum
double precision dasum,asum
integer n,incx
double precision x(*)
c
asum=dasum(n,x,incx)
return
end
c ddotsub.f
c
c The program is a fortran wrapper for ddot.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine ddotsub(n,x,incx,y,incy,dot)
c
external ddot
double precision ddot
integer n,incx,incy
double precision x(*),y(*),dot
c
dot=ddot(n,x,incx,y,incy)
return
end
c dnrm2sub.f
c
c The program is a fortran wrapper for dnrm2.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine dnrm2sub(n,x,incx,nrm2)
c
external dnrm2
double precision dnrm2,nrm2
integer n,incx
double precision x(*)
c
nrm2=dnrm2(n,x,incx)
return
end
c dsdotsub.f
c
c The program is a fortran wrapper for dsdot.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine dsdotsub(n,x,incx,y,incy,dot)
c
external dsdot
double precision dsdot,dot
integer n,incx,incy
real x(*),y(*)
c
dot=dsdot(n,x,incx,y,incy)
return
end
c dzasumsub.f
c
c The program is a fortran wrapper for dzasum.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine dzasumsub(n,x,incx,asum)
c
external dzasum
double precision dzasum,asum
integer n,incx
double complex x(*)
c
asum=dzasum(n,x,incx)
return
end
c dznrm2sub.f
c
c The program is a fortran wrapper for dznrm2.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine dznrm2sub(n,x,incx,nrm2)
c
external dznrm2
double precision dznrm2,nrm2
integer n,incx
double complex x(*)
c
nrm2=dznrm2(n,x,incx)
return
end
c icamaxsub.f
c
c The program is a fortran wrapper for icamax.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine icamaxsub(n,x,incx,iamax)
c
external icamax
integer icamax,iamax
integer n,incx
complex x(*)
c
iamax=icamax(n,x,incx)
return
end
c icamaxsub.f
c
c The program is a fortran wrapper for idamax.
c Witten by Keita Teranishi. 2/22/1998
c
subroutine idamaxsub(n,x,incx,iamax)
c
external idamax
integer idamax,iamax
integer n,incx
double precision x(*)
c
iamax=idamax(n,x,incx)
return
end
c isamaxsub.f
c
c The program is a fortran wrapper for isamax.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine isamaxsub(n,x,incx,iamax)
c
external isamax
integer isamax,iamax
integer n,incx
real x(*)
c
iamax=isamax(n,x,incx)
return
end
c izamaxsub.f
c
c The program is a fortran wrapper for izamax.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine izamaxsub(n,x,incx,iamax)
c
external izamax
integer izamax,iamax
integer n,incx
double complex x(*)
c
iamax=izamax(n,x,incx)
return
end
c sasumsub.f
c
c The program is a fortran wrapper for sasum.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine sasumsub(n,x,incx,asum)
c
external sasum
real sasum,asum
integer n,incx
real x(*)
c
asum=sasum(n,x,incx)
return
end
c scasumsub.f
c
c The program is a fortran wrapper for scasum.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine scasumsub(n,x,incx,asum)
c
external scasum
real scasum,asum
integer n,incx
complex x(*)
c
asum=scasum(n,x,incx)
return
end
c scnrm2sub.f
c
c The program is a fortran wrapper for scnrm2.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine scnrm2sub(n,x,incx,nrm2)
c
external scnrm2
real scnrm2,nrm2
integer n,incx
complex x(*)
c
nrm2=scnrm2(n,x,incx)
return
end
c sdotsub.f
c
c The program is a fortran wrapper for sdot.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine sdotsub(n,x,incx,y,incy,dot)
c
external sdot
real sdot
integer n,incx,incy
real x(*),y(*),dot
c
dot=sdot(n,x,incx,y,incy)
return
end
c sdsdotsub.f
c
c The program is a fortran wrapper for sdsdot.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine sdsdotsub(n,x,incx,y,incy,dot)
c
external sdsdot
real sdsdot,dot
integer n,incx,incy
real x(*),y(*)
c
dot=sdsdot(n,x,incx,y,incy)
return
end
c snrm2sub.f
c
c The program is a fortran wrapper for snrm2.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine snrm2sub(n,x,incx,nrm2)
c
external snrm2
real snrm2,nrm2
integer n,incx
real x(*)
c
nrm2=snrm2(n,x,incx)
return
end
c zdotcsub.f
c
c The program is a fortran wrapper for zdotc.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine zdotcsub(n,x,incx,y,incy,dotc)
c
external zdotc
double complex zdotc,dotc
integer n,incx,incy
double complex x(*),y(*)
c
dotc=zdotc(n,x,incx,y,incy)
return
end
c zdotusub.f
c
c The program is a fortran wrapper for zdotu.
c Witten by Keita Teranishi. 2/11/1998
c
subroutine zdotusub(n,x,incx,y,incy,dotu)
c
external zdotu
double complex zdotu,dotu
integer n,incx,incy
double complex x(*),y(*)
c
dotu=zdotu(n,x,incx,y,incy)
return
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment