ctest/c_zblas2.c

   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 "common.h"
   9 #include "cblas_test.h"
  10
  11 void F77_zgemv(int *order, char *transp, int *m, int *n,
  12           const void *alpha,
  13           CBLAS_TEST_ZOMPLEX *a, int *lda, const void *x, int *incx,
  14           const void *beta, void *y, int *incy) {
  15
  16   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_ZOMPLEX) );
  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_zgemv( 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_zgemv( CblasColMajor, trans,
  35                   *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
  36   else
  37      cblas_zgemv( UNDEFINED, trans,
  38                   *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
  39 }
  40
  41 void F77_zgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
  42               CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
  43               CBLAS_TEST_ZOMPLEX *x, int *incx,
  44               CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy) {
  45
  46   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
  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_zgbmv( 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_zgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
  82                   *incx, beta, y, *incy );
  83   else
  84      cblas_zgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
  85                   *incx, beta, y, *incy );
  86 }
  87
  88 void F77_zgeru(int *order, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha,
  89          CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
  90          CBLAS_TEST_ZOMPLEX *a, int *lda){
  91
  92   CBLAS_TEST_ZOMPLEX *A;
  93   int i,j,LDA;
  94
  95   if (*order == TEST_ROW_MJR) {
  96      LDA = *n+1;
  97      A=(CBLAS_TEST_ZOMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
  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_zgeru( 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_zgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 113   else
 114      cblas_zgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 115 }
 116
 117 void F77_zgerc(int *order, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 118          CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
 119          CBLAS_TEST_ZOMPLEX *a, int *lda) {
 120   CBLAS_TEST_ZOMPLEX *A;
 121   int i,j,LDA;
 122
 123   if (*order == TEST_ROW_MJR) {
 124      LDA = *n+1;
 125      A=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 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_zgerc( 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_zgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 141   else
 142      cblas_zgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 143 }
 144
 145 void F77_zhemv(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 146       CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 147       int *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){
 148
 149   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 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_zhemv( 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_zhemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx,
 169            beta, y, *incy );
 170   else
 171      cblas_zhemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
 172            beta, y, *incy );
 173 }
 174
 175 void F77_zhbmv(int *order, char *uplow, int *n, int *k,
 176      CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
 177      CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *beta,
 178      CBLAS_TEST_ZOMPLEX *y, int *incy){
 179
 180 CBLAS_TEST_ZOMPLEX *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_zhbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x,
 190                  *incx, beta, y, *incy );
 191      else {
 192         LDA = *k+2;
 193         A =(CBLAS_TEST_ZOMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 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_zhbmv( 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_zhbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
 233                  beta, y, *incy );
 234    else
 235      cblas_zhbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
 236                  beta, y, *incy );
 237 }
 238
 239 void F77_zhpmv(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 240      CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx,
 241      CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){
 242
 243   CBLAS_TEST_ZOMPLEX *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_zhpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx,
 251                  beta, y, *incy);
 252      else {
 253         LDA = *n;
 254         A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
 255         AP = (CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
 256                 sizeof( CBLAS_TEST_ZOMPLEX ));
 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_zhpmv( 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_zhpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
 289                   *incy );
 290   else
 291      cblas_zhpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
 292                   *incy );
 293 }
 294
 295 void F77_ztbmv(int *order, char *uplow, char *transp, char *diagn,
 296      int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 297      int *incx) {
 298   CBLAS_TEST_ZOMPLEX *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_ztbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
 311         x, *incx);
 312      else {
 313         LDA = *k+2;
 314         A=(CBLAS_TEST_ZOMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 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_ztbmv(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_ztbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 354    else
 355      cblas_ztbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 356 }
 357
 358 void F77_ztbsv(int *order, char *uplow, char *transp, char *diagn,
 359       int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 360       int *incx) {
 361
 362   CBLAS_TEST_ZOMPLEX *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_ztbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x,
 375                  *incx);
 376      else {
 377         LDA = *k+2;
 378         A=(CBLAS_TEST_ZOMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
 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_ztbsv(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_ztbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 418   else
 419      cblas_ztbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 420 }
 421
 422 void F77_ztpmv(int *order, char *uplow, char *transp, char *diagn,
 423       int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) {
 424   CBLAS_TEST_ZOMPLEX *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_ztpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
 437      else {
 438         LDA = *n;
 439         A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 440         AP=(CBLAS_TEST_ZOMPLEX*)malloc((((LDA+1)*LDA)/2)*
 441                 sizeof(CBLAS_TEST_ZOMPLEX));
 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_ztpmv( 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_ztpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
 473   else
 474      cblas_ztpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
 475 }
 476
 477 void F77_ztpsv(int *order, char *uplow, char *transp, char *diagn,
 478      int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) {
 479   CBLAS_TEST_ZOMPLEX *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_ztpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
 492      else {
 493         LDA = *n;
 494         A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 495         AP=(CBLAS_TEST_ZOMPLEX*)malloc((((LDA+1)*LDA)/2)*
 496                 sizeof(CBLAS_TEST_ZOMPLEX));
 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_ztpsv( 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_ztpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
 528   else
 529      cblas_ztpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
 530 }
 531
 532 void F77_ztrmv(int *order, char *uplow, char *transp, char *diagn,
 533      int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 534       int *incx) {
 535   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 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_ztrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
 554      free(A);
 555   }
 556   else if (*order == TEST_COL_MJR)
 557      cblas_ztrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
 558   else
 559      cblas_ztrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
 560 }
 561 void F77_ztrsv(int *order, char *uplow, char *transp, char *diagn,
 562        int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 563               int *incx) {
 564   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 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_ztrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
 583      free(A);
 584    }
 585    else if (*order == TEST_COL_MJR)
 586      cblas_ztrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
 587    else
 588      cblas_ztrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
 589 }
 590
 591 void F77_zhpr(int *order, char *uplow, int *n, double *alpha,
 592              CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *ap) {
 593   CBLAS_TEST_ZOMPLEX *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_zhpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
 602      else {
 603         LDA = *n;
 604         A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 605         AP = ( CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
 606                 sizeof( CBLAS_TEST_ZOMPLEX ));
 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_zhpr(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_zhpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
 662   else
 663      cblas_zhpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
 664 }
 665
 666 void F77_zhpr2(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 667        CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
 668        CBLAS_TEST_ZOMPLEX *ap) {
 669   CBLAS_TEST_ZOMPLEX *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_zhpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y,
 678                      *incy, ap );
 679      else {
 680         LDA = *n;
 681         A=(CBLAS_TEST_ZOMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 682         AP=(CBLAS_TEST_ZOMPLEX*)malloc( (((LDA+1)*LDA)/2)*
 683         sizeof( CBLAS_TEST_ZOMPLEX ));
 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_zhpr2( 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_zhpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
 739   else
 740      cblas_zhpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
 741 }
 742
 743 void F77_zher(int *order, char *uplow, int *n, double *alpha,
 744   CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *a, int *lda) {
 745   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_ZOMPLEX ));
 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_zher(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_zher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
 771   else
 772      cblas_zher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
 773 }
 774
 775 void F77_zher2(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 776           CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
 777           CBLAS_TEST_ZOMPLEX *a, int *lda) {
 778
 779   CBLAS_TEST_ZOMPLEX *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_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 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_zher2(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_zher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
 805   else
 806      cblas_zher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
 807 }