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