c_cblas2.c
Go to the documentation of this file.
00001 /*
00002  *     Written by D.P. Manley, Digital Equipment Corporation.
00003  *     Prefixed "C_" to BLAS routines and their declarations.
00004  *
00005  *     Modified by T. H. Do, 4/08/98, SGI/CRAY Research.
00006  */
00007 #include <stdlib.h>
00008 #include "cblas.h"
00009 #include "cblas_test.h"
00010 
00011 void F77_cgemv(int *order, char *transp, int *m, int *n, 
00012           const void *alpha,
00013           CBLAS_TEST_COMPLEX *a, int *lda, const void *x, int *incx, 
00014           const void *beta, void *y, int *incy) {
00015 
00016   CBLAS_TEST_COMPLEX *A;
00017   int i,j,LDA;
00018   enum CBLAS_TRANSPOSE trans;
00019 
00020   get_transpose_type(transp, &trans);
00021   if (*order == TEST_ROW_MJR) {
00022      LDA = *n+1;
00023      A  = (CBLAS_TEST_COMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_COMPLEX) );
00024      for( i=0; i<*m; i++ )
00025         for( j=0; j<*n; j++ ){
00026            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00027            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00028         }
00029      cblas_cgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx,
00030             beta, y, *incy );
00031      free(A);
00032   }
00033   else if (*order == TEST_COL_MJR)
00034      cblas_cgemv( CblasColMajor, trans,
00035                   *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
00036   else
00037      cblas_cgemv( UNDEFINED, trans,
00038                   *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
00039 }
00040 
00041 void F77_cgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku, 
00042               CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, 
00043               CBLAS_TEST_COMPLEX *x, int *incx, 
00044               CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy) {
00045 
00046   CBLAS_TEST_COMPLEX *A;
00047   int i,j,irow,jcol,LDA;
00048   enum CBLAS_TRANSPOSE trans;
00049 
00050   get_transpose_type(transp, &trans);
00051   if (*order == TEST_ROW_MJR) {
00052      LDA = *ku+*kl+2;
00053      A=( CBLAS_TEST_COMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00054      for( i=0; i<*ku; i++ ){
00055         irow=*ku+*kl-i;
00056         jcol=(*ku)-i;
00057         for( j=jcol; j<*n; j++ ){
00058            A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00059            A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00060         }
00061      }
00062      i=*ku;
00063      irow=*ku+*kl-i;
00064      for( j=0; j<*n; j++ ){
00065         A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00066         A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00067      }
00068      for( i=*ku+1; i<*ku+*kl+1; i++ ){
00069         irow=*ku+*kl-i;
00070         jcol=i-(*ku);
00071         for( j=jcol; j<(*n+*kl); j++ ){
00072            A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00073            A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00074         }
00075      }
00076      cblas_cgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x,
00077                   *incx, beta, y, *incy );
00078      free(A);
00079   }
00080   else if (*order == TEST_COL_MJR)
00081      cblas_cgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
00082                   *incx, beta, y, *incy );
00083   else
00084      cblas_cgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
00085                   *incx, beta, y, *incy );
00086 }
00087 
00088 void F77_cgeru(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, 
00089          CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, 
00090          CBLAS_TEST_COMPLEX *a, int *lda){
00091 
00092   CBLAS_TEST_COMPLEX *A;
00093   int i,j,LDA;
00094 
00095   if (*order == TEST_ROW_MJR) {
00096      LDA = *n+1;
00097      A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00098      for( i=0; i<*m; i++ )
00099         for( j=0; j<*n; j++ ){
00100            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00101            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00102      }
00103      cblas_cgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
00104      for( i=0; i<*m; i++ )
00105         for( j=0; j<*n; j++ ){
00106            a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00107            a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00108         }
00109      free(A);
00110   }
00111   else if (*order == TEST_COL_MJR)
00112      cblas_cgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00113   else
00114      cblas_cgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00115 }
00116 
00117 void F77_cgerc(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, 
00118          CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, 
00119          CBLAS_TEST_COMPLEX *a, int *lda) {
00120   CBLAS_TEST_COMPLEX *A;
00121   int i,j,LDA;
00122 
00123   if (*order == TEST_ROW_MJR) {
00124      LDA = *n+1;
00125      A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00126      for( i=0; i<*m; i++ )
00127         for( j=0; j<*n; j++ ){
00128            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00129            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00130         }
00131      cblas_cgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
00132      for( i=0; i<*m; i++ )
00133         for( j=0; j<*n; j++ ){
00134            a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00135            a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00136         }
00137      free(A);
00138   }
00139   else if (*order == TEST_COL_MJR)
00140      cblas_cgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00141   else
00142      cblas_cgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00143 }
00144 
00145 void F77_chemv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00146       CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00147       int *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
00148 
00149   CBLAS_TEST_COMPLEX *A;
00150   int i,j,LDA;
00151   enum CBLAS_UPLO uplo;
00152 
00153   get_uplo_type(uplow,&uplo);
00154 
00155   if (*order == TEST_ROW_MJR) {
00156      LDA = *n+1;
00157      A = (CBLAS_TEST_COMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00158      for( i=0; i<*n; i++ )
00159         for( j=0; j<*n; j++ ){
00160            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00161            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00162      }
00163      cblas_chemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx,
00164             beta, y, *incy );
00165      free(A);
00166   }
00167   else if (*order == TEST_COL_MJR)
00168      cblas_chemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, 
00169            beta, y, *incy );
00170   else
00171      cblas_chemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
00172            beta, y, *incy );
00173 }
00174 
00175 void F77_chbmv(int *order, char *uplow, int *n, int *k,
00176      CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, 
00177      CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta,
00178      CBLAS_TEST_COMPLEX *y, int *incy){
00179 
00180 CBLAS_TEST_COMPLEX *A;
00181 int i,irow,j,jcol,LDA;
00182 
00183   enum CBLAS_UPLO uplo;
00184 
00185   get_uplo_type(uplow,&uplo);
00186 
00187   if (*order == TEST_ROW_MJR) {
00188      if (uplo != CblasUpper && uplo != CblasLower )
00189         cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x, 
00190                  *incx, beta, y, *incy );
00191      else {
00192         LDA = *k+2;
00193         A =(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00194         if (uplo == CblasUpper) {
00195            for( i=0; i<*k; i++ ){
00196               irow=*k-i;
00197               jcol=(*k)-i;
00198               for( j=jcol; j<*n; j++ ) {
00199                  A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00200                  A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00201               }
00202            }
00203            i=*k;
00204            irow=*k-i;
00205            for( j=0; j<*n; j++ ) {
00206               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00207               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00208            }
00209         }
00210         else {
00211            i=0;
00212            irow=*k-i;
00213            for( j=0; j<*n; j++ ) {
00214               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00215               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00216            }
00217            for( i=1; i<*k+1; i++ ){
00218               irow=*k-i;
00219               jcol=i;
00220               for( j=jcol; j<(*n+*k); j++ ) {
00221                  A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00222                  A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00223               }
00224            }
00225         }
00226         cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx,
00227                      beta, y, *incy );
00228         free(A);
00229       }
00230    }
00231    else if (*order == TEST_COL_MJR)
00232      cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
00233                  beta, y, *incy );
00234    else
00235      cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
00236                  beta, y, *incy );
00237 }
00238 
00239 void F77_chpmv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00240      CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx, 
00241      CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
00242 
00243   CBLAS_TEST_COMPLEX *A, *AP;
00244   int i,j,k,LDA;
00245   enum CBLAS_UPLO uplo;
00246 
00247   get_uplo_type(uplow,&uplo);
00248   if (*order == TEST_ROW_MJR) {
00249      if (uplo != CblasUpper && uplo != CblasLower )
00250         cblas_chpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx, 
00251                  beta, y, *incy);
00252      else {
00253         LDA = *n;
00254         A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ));
00255         AP = (CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
00256                 sizeof( CBLAS_TEST_COMPLEX ));
00257         if (uplo == CblasUpper) {
00258            for( j=0, k=0; j<*n; j++ )
00259               for( i=0; i<j+1; i++, k++ ) {
00260                  A[ LDA*i+j ].real=ap[ k ].real;
00261                  A[ LDA*i+j ].imag=ap[ k ].imag;
00262               }
00263            for( i=0, k=0; i<*n; i++ )
00264               for( j=i; j<*n; j++, k++ ) {
00265                  AP[ k ].real=A[ LDA*i+j ].real;
00266                  AP[ k ].imag=A[ LDA*i+j ].imag;
00267               }
00268         }
00269         else {
00270            for( j=0, k=0; j<*n; j++ )
00271               for( i=j; i<*n; i++, k++ ) {
00272                  A[ LDA*i+j ].real=ap[ k ].real;
00273                  A[ LDA*i+j ].imag=ap[ k ].imag;
00274               }
00275            for( i=0, k=0; i<*n; i++ )
00276               for( j=0; j<i+1; j++, k++ ) {
00277                  AP[ k ].real=A[ LDA*i+j ].real;
00278                  AP[ k ].imag=A[ LDA*i+j ].imag;
00279               }
00280         }
00281         cblas_chpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y,
00282                      *incy );
00283         free(A);
00284         free(AP);
00285      }
00286   }
00287   else if (*order == TEST_COL_MJR)
00288      cblas_chpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
00289                   *incy );
00290   else
00291      cblas_chpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
00292                   *incy );
00293 }
00294 
00295 void F77_ctbmv(int *order, char *uplow, char *transp, char *diagn,
00296      int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00297      int *incx) {
00298   CBLAS_TEST_COMPLEX *A;
00299   int irow, jcol, i, j, LDA;
00300   enum CBLAS_TRANSPOSE trans;
00301   enum CBLAS_UPLO uplo;
00302   enum CBLAS_DIAG diag;
00303 
00304   get_transpose_type(transp,&trans);
00305   get_uplo_type(uplow,&uplo);
00306   get_diag_type(diagn,&diag);
00307 
00308   if (*order == TEST_ROW_MJR) {
00309      if (uplo != CblasUpper && uplo != CblasLower )
00310         cblas_ctbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
00311         x, *incx);
00312      else {
00313         LDA = *k+2;
00314         A=(CBLAS_TEST_COMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00315         if (uplo == CblasUpper) {
00316            for( i=0; i<*k; i++ ){
00317               irow=*k-i;
00318               jcol=(*k)-i;
00319               for( j=jcol; j<*n; j++ ) {
00320                  A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00321                  A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00322               }
00323            }
00324            i=*k;
00325            irow=*k-i;
00326            for( j=0; j<*n; j++ ) {
00327               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00328               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00329            }
00330         }
00331         else {
00332           i=0;
00333           irow=*k-i;
00334           for( j=0; j<*n; j++ ) {
00335              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00336              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00337           }
00338           for( i=1; i<*k+1; i++ ){
00339              irow=*k-i;
00340              jcol=i;
00341              for( j=jcol; j<(*n+*k); j++ ) {
00342                 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00343                 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00344              }
00345           }
00346         }
00347         cblas_ctbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, 
00348                     *incx);
00349         free(A);
00350      }
00351    }
00352    else if (*order == TEST_COL_MJR)
00353      cblas_ctbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00354    else
00355      cblas_ctbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00356 }
00357 
00358 void F77_ctbsv(int *order, char *uplow, char *transp, char *diagn,
00359       int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00360       int *incx) {
00361 
00362   CBLAS_TEST_COMPLEX *A;
00363   int irow, jcol, i, j, LDA;
00364   enum CBLAS_TRANSPOSE trans;
00365   enum CBLAS_UPLO uplo;
00366   enum CBLAS_DIAG diag;
00367 
00368   get_transpose_type(transp,&trans);
00369   get_uplo_type(uplow,&uplo);
00370   get_diag_type(diagn,&diag);
00371 
00372   if (*order == TEST_ROW_MJR) {
00373      if (uplo != CblasUpper && uplo != CblasLower )
00374         cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x, 
00375                  *incx);
00376      else {
00377         LDA = *k+2;
00378         A=(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
00379         if (uplo == CblasUpper) {
00380            for( i=0; i<*k; i++ ){
00381               irow=*k-i;
00382               jcol=(*k)-i;
00383               for( j=jcol; j<*n; j++ ) {
00384                  A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00385                  A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00386               }
00387            }
00388            i=*k;
00389            irow=*k-i;
00390            for( j=0; j<*n; j++ ) {
00391               A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00392               A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00393            }
00394         }
00395         else {
00396            i=0;
00397            irow=*k-i;
00398            for( j=0; j<*n; j++ ) {
00399              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00400              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00401            }
00402            for( i=1; i<*k+1; i++ ){
00403               irow=*k-i;
00404               jcol=i;
00405               for( j=jcol; j<(*n+*k); j++ ) {
00406                  A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00407                  A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00408               }
00409            }
00410         }
00411         cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, 
00412                     x, *incx);
00413         free(A);
00414      }
00415   }
00416   else if (*order == TEST_COL_MJR)
00417      cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00418   else
00419      cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00420 }
00421 
00422 void F77_ctpmv(int *order, char *uplow, char *transp, char *diagn,
00423       int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
00424   CBLAS_TEST_COMPLEX *A, *AP;
00425   int i, j, k, LDA;
00426   enum CBLAS_TRANSPOSE trans;
00427   enum CBLAS_UPLO uplo;
00428   enum CBLAS_DIAG diag;
00429 
00430   get_transpose_type(transp,&trans);
00431   get_uplo_type(uplow,&uplo);
00432   get_diag_type(diagn,&diag);
00433 
00434   if (*order == TEST_ROW_MJR) {
00435      if (uplo != CblasUpper && uplo != CblasLower )
00436         cblas_ctpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
00437      else {
00438         LDA = *n;
00439         A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
00440         AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
00441                 sizeof(CBLAS_TEST_COMPLEX));
00442         if (uplo == CblasUpper) {
00443            for( j=0, k=0; j<*n; j++ )
00444               for( i=0; i<j+1; i++, k++ ) {
00445                  A[ LDA*i+j ].real=ap[ k ].real;
00446                  A[ LDA*i+j ].imag=ap[ k ].imag;
00447               }
00448            for( i=0, k=0; i<*n; i++ )
00449               for( j=i; j<*n; j++, k++ ) {
00450                  AP[ k ].real=A[ LDA*i+j ].real;
00451                  AP[ k ].imag=A[ LDA*i+j ].imag;
00452               }
00453         }
00454         else {
00455            for( j=0, k=0; j<*n; j++ )
00456               for( i=j; i<*n; i++, k++ ) {
00457                  A[ LDA*i+j ].real=ap[ k ].real;
00458                  A[ LDA*i+j ].imag=ap[ k ].imag;
00459               }
00460            for( i=0, k=0; i<*n; i++ )
00461               for( j=0; j<i+1; j++, k++ ) {
00462                  AP[ k ].real=A[ LDA*i+j ].real;
00463                  AP[ k ].imag=A[ LDA*i+j ].imag;
00464               }
00465         }
00466         cblas_ctpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00467         free(A);
00468         free(AP);
00469      }
00470   }
00471   else if (*order == TEST_COL_MJR)
00472      cblas_ctpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00473   else
00474      cblas_ctpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
00475 }
00476 
00477 void F77_ctpsv(int *order, char *uplow, char *transp, char *diagn,
00478      int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
00479   CBLAS_TEST_COMPLEX *A, *AP;
00480   int i, j, k, LDA;
00481   enum CBLAS_TRANSPOSE trans;
00482   enum CBLAS_UPLO uplo;
00483   enum CBLAS_DIAG diag;
00484 
00485   get_transpose_type(transp,&trans);
00486   get_uplo_type(uplow,&uplo);
00487   get_diag_type(diagn,&diag);
00488 
00489   if (*order == TEST_ROW_MJR) {
00490      if (uplo != CblasUpper && uplo != CblasLower )
00491         cblas_ctpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
00492      else {
00493         LDA = *n;
00494         A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
00495         AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
00496                 sizeof(CBLAS_TEST_COMPLEX));
00497         if (uplo == CblasUpper) {
00498            for( j=0, k=0; j<*n; j++ )
00499               for( i=0; i<j+1; i++, k++ ) {
00500                  A[ LDA*i+j ].real=ap[ k ].real;
00501                  A[ LDA*i+j ].imag=ap[ k ].imag;
00502               }
00503            for( i=0, k=0; i<*n; i++ )
00504               for( j=i; j<*n; j++, k++ ) {
00505                  AP[ k ].real=A[ LDA*i+j ].real;
00506                  AP[ k ].imag=A[ LDA*i+j ].imag;
00507               }
00508         }
00509         else {
00510            for( j=0, k=0; j<*n; j++ )
00511               for( i=j; i<*n; i++, k++ ) {
00512                  A[ LDA*i+j ].real=ap[ k ].real;
00513                  A[ LDA*i+j ].imag=ap[ k ].imag;
00514               }
00515            for( i=0, k=0; i<*n; i++ )
00516               for( j=0; j<i+1; j++, k++ ) {
00517                  AP[ k ].real=A[ LDA*i+j ].real;
00518                  AP[ k ].imag=A[ LDA*i+j ].imag;
00519               }
00520         }
00521         cblas_ctpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00522         free(A);
00523         free(AP);
00524      }
00525   }
00526   else if (*order == TEST_COL_MJR)
00527      cblas_ctpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00528   else
00529      cblas_ctpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
00530 }
00531 
00532 void F77_ctrmv(int *order, char *uplow, char *transp, char *diagn,
00533      int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00534       int *incx) {
00535   CBLAS_TEST_COMPLEX *A;
00536   int i,j,LDA;
00537   enum CBLAS_TRANSPOSE trans;
00538   enum CBLAS_UPLO uplo;
00539   enum CBLAS_DIAG diag;
00540 
00541   get_transpose_type(transp,&trans);
00542   get_uplo_type(uplow,&uplo);
00543   get_diag_type(diagn,&diag);
00544 
00545   if (*order == TEST_ROW_MJR) {
00546      LDA=*n+1;
00547      A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00548      for( i=0; i<*n; i++ )
00549        for( j=0; j<*n; j++ ) {
00550           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00551           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00552        }
00553      cblas_ctrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
00554      free(A);
00555   }
00556   else if (*order == TEST_COL_MJR)
00557      cblas_ctrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
00558   else
00559      cblas_ctrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
00560 }
00561 void F77_ctrsv(int *order, char *uplow, char *transp, char *diagn,
00562        int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00563               int *incx) {
00564   CBLAS_TEST_COMPLEX *A;
00565   int i,j,LDA;
00566   enum CBLAS_TRANSPOSE trans;
00567   enum CBLAS_UPLO uplo;
00568   enum CBLAS_DIAG diag;
00569 
00570   get_transpose_type(transp,&trans);
00571   get_uplo_type(uplow,&uplo);
00572   get_diag_type(diagn,&diag);
00573 
00574   if (*order == TEST_ROW_MJR) {
00575      LDA = *n+1;
00576      A =(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00577      for( i=0; i<*n; i++ )
00578         for( j=0; j<*n; j++ ) {
00579            A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00580            A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00581         }
00582      cblas_ctrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
00583      free(A);
00584    }
00585    else if (*order == TEST_COL_MJR)
00586      cblas_ctrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
00587    else
00588      cblas_ctrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
00589 }
00590 
00591 void F77_chpr(int *order, char *uplow, int *n, float *alpha,
00592              CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *ap) {
00593   CBLAS_TEST_COMPLEX *A, *AP;
00594   int i,j,k,LDA;
00595   enum CBLAS_UPLO uplo;
00596 
00597   get_uplo_type(uplow,&uplo);
00598 
00599   if (*order == TEST_ROW_MJR) {
00600      if (uplo != CblasUpper && uplo != CblasLower )
00601         cblas_chpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
00602      else {
00603         LDA = *n;
00604         A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00605         AP = ( CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
00606                 sizeof( CBLAS_TEST_COMPLEX ));
00607         if (uplo == CblasUpper) {
00608            for( j=0, k=0; j<*n; j++ )
00609               for( i=0; i<j+1; i++, k++ ){
00610                  A[ LDA*i+j ].real=ap[ k ].real;
00611                  A[ LDA*i+j ].imag=ap[ k ].imag;
00612               }
00613            for( i=0, k=0; i<*n; i++ )
00614               for( j=i; j<*n; j++, k++ ){
00615                  AP[ k ].real=A[ LDA*i+j ].real;
00616                  AP[ k ].imag=A[ LDA*i+j ].imag;
00617               }
00618         }
00619         else {
00620            for( j=0, k=0; j<*n; j++ )
00621               for( i=j; i<*n; i++, k++ ){
00622                  A[ LDA*i+j ].real=ap[ k ].real;
00623                  A[ LDA*i+j ].imag=ap[ k ].imag;
00624               }
00625            for( i=0, k=0; i<*n; i++ )
00626               for( j=0; j<i+1; j++, k++ ){
00627                  AP[ k ].real=A[ LDA*i+j ].real;
00628                  AP[ k ].imag=A[ LDA*i+j ].imag;
00629               }
00630         }
00631         cblas_chpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
00632         if (uplo == CblasUpper) {
00633            for( i=0, k=0; i<*n; i++ )
00634               for( j=i; j<*n; j++, k++ ){
00635                  A[ LDA*i+j ].real=AP[ k ].real;
00636                  A[ LDA*i+j ].imag=AP[ k ].imag;
00637               }
00638            for( j=0, k=0; j<*n; j++ )
00639               for( i=0; i<j+1; i++, k++ ){
00640                  ap[ k ].real=A[ LDA*i+j ].real;
00641                  ap[ k ].imag=A[ LDA*i+j ].imag;
00642               }
00643         }
00644         else {
00645            for( i=0, k=0; i<*n; i++ )
00646               for( j=0; j<i+1; j++, k++ ){
00647                  A[ LDA*i+j ].real=AP[ k ].real;
00648                  A[ LDA*i+j ].imag=AP[ k ].imag;
00649               }
00650            for( j=0, k=0; j<*n; j++ )
00651               for( i=j; i<*n; i++, k++ ){
00652                  ap[ k ].real=A[ LDA*i+j ].real;
00653                  ap[ k ].imag=A[ LDA*i+j ].imag;
00654               }
00655         }
00656         free(A);
00657         free(AP);
00658      }
00659   }
00660   else if (*order == TEST_COL_MJR)
00661      cblas_chpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
00662   else
00663      cblas_chpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
00664 }
00665 
00666 void F77_chpr2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00667        CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
00668        CBLAS_TEST_COMPLEX *ap) {
00669   CBLAS_TEST_COMPLEX *A, *AP;
00670   int i,j,k,LDA;
00671   enum CBLAS_UPLO uplo;
00672 
00673   get_uplo_type(uplow,&uplo);
00674 
00675   if (*order == TEST_ROW_MJR) {
00676      if (uplo != CblasUpper && uplo != CblasLower )
00677         cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y, 
00678                      *incy, ap );
00679      else {
00680         LDA = *n;
00681         A=(CBLAS_TEST_COMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00682         AP=(CBLAS_TEST_COMPLEX*)malloc( (((LDA+1)*LDA)/2)*
00683         sizeof( CBLAS_TEST_COMPLEX ));
00684         if (uplo == CblasUpper) {
00685            for( j=0, k=0; j<*n; j++ )
00686               for( i=0; i<j+1; i++, k++ ) {
00687                  A[ LDA*i+j ].real=ap[ k ].real;
00688                  A[ LDA*i+j ].imag=ap[ k ].imag;
00689               }
00690            for( i=0, k=0; i<*n; i++ )
00691               for( j=i; j<*n; j++, k++ ) {
00692                  AP[ k ].real=A[ LDA*i+j ].real;
00693                  AP[ k ].imag=A[ LDA*i+j ].imag;
00694               }
00695         }
00696         else {
00697            for( j=0, k=0; j<*n; j++ )
00698               for( i=j; i<*n; i++, k++ ) {
00699                  A[ LDA*i+j ].real=ap[ k ].real;
00700                  A[ LDA*i+j ].imag=ap[ k ].imag;
00701               }
00702            for( i=0, k=0; i<*n; i++ )
00703               for( j=0; j<i+1; j++, k++ ) {
00704                  AP[ k ].real=A[ LDA*i+j ].real;
00705                  AP[ k ].imag=A[ LDA*i+j ].imag;
00706               }
00707         }
00708         cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP );
00709         if (uplo == CblasUpper) {
00710            for( i=0, k=0; i<*n; i++ )
00711               for( j=i; j<*n; j++, k++ ) {
00712                  A[ LDA*i+j ].real=AP[ k ].real;
00713                  A[ LDA*i+j ].imag=AP[ k ].imag;
00714               }
00715            for( j=0, k=0; j<*n; j++ )
00716               for( i=0; i<j+1; i++, k++ ) {
00717                  ap[ k ].real=A[ LDA*i+j ].real;
00718                  ap[ k ].imag=A[ LDA*i+j ].imag;
00719               }
00720         }
00721         else {
00722            for( i=0, k=0; i<*n; i++ )
00723               for( j=0; j<i+1; j++, k++ ) {
00724                  A[ LDA*i+j ].real=AP[ k ].real;
00725                  A[ LDA*i+j ].imag=AP[ k ].imag;
00726               }
00727            for( j=0, k=0; j<*n; j++ )
00728               for( i=j; i<*n; i++, k++ ) {
00729                  ap[ k ].real=A[ LDA*i+j ].real;
00730                  ap[ k ].imag=A[ LDA*i+j ].imag;
00731               }
00732         }
00733         free(A);
00734         free(AP);
00735      }
00736   }
00737   else if (*order == TEST_COL_MJR)
00738      cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
00739   else
00740      cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
00741 }
00742 
00743 void F77_cher(int *order, char *uplow, int *n, float *alpha,
00744   CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *a, int *lda) {
00745   CBLAS_TEST_COMPLEX *A;
00746   int i,j,LDA;
00747   enum CBLAS_UPLO uplo;
00748 
00749   get_uplo_type(uplow,&uplo);
00750 
00751   if (*order == TEST_ROW_MJR) {
00752      LDA = *n+1;
00753      A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_COMPLEX ));
00754 
00755      for( i=0; i<*n; i++ ) 
00756        for( j=0; j<*n; j++ ) {
00757           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00758           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00759        }
00760 
00761      cblas_cher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA );
00762      for( i=0; i<*n; i++ )
00763        for( j=0; j<*n; j++ ) {
00764           a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00765           a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00766        }
00767      free(A);
00768   }
00769   else if (*order == TEST_COL_MJR)
00770      cblas_cher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
00771   else
00772      cblas_cher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
00773 }
00774 
00775 void F77_cher2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00776           CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
00777           CBLAS_TEST_COMPLEX *a, int *lda) {
00778 
00779   CBLAS_TEST_COMPLEX *A;
00780   int i,j,LDA;
00781   enum CBLAS_UPLO uplo;
00782 
00783   get_uplo_type(uplow,&uplo);
00784 
00785   if (*order == TEST_ROW_MJR) {
00786      LDA = *n+1;
00787      A= ( CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00788 
00789      for( i=0; i<*n; i++ ) 
00790        for( j=0; j<*n; j++ ) {
00791           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00792           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00793        }
00794 
00795      cblas_cher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA );
00796      for( i=0; i<*n; i++ )
00797        for( j=0; j<*n; j++ ) {
00798           a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00799           a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00800        }
00801      free(A);
00802   }
00803   else if (*order == TEST_COL_MJR)
00804      cblas_cher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
00805   else
00806      cblas_cher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
00807 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:15