1b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse/* 2b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse * 3b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse * cblas_dsbmv.c 4b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse * This program is a C interface to dsbmv. 5b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse * Written by Keita Teranishi 6b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse * 4/6/1998 7b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse * 8b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse */ 9b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse 10b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#include "cblas.h" 11b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#include "cblas_f77.h" 12b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glissevoid cblas_dsbmv(const enum CBLAS_ORDER order, 13b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse const enum CBLAS_UPLO Uplo, const int N, const int K, 14b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse const double alpha, const double *A, const int lda, 15b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse const double *X, const int incX, const double beta, 16b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse double *Y, const int incY) 17b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse{ 18b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse char UL; 19b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#ifdef F77_CHAR 20b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse F77_CHAR F77_UL; 21b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#else 22b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #define F77_UL &UL 23b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#endif 24b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#ifdef F77_INT 25b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY; 26b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#else 27b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #define F77_N N 28b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #define F77_K K 29b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #define F77_lda lda 30b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #define F77_incX incX 31b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #define F77_incY incY 32b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse#endif 33b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse extern int CBLAS_CallFromC; 34b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse extern int RowMajorStrg; 35b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse RowMajorStrg = 0; 36b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse 37b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse CBLAS_CallFromC = 1; 38b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse if (order == CblasColMajor) 39b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse { 40b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse if (Uplo == CblasUpper) UL = 'U'; 41b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse else if (Uplo == CblasLower) UL = 'L'; 42c8d4108fbee679735a1cc3f405d848d01bfb23f6Dave Airlie else 43b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse { 44b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n",Uplo ); 45b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse CBLAS_CallFromC = 0; 46b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse RowMajorStrg = 0; 47b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse return; 48b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse } 49b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #ifdef F77_CHAR 50b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse F77_UL = C2F_CHAR(&UL); 51b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #endif 52b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha, A, &F77_lda, X, 53b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse &F77_incX, &beta, Y, &F77_incY); 54b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse } 55b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse else if (order == CblasRowMajor) 56b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse { 57b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse RowMajorStrg = 1; 58b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse if (Uplo == CblasUpper) UL = 'L'; 59b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse else if (Uplo == CblasLower) UL = 'U'; 60b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse else 615646964b1360883b6254e2ebacc198f43869d36fJerome Glisse { 625646964b1360883b6254e2ebacc198f43869d36fJerome Glisse cblas_xerbla(2, "cblas_dsbmv","Illegal Uplo setting, %d\n", Uplo); 635646964b1360883b6254e2ebacc198f43869d36fJerome Glisse CBLAS_CallFromC = 0; 645646964b1360883b6254e2ebacc198f43869d36fJerome Glisse RowMajorStrg = 0; 65ba7e6ccc95a4e39cd15ca03573b2f6d6f8c9f539Jerome Glisse return; 66b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse } 67b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #ifdef F77_CHAR 68b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse F77_UL = C2F_CHAR(&UL); 69b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse #endif 70b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse F77_dsbmv(F77_UL, &F77_N, &F77_K, &alpha, 71b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse A ,&F77_lda, X,&F77_incX, &beta, Y, &F77_incY); 72b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse } 73b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse else cblas_xerbla(1, "cblas_dsbmv", "Illegal Order setting, %d\n", order); 74b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse CBLAS_CallFromC = 0; 75b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse RowMajorStrg = 0; 76b360c050b60a578ce6c75cbc872dd54999b3f6c5Jerome Glisse return; 77ba7e6ccc95a4e39cd15ca03573b2f6d6f8c9f539Jerome Glisse} 78ba7e6ccc95a4e39cd15ca03573b2f6d6f8c9f539Jerome Glisse