OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.
Tree: d2b11c4777
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from 'd2b11c4777'
${ noResults }
OpenBLAS/ctest/c_zblas2.c

808 lines
27 kB
Raw Blame History 

  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.           OPENBLAS_CONST void *alpha,

  13.           CBLAS_TEST_ZOMPLEX *a, int *lda, OPENBLAS_CONST void *x, int *incx,

  14.           OPENBLAS_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. }