Home | History | Annotate | Download | only in src 
      1 /*
      2  *
      3  * cblas_dtrsm.c
      4  * This program is a C interface to dtrsm.
      5  * Written by Keita Teranishi
      6  * 4/6/1998
      7  *
      8  */
      9 
     10 #include "cblas.h"
     11 #include "cblas_f77.h"
     12 void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
     13                  const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
     14                  const enum CBLAS_DIAG Diag, const int M, const int N,
     15                  const double alpha, const double  *A, const int lda,
     16                  double  *B, const int ldb)
     17 
     18 {
     19    char UL, TA, SD, DI;
     20 #ifdef F77_CHAR
     21    F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
     22 #else
     23    #define F77_TA &TA
     24    #define F77_UL &UL
     25    #define F77_SD &SD
     26    #define F77_DI &DI
     27 #endif
     28 
     29 #ifdef F77_INT
     30    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
     31 #else
     32    #define F77_M M
     33    #define F77_N N
     34    #define F77_lda lda
     35    #define F77_ldb ldb
     36 #endif
     37 
     38    extern int CBLAS_CallFromC;
     39    extern int RowMajorStrg;
     40    RowMajorStrg = 0;
     41    CBLAS_CallFromC = 1;
     42 
     43    if( Order == CblasColMajor )
     44    {
     45       if      ( Side == CblasRight) SD='R';
     46       else if ( Side == CblasLeft ) SD='L';
     47       else
     48       {
     49          cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
     50          CBLAS_CallFromC = 0;
     51          RowMajorStrg = 0;
     52          return;
     53       }
     54       if      ( Uplo == CblasUpper) UL='U';
     55       else if ( Uplo == CblasLower) UL='L';
     56       else
     57       {
     58          cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
     59          CBLAS_CallFromC = 0;
     60          RowMajorStrg = 0;
     61          return;
     62       }
     63 
     64       if      ( TransA == CblasTrans    ) TA='T';
     65       else if ( TransA == CblasConjTrans) TA='C';
     66       else if ( TransA == CblasNoTrans  ) TA='N';
     67       else
     68       {
     69          cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
     70          CBLAS_CallFromC = 0;
     71          RowMajorStrg = 0;
     72          return;
     73       }
     74 
     75       if      ( Diag == CblasUnit   ) DI='U';
     76       else if ( Diag == CblasNonUnit) DI='N';
     77       else
     78       {
     79          cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
     80          CBLAS_CallFromC = 0;
     81          RowMajorStrg = 0;
     82          return;
     83       }
     84 
     85       #ifdef F77_CHAR
     86          F77_UL = C2F_CHAR(&UL);
     87          F77_TA = C2F_CHAR(&TA);
     88          F77_SD = C2F_CHAR(&SD);
     89          F77_DI = C2F_CHAR(&DI);
     90       #endif
     91 
     92       F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha,
     93                 A, &F77_lda, B, &F77_ldb);
     94    }
     95    else if (Order == CblasRowMajor)
     96    {
     97       RowMajorStrg = 1;
     98       if      ( Side == CblasRight) SD='L';
     99       else if ( Side == CblasLeft ) SD='R';
    100       else
    101       {
    102          cblas_xerbla(2, "cblas_dtrsm","Illegal Side setting, %d\n", Side);
    103          CBLAS_CallFromC = 0;
    104          RowMajorStrg = 0;
    105          return;
    106       }
    107 
    108       if      ( Uplo == CblasUpper) UL='L';
    109       else if ( Uplo == CblasLower) UL='U';
    110       else
    111       {
    112          cblas_xerbla(3, "cblas_dtrsm","Illegal Uplo setting, %d\n", Uplo);
    113          CBLAS_CallFromC = 0;
    114          RowMajorStrg = 0;
    115          return;
    116       }
    117 
    118       if      ( TransA == CblasTrans    ) TA='T';
    119       else if ( TransA == CblasConjTrans) TA='C';
    120       else if ( TransA == CblasNoTrans  ) TA='N';
    121       else
    122       {
    123          cblas_xerbla(4, "cblas_dtrsm","Illegal Trans setting, %d\n", TransA);
    124          CBLAS_CallFromC = 0;
    125          RowMajorStrg = 0;
    126          return;
    127       }
    128 
    129       if      ( Diag == CblasUnit   ) DI='U';
    130       else if ( Diag == CblasNonUnit) DI='N';
    131       else
    132       {
    133          cblas_xerbla(5, "cblas_dtrsm","Illegal Diag setting, %d\n", Diag);
    134          CBLAS_CallFromC = 0;
    135          RowMajorStrg = 0;
    136          return;
    137       }
    138 
    139       #ifdef F77_CHAR
    140          F77_UL = C2F_CHAR(&UL);
    141          F77_TA = C2F_CHAR(&TA);
    142          F77_SD = C2F_CHAR(&SD);
    143          F77_DI = C2F_CHAR(&DI);
    144       #endif
    145 
    146       F77_dtrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A,
    147                &F77_lda, B, &F77_ldb);
    148    }
    149    else cblas_xerbla(1, "cblas_dtrsm","Illegal Order setting, %d\n", Order);
    150    CBLAS_CallFromC = 0;
    151    RowMajorStrg = 0;
    152    return;
    153 }
    154