1/*
2 *
3 * cblas_chemm.c
4 * This program is a C interface to chemm.
5 * Written by Keita Teranishi
6 * 4/8/1998
7 *
8 */
9
10#include "cblas.h"
11#include "cblas_f77.h"
12void cblas_chemm(const enum CBLAS_ORDER Order, const  enum CBLAS_SIDE Side,
13                 const enum CBLAS_UPLO Uplo, const int M, const int N,
14                 const void *alpha, const void *A, const int lda,
15                 const void *B, const int ldb, const void *beta,
16                 void *C, const int ldc)
17{
18   char SD, UL;
19#ifdef F77_CHAR
20   F77_CHAR F77_SD, F77_UL;
21#else
22   #define F77_SD &SD
23   #define F77_UL &UL
24#endif
25
26#ifdef F77_INT
27   F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
28   F77_INT F77_ldc=ldc;
29#else
30   #define F77_M M
31   #define F77_N N
32   #define F77_lda lda
33   #define F77_ldb ldb
34   #define F77_ldc ldc
35#endif
36
37   extern int CBLAS_CallFromC;
38   extern int RowMajorStrg;
39   RowMajorStrg = 0;
40   CBLAS_CallFromC = 1;
41
42   if( Order == CblasColMajor )
43   {
44      if( Side == CblasRight) SD='R';
45      else if ( Side == CblasLeft ) SD='L';
46      else
47      {
48         cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
49         CBLAS_CallFromC = 0;
50         RowMajorStrg = 0;
51         return;
52      }
53
54      if( Uplo == CblasUpper) UL='U';
55      else if ( Uplo == CblasLower ) UL='L';
56      else
57      {
58         cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
59         CBLAS_CallFromC = 0;
60         RowMajorStrg = 0;
61         return;
62      }
63
64      #ifdef F77_CHAR
65         F77_UL = C2F_CHAR(&UL);
66         F77_SD = C2F_CHAR(&SD);
67      #endif
68
69      F77_chemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
70                     B, &F77_ldb, beta, C, &F77_ldc);
71   } else if (Order == CblasRowMajor)
72   {
73      RowMajorStrg = 1;
74      if( Side == CblasRight) SD='L';
75      else if ( Side == CblasLeft ) SD='R';
76      else
77      {
78         cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
79         CBLAS_CallFromC = 0;
80         RowMajorStrg = 0;
81         return;
82      }
83
84      if( Uplo == CblasUpper) UL='L';
85      else if ( Uplo == CblasLower ) UL='U';
86      else
87      {
88         cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
89         CBLAS_CallFromC = 0;
90         RowMajorStrg = 0;
91         return;
92      }
93
94      #ifdef F77_CHAR
95         F77_UL = C2F_CHAR(&UL);
96         F77_SD = C2F_CHAR(&SD);
97      #endif
98
99      F77_chemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
100                 &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
101   }
102   else  cblas_xerbla(1, "cblas_chemm", "Illegal Order setting, %d\n", Order);
103   CBLAS_CallFromC = 0;
104   RowMajorStrg = 0;
105   return;
106}
107