Home | History | Annotate | Download | only in testing
      1 /*
      2  *     Written by D.P. Manley, Digital Equipment Corporation.
      3  *     Prefixed "C_" to BLAS routines and their declarations.
      4  *
      5  *     Modified by T. H. Do, 4/08/98, SGI/CRAY Research.
      6  */
      7 #include <stdlib.h>
      8 #include "cblas.h"
      9 #include "cblas_test.h"
     10 
     11 void F77_cgemv(int *order, char *transp, int *m, int *n,
     12           const void *alpha,
     13           CBLAS_TEST_COMPLEX *a, int *lda, const void *x, int *incx,
     14           const void *beta, void *y, int *incy) {
     15 
     16   CBLAS_TEST_COMPLEX *A;
     17   int i,j,LDA;
     18   enum CBLAS_TRANSPOSE trans;
     19 
     20   get_transpose_type(transp, &trans);
     21   if (*order == TEST_ROW_MJR) {
     22      LDA = *n+1;
     23      A  = (CBLAS_TEST_COMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_COMPLEX) );
     24      for( i=0; i<*m; i++ )
     25         for( j=0; j<*n; j++ ){
     26            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
     27            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
     28         }
     29      cblas_cgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx,
     30 	    beta, y, *incy );
     31      free(A);
     32   }
     33   else if (*order == TEST_COL_MJR)
     34      cblas_cgemv( CblasColMajor, trans,
     35                   *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
     36   else
     37      cblas_cgemv( UNDEFINED, trans,
     38                   *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
     39 }
     40 
     41 void F77_cgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
     42 	      CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
     43 	      CBLAS_TEST_COMPLEX *x, int *incx,
     44 	      CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy) {
     45 
     46   CBLAS_TEST_COMPLEX *A;
     47   int i,j,irow,jcol,LDA;
     48   enum CBLAS_TRANSPOSE trans;
     49 
     50   get_transpose_type(transp, &trans);
     51   if (*order == TEST_ROW_MJR) {
     52      LDA = *ku+*kl+2;
     53      A=( CBLAS_TEST_COMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_COMPLEX));
     54      for( i=0; i<*ku; i++ ){
     55         irow=*ku+*kl-i;
     56         jcol=(*ku)-i;
     57         for( j=jcol; j<*n; j++ ){
     58            A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
     59            A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
     60         }
     61      }
     62      i=*ku;
     63      irow=*ku+*kl-i;
     64      for( j=0; j<*n; j++ ){
     65         A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
     66         A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
     67      }
     68      for( i=*ku+1; i<*ku+*kl+1; i++ ){
     69         irow=*ku+*kl-i;
     70         jcol=i-(*ku);
     71         for( j=jcol; j<(*n+*kl); j++ ){
     72            A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
     73            A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
     74         }
     75      }
     76      cblas_cgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x,
     77 		  *incx, beta, y, *incy );
     78      free(A);
     79   }
     80   else if (*order == TEST_COL_MJR)
     81      cblas_cgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
     82 		  *incx, beta, y, *incy );
     83   else
     84      cblas_cgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
     85 		  *incx, beta, y, *incy );
     86 }
     87 
     88 void F77_cgeru(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha,
     89 	 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
     90          CBLAS_TEST_COMPLEX *a, int *lda){
     91 
     92   CBLAS_TEST_COMPLEX *A;
     93   int i,j,LDA;
     94 
     95   if (*order == TEST_ROW_MJR) {
     96      LDA = *n+1;
     97      A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
     98      for( i=0; i<*m; i++ )
     99         for( j=0; j<*n; j++ ){
    100            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    101            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    102      }
    103      cblas_cgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
    104      for( i=0; i<*m; i++ )
    105         for( j=0; j<*n; j++ ){
    106            a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
    107            a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
    108         }
    109      free(A);
    110   }
    111   else if (*order == TEST_COL_MJR)
    112      cblas_cgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
    113   else
    114      cblas_cgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
    115 }
    116 
    117 void F77_cgerc(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha,
    118 	 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
    119          CBLAS_TEST_COMPLEX *a, int *lda) {
    120   CBLAS_TEST_COMPLEX *A;
    121   int i,j,LDA;
    122 
    123   if (*order == TEST_ROW_MJR) {
    124      LDA = *n+1;
    125      A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
    126      for( i=0; i<*m; i++ )
    127         for( j=0; j<*n; j++ ){
    128            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    129            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    130         }
    131      cblas_cgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
    132      for( i=0; i<*m; i++ )
    133         for( j=0; j<*n; j++ ){
    134            a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
    135            a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
    136         }
    137      free(A);
    138   }
    139   else if (*order == TEST_COL_MJR)
    140      cblas_cgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
    141   else
    142      cblas_cgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
    143 }
    144 
    145 void F77_chemv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
    146       CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
    147       int *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
    148 
    149   CBLAS_TEST_COMPLEX *A;
    150   int i,j,LDA;
    151   enum CBLAS_UPLO uplo;
    152 
    153   get_uplo_type(uplow,&uplo);
    154 
    155   if (*order == TEST_ROW_MJR) {
    156      LDA = *n+1;
    157      A = (CBLAS_TEST_COMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
    158      for( i=0; i<*n; i++ )
    159         for( j=0; j<*n; j++ ){
    160            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    161            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    162      }
    163      cblas_chemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx,
    164 	    beta, y, *incy );
    165      free(A);
    166   }
    167   else if (*order == TEST_COL_MJR)
    168      cblas_chemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx,
    169 	   beta, y, *incy );
    170   else
    171      cblas_chemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
    172 	   beta, y, *incy );
    173 }
    174 
    175 void F77_chbmv(int *order, char *uplow, int *n, int *k,
    176      CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
    177      CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta,
    178      CBLAS_TEST_COMPLEX *y, int *incy){
    179 
    180 CBLAS_TEST_COMPLEX *A;
    181 int i,irow,j,jcol,LDA;
    182 
    183   enum CBLAS_UPLO uplo;
    184 
    185   get_uplo_type(uplow,&uplo);
    186 
    187   if (*order == TEST_ROW_MJR) {
    188      if (uplo != CblasUpper && uplo != CblasLower )
    189         cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x,
    190 		 *incx, beta, y, *incy );
    191      else {
    192         LDA = *k+2;
    193         A =(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
    194         if (uplo == CblasUpper) {
    195            for( i=0; i<*k; i++ ){
    196               irow=*k-i;
    197               jcol=(*k)-i;
    198               for( j=jcol; j<*n; j++ ) {
    199                  A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
    200                  A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
    201               }
    202            }
    203            i=*k;
    204            irow=*k-i;
    205            for( j=0; j<*n; j++ ) {
    206               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
    207               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
    208            }
    209         }
    210         else {
    211            i=0;
    212            irow=*k-i;
    213            for( j=0; j<*n; j++ ) {
    214               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
    215               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
    216            }
    217            for( i=1; i<*k+1; i++ ){
    218               irow=*k-i;
    219               jcol=i;
    220               for( j=jcol; j<(*n+*k); j++ ) {
    221                  A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
    222                  A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
    223               }
    224            }
    225         }
    226         cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx,
    227        		     beta, y, *incy );
    228         free(A);
    229       }
    230    }
    231    else if (*order == TEST_COL_MJR)
    232      cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
    233                  beta, y, *incy );
    234    else
    235      cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
    236                  beta, y, *incy );
    237 }
    238 
    239 void F77_chpmv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
    240      CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx,
    241      CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
    242 
    243   CBLAS_TEST_COMPLEX *A, *AP;
    244   int i,j,k,LDA;
    245   enum CBLAS_UPLO uplo;
    246 
    247   get_uplo_type(uplow,&uplo);
    248   if (*order == TEST_ROW_MJR) {
    249      if (uplo != CblasUpper && uplo != CblasLower )
    250         cblas_chpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx,
    251 	         beta, y, *incy);
    252      else {
    253         LDA = *n;
    254         A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ));
    255         AP = (CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
    256 	        sizeof( CBLAS_TEST_COMPLEX ));
    257         if (uplo == CblasUpper) {
    258            for( j=0, k=0; j<*n; j++ )
    259               for( i=0; i<j+1; i++, k++ ) {
    260                  A[ LDA*i+j ].real=ap[ k ].real;
    261                  A[ LDA*i+j ].imag=ap[ k ].imag;
    262               }
    263            for( i=0, k=0; i<*n; i++ )
    264               for( j=i; j<*n; j++, k++ ) {
    265                  AP[ k ].real=A[ LDA*i+j ].real;
    266                  AP[ k ].imag=A[ LDA*i+j ].imag;
    267               }
    268         }
    269         else {
    270            for( j=0, k=0; j<*n; j++ )
    271               for( i=j; i<*n; i++, k++ ) {
    272                  A[ LDA*i+j ].real=ap[ k ].real;
    273                  A[ LDA*i+j ].imag=ap[ k ].imag;
    274               }
    275            for( i=0, k=0; i<*n; i++ )
    276               for( j=0; j<i+1; j++, k++ ) {
    277 	         AP[ k ].real=A[ LDA*i+j ].real;
    278 	         AP[ k ].imag=A[ LDA*i+j ].imag;
    279               }
    280         }
    281         cblas_chpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y,
    282                      *incy );
    283         free(A);
    284         free(AP);
    285      }
    286   }
    287   else if (*order == TEST_COL_MJR)
    288      cblas_chpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
    289                   *incy );
    290   else
    291      cblas_chpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
    292                   *incy );
    293 }
    294 
    295 void F77_ctbmv(int *order, char *uplow, char *transp, char *diagn,
    296      int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
    297      int *incx) {
    298   CBLAS_TEST_COMPLEX *A;
    299   int irow, jcol, i, j, LDA;
    300   enum CBLAS_TRANSPOSE trans;
    301   enum CBLAS_UPLO uplo;
    302   enum CBLAS_DIAG diag;
    303 
    304   get_transpose_type(transp,&trans);
    305   get_uplo_type(uplow,&uplo);
    306   get_diag_type(diagn,&diag);
    307 
    308   if (*order == TEST_ROW_MJR) {
    309      if (uplo != CblasUpper && uplo != CblasLower )
    310         cblas_ctbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
    311 	x, *incx);
    312      else {
    313         LDA = *k+2;
    314         A=(CBLAS_TEST_COMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
    315         if (uplo == CblasUpper) {
    316            for( i=0; i<*k; i++ ){
    317               irow=*k-i;
    318               jcol=(*k)-i;
    319               for( j=jcol; j<*n; j++ ) {
    320                  A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
    321                  A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
    322               }
    323            }
    324            i=*k;
    325            irow=*k-i;
    326            for( j=0; j<*n; j++ ) {
    327               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
    328               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
    329            }
    330         }
    331         else {
    332           i=0;
    333           irow=*k-i;
    334           for( j=0; j<*n; j++ ) {
    335              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
    336              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
    337           }
    338           for( i=1; i<*k+1; i++ ){
    339              irow=*k-i;
    340              jcol=i;
    341              for( j=jcol; j<(*n+*k); j++ ) {
    342                 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
    343                 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
    344              }
    345           }
    346         }
    347         cblas_ctbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x,
    348 		    *incx);
    349         free(A);
    350      }
    351    }
    352    else if (*order == TEST_COL_MJR)
    353      cblas_ctbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
    354    else
    355      cblas_ctbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
    356 }
    357 
    358 void F77_ctbsv(int *order, char *uplow, char *transp, char *diagn,
    359       int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
    360       int *incx) {
    361 
    362   CBLAS_TEST_COMPLEX *A;
    363   int irow, jcol, i, j, LDA;
    364   enum CBLAS_TRANSPOSE trans;
    365   enum CBLAS_UPLO uplo;
    366   enum CBLAS_DIAG diag;
    367 
    368   get_transpose_type(transp,&trans);
    369   get_uplo_type(uplow,&uplo);
    370   get_diag_type(diagn,&diag);
    371 
    372   if (*order == TEST_ROW_MJR) {
    373      if (uplo != CblasUpper && uplo != CblasLower )
    374         cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x,
    375 	         *incx);
    376      else {
    377         LDA = *k+2;
    378         A=(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
    379         if (uplo == CblasUpper) {
    380            for( i=0; i<*k; i++ ){
    381               irow=*k-i;
    382               jcol=(*k)-i;
    383               for( j=jcol; j<*n; j++ ) {
    384                  A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
    385                  A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
    386               }
    387            }
    388            i=*k;
    389            irow=*k-i;
    390            for( j=0; j<*n; j++ ) {
    391               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
    392               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
    393            }
    394         }
    395         else {
    396            i=0;
    397            irow=*k-i;
    398            for( j=0; j<*n; j++ ) {
    399              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
    400              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
    401            }
    402            for( i=1; i<*k+1; i++ ){
    403               irow=*k-i;
    404               jcol=i;
    405               for( j=jcol; j<(*n+*k); j++ ) {
    406 	         A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
    407                  A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
    408               }
    409            }
    410         }
    411         cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA,
    412 		    x, *incx);
    413         free(A);
    414      }
    415   }
    416   else if (*order == TEST_COL_MJR)
    417      cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
    418   else
    419      cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
    420 }
    421 
    422 void F77_ctpmv(int *order, char *uplow, char *transp, char *diagn,
    423       int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
    424   CBLAS_TEST_COMPLEX *A, *AP;
    425   int i, j, k, LDA;
    426   enum CBLAS_TRANSPOSE trans;
    427   enum CBLAS_UPLO uplo;
    428   enum CBLAS_DIAG diag;
    429 
    430   get_transpose_type(transp,&trans);
    431   get_uplo_type(uplow,&uplo);
    432   get_diag_type(diagn,&diag);
    433 
    434   if (*order == TEST_ROW_MJR) {
    435      if (uplo != CblasUpper && uplo != CblasLower )
    436         cblas_ctpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
    437      else {
    438         LDA = *n;
    439         A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
    440         AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
    441 	 	sizeof(CBLAS_TEST_COMPLEX));
    442         if (uplo == CblasUpper) {
    443            for( j=0, k=0; j<*n; j++ )
    444               for( i=0; i<j+1; i++, k++ ) {
    445                  A[ LDA*i+j ].real=ap[ k ].real;
    446                  A[ LDA*i+j ].imag=ap[ k ].imag;
    447               }
    448            for( i=0, k=0; i<*n; i++ )
    449               for( j=i; j<*n; j++, k++ ) {
    450                  AP[ k ].real=A[ LDA*i+j ].real;
    451                  AP[ k ].imag=A[ LDA*i+j ].imag;
    452               }
    453         }
    454         else {
    455            for( j=0, k=0; j<*n; j++ )
    456               for( i=j; i<*n; i++, k++ ) {
    457                  A[ LDA*i+j ].real=ap[ k ].real;
    458 	         A[ LDA*i+j ].imag=ap[ k ].imag;
    459               }
    460            for( i=0, k=0; i<*n; i++ )
    461               for( j=0; j<i+1; j++, k++ ) {
    462                  AP[ k ].real=A[ LDA*i+j ].real;
    463 	         AP[ k ].imag=A[ LDA*i+j ].imag;
    464               }
    465         }
    466         cblas_ctpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
    467         free(A);
    468         free(AP);
    469      }
    470   }
    471   else if (*order == TEST_COL_MJR)
    472      cblas_ctpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
    473   else
    474      cblas_ctpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
    475 }
    476 
    477 void F77_ctpsv(int *order, char *uplow, char *transp, char *diagn,
    478      int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
    479   CBLAS_TEST_COMPLEX *A, *AP;
    480   int i, j, k, LDA;
    481   enum CBLAS_TRANSPOSE trans;
    482   enum CBLAS_UPLO uplo;
    483   enum CBLAS_DIAG diag;
    484 
    485   get_transpose_type(transp,&trans);
    486   get_uplo_type(uplow,&uplo);
    487   get_diag_type(diagn,&diag);
    488 
    489   if (*order == TEST_ROW_MJR) {
    490      if (uplo != CblasUpper && uplo != CblasLower )
    491         cblas_ctpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
    492      else {
    493         LDA = *n;
    494         A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
    495         AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
    496 		sizeof(CBLAS_TEST_COMPLEX));
    497      	if (uplo == CblasUpper) {
    498            for( j=0, k=0; j<*n; j++ )
    499               for( i=0; i<j+1; i++, k++ ) {
    500                  A[ LDA*i+j ].real=ap[ k ].real;
    501        	         A[ LDA*i+j ].imag=ap[ k ].imag;
    502               }
    503            for( i=0, k=0; i<*n; i++ )
    504               for( j=i; j<*n; j++, k++ ) {
    505                  AP[ k ].real=A[ LDA*i+j ].real;
    506 	         AP[ k ].imag=A[ LDA*i+j ].imag;
    507               }
    508         }
    509         else {
    510            for( j=0, k=0; j<*n; j++ )
    511               for( i=j; i<*n; i++, k++ ) {
    512                  A[ LDA*i+j ].real=ap[ k ].real;
    513                  A[ LDA*i+j ].imag=ap[ k ].imag;
    514               }
    515            for( i=0, k=0; i<*n; i++ )
    516               for( j=0; j<i+1; j++, k++ ) {
    517                  AP[ k ].real=A[ LDA*i+j ].real;
    518 	         AP[ k ].imag=A[ LDA*i+j ].imag;
    519               }
    520         }
    521         cblas_ctpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
    522         free(A);
    523         free(AP);
    524      }
    525   }
    526   else if (*order == TEST_COL_MJR)
    527      cblas_ctpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
    528   else
    529      cblas_ctpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
    530 }
    531 
    532 void F77_ctrmv(int *order, char *uplow, char *transp, char *diagn,
    533      int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
    534       int *incx) {
    535   CBLAS_TEST_COMPLEX *A;
    536   int i,j,LDA;
    537   enum CBLAS_TRANSPOSE trans;
    538   enum CBLAS_UPLO uplo;
    539   enum CBLAS_DIAG diag;
    540 
    541   get_transpose_type(transp,&trans);
    542   get_uplo_type(uplow,&uplo);
    543   get_diag_type(diagn,&diag);
    544 
    545   if (*order == TEST_ROW_MJR) {
    546      LDA=*n+1;
    547      A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
    548      for( i=0; i<*n; i++ )
    549        for( j=0; j<*n; j++ ) {
    550 	  A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    551           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    552        }
    553      cblas_ctrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
    554      free(A);
    555   }
    556   else if (*order == TEST_COL_MJR)
    557      cblas_ctrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
    558   else
    559      cblas_ctrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
    560 }
    561 void F77_ctrsv(int *order, char *uplow, char *transp, char *diagn,
    562        int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
    563               int *incx) {
    564   CBLAS_TEST_COMPLEX *A;
    565   int i,j,LDA;
    566   enum CBLAS_TRANSPOSE trans;
    567   enum CBLAS_UPLO uplo;
    568   enum CBLAS_DIAG diag;
    569 
    570   get_transpose_type(transp,&trans);
    571   get_uplo_type(uplow,&uplo);
    572   get_diag_type(diagn,&diag);
    573 
    574   if (*order == TEST_ROW_MJR) {
    575      LDA = *n+1;
    576      A =(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
    577      for( i=0; i<*n; i++ )
    578         for( j=0; j<*n; j++ ) {
    579            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    580 	   A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    581 	}
    582      cblas_ctrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
    583      free(A);
    584    }
    585    else if (*order == TEST_COL_MJR)
    586      cblas_ctrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
    587    else
    588      cblas_ctrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
    589 }
    590 
    591 void F77_chpr(int *order, char *uplow, int *n, float *alpha,
    592 	     CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *ap) {
    593   CBLAS_TEST_COMPLEX *A, *AP;
    594   int i,j,k,LDA;
    595   enum CBLAS_UPLO uplo;
    596 
    597   get_uplo_type(uplow,&uplo);
    598 
    599   if (*order == TEST_ROW_MJR) {
    600      if (uplo != CblasUpper && uplo != CblasLower )
    601         cblas_chpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
    602      else {
    603         LDA = *n;
    604         A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
    605         AP = ( CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
    606 		sizeof( CBLAS_TEST_COMPLEX ));
    607         if (uplo == CblasUpper) {
    608            for( j=0, k=0; j<*n; j++ )
    609               for( i=0; i<j+1; i++, k++ ){
    610                  A[ LDA*i+j ].real=ap[ k ].real;
    611                  A[ LDA*i+j ].imag=ap[ k ].imag;
    612               }
    613            for( i=0, k=0; i<*n; i++ )
    614               for( j=i; j<*n; j++, k++ ){
    615                  AP[ k ].real=A[ LDA*i+j ].real;
    616                  AP[ k ].imag=A[ LDA*i+j ].imag;
    617               }
    618         }
    619         else {
    620            for( j=0, k=0; j<*n; j++ )
    621               for( i=j; i<*n; i++, k++ ){
    622                  A[ LDA*i+j ].real=ap[ k ].real;
    623        	         A[ LDA*i+j ].imag=ap[ k ].imag;
    624               }
    625            for( i=0, k=0; i<*n; i++ )
    626               for( j=0; j<i+1; j++, k++ ){
    627                  AP[ k ].real=A[ LDA*i+j ].real;
    628                  AP[ k ].imag=A[ LDA*i+j ].imag;
    629               }
    630         }
    631         cblas_chpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
    632         if (uplo == CblasUpper) {
    633            for( i=0, k=0; i<*n; i++ )
    634               for( j=i; j<*n; j++, k++ ){
    635                  A[ LDA*i+j ].real=AP[ k ].real;
    636                  A[ LDA*i+j ].imag=AP[ k ].imag;
    637               }
    638            for( j=0, k=0; j<*n; j++ )
    639               for( i=0; i<j+1; i++, k++ ){
    640                  ap[ k ].real=A[ LDA*i+j ].real;
    641                  ap[ k ].imag=A[ LDA*i+j ].imag;
    642               }
    643         }
    644         else {
    645            for( i=0, k=0; i<*n; i++ )
    646               for( j=0; j<i+1; j++, k++ ){
    647                  A[ LDA*i+j ].real=AP[ k ].real;
    648                  A[ LDA*i+j ].imag=AP[ k ].imag;
    649               }
    650            for( j=0, k=0; j<*n; j++ )
    651               for( i=j; i<*n; i++, k++ ){
    652                  ap[ k ].real=A[ LDA*i+j ].real;
    653                  ap[ k ].imag=A[ LDA*i+j ].imag;
    654               }
    655         }
    656         free(A);
    657         free(AP);
    658      }
    659   }
    660   else if (*order == TEST_COL_MJR)
    661      cblas_chpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
    662   else
    663      cblas_chpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
    664 }
    665 
    666 void F77_chpr2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
    667        CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
    668        CBLAS_TEST_COMPLEX *ap) {
    669   CBLAS_TEST_COMPLEX *A, *AP;
    670   int i,j,k,LDA;
    671   enum CBLAS_UPLO uplo;
    672 
    673   get_uplo_type(uplow,&uplo);
    674 
    675   if (*order == TEST_ROW_MJR) {
    676      if (uplo != CblasUpper && uplo != CblasLower )
    677         cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y,
    678 		     *incy, ap );
    679      else {
    680         LDA = *n;
    681         A=(CBLAS_TEST_COMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
    682         AP=(CBLAS_TEST_COMPLEX*)malloc( (((LDA+1)*LDA)/2)*
    683 	sizeof( CBLAS_TEST_COMPLEX ));
    684         if (uplo == CblasUpper) {
    685            for( j=0, k=0; j<*n; j++ )
    686               for( i=0; i<j+1; i++, k++ ) {
    687                  A[ LDA*i+j ].real=ap[ k ].real;
    688 	         A[ LDA*i+j ].imag=ap[ k ].imag;
    689 	      }
    690            for( i=0, k=0; i<*n; i++ )
    691               for( j=i; j<*n; j++, k++ ) {
    692                  AP[ k ].real=A[ LDA*i+j ].real;
    693 	         AP[ k ].imag=A[ LDA*i+j ].imag;
    694 	      }
    695         }
    696         else {
    697            for( j=0, k=0; j<*n; j++ )
    698               for( i=j; i<*n; i++, k++ ) {
    699 	         A[ LDA*i+j ].real=ap[ k ].real;
    700 	         A[ LDA*i+j ].imag=ap[ k ].imag;
    701 	      }
    702            for( i=0, k=0; i<*n; i++ )
    703               for( j=0; j<i+1; j++, k++ ) {
    704                  AP[ k ].real=A[ LDA*i+j ].real;
    705 	         AP[ k ].imag=A[ LDA*i+j ].imag;
    706 	      }
    707         }
    708         cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP );
    709         if (uplo == CblasUpper) {
    710            for( i=0, k=0; i<*n; i++ )
    711               for( j=i; j<*n; j++, k++ ) {
    712                  A[ LDA*i+j ].real=AP[ k ].real;
    713                  A[ LDA*i+j ].imag=AP[ k ].imag;
    714               }
    715            for( j=0, k=0; j<*n; j++ )
    716               for( i=0; i<j+1; i++, k++ ) {
    717                  ap[ k ].real=A[ LDA*i+j ].real;
    718 	         ap[ k ].imag=A[ LDA*i+j ].imag;
    719               }
    720         }
    721         else {
    722            for( i=0, k=0; i<*n; i++ )
    723               for( j=0; j<i+1; j++, k++ ) {
    724                  A[ LDA*i+j ].real=AP[ k ].real;
    725 	         A[ LDA*i+j ].imag=AP[ k ].imag;
    726               }
    727            for( j=0, k=0; j<*n; j++ )
    728               for( i=j; i<*n; i++, k++ ) {
    729                  ap[ k ].real=A[ LDA*i+j ].real;
    730 	         ap[ k ].imag=A[ LDA*i+j ].imag;
    731               }
    732         }
    733         free(A);
    734         free(AP);
    735      }
    736   }
    737   else if (*order == TEST_COL_MJR)
    738      cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
    739   else
    740      cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
    741 }
    742 
    743 void F77_cher(int *order, char *uplow, int *n, float *alpha,
    744   CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *a, int *lda) {
    745   CBLAS_TEST_COMPLEX *A;
    746   int i,j,LDA;
    747   enum CBLAS_UPLO uplo;
    748 
    749   get_uplo_type(uplow,&uplo);
    750 
    751   if (*order == TEST_ROW_MJR) {
    752      LDA = *n+1;
    753      A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_COMPLEX ));
    754 
    755      for( i=0; i<*n; i++ )
    756        for( j=0; j<*n; j++ ) {
    757 	  A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    758           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    759        }
    760 
    761      cblas_cher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA );
    762      for( i=0; i<*n; i++ )
    763        for( j=0; j<*n; j++ ) {
    764 	  a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
    765           a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
    766        }
    767      free(A);
    768   }
    769   else if (*order == TEST_COL_MJR)
    770      cblas_cher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
    771   else
    772      cblas_cher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
    773 }
    774 
    775 void F77_cher2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
    776           CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
    777 	  CBLAS_TEST_COMPLEX *a, int *lda) {
    778 
    779   CBLAS_TEST_COMPLEX *A;
    780   int i,j,LDA;
    781   enum CBLAS_UPLO uplo;
    782 
    783   get_uplo_type(uplow,&uplo);
    784 
    785   if (*order == TEST_ROW_MJR) {
    786      LDA = *n+1;
    787      A= ( CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
    788 
    789      for( i=0; i<*n; i++ )
    790        for( j=0; j<*n; j++ ) {
    791 	  A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
    792           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
    793        }
    794 
    795      cblas_cher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA );
    796      for( i=0; i<*n; i++ )
    797        for( j=0; j<*n; j++ ) {
    798 	  a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
    799           a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
    800        }
    801      free(A);
    802   }
    803   else if (*order == TEST_COL_MJR)
    804      cblas_cher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
    805   else
    806      cblas_cher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
    807 }
    808