c_sblas2.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, 1/23/98, SGI/CRAY Research.
00006  */
00007 #include <stdlib.h>
00008 #include "cblas.h"
00009 #include "cblas_test.h"
00010 
00011 void F77_sgemv(int *order, char *transp, int *m, int *n, float *alpha, 
00012                float *a, int *lda, float *x, int *incx, float *beta, 
00013                float *y, int *incy ) {
00014 
00015   float *A;
00016   int i,j,LDA;
00017   enum CBLAS_TRANSPOSE trans;
00018 
00019   get_transpose_type(transp, &trans);
00020   if (*order == TEST_ROW_MJR) {
00021      LDA = *n+1;
00022      A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
00023      for( i=0; i<*m; i++ )
00024         for( j=0; j<*n; j++ )
00025            A[ LDA*i+j ]=a[ (*lda)*j+i ];
00026      cblas_sgemv( CblasRowMajor, trans, 
00027                   *m, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy );
00028      free(A);
00029   }
00030   else if (*order == TEST_COL_MJR)
00031      cblas_sgemv( CblasColMajor, trans,
00032                   *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy );
00033   else
00034      cblas_sgemv( UNDEFINED, trans,
00035                   *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy );
00036 }
00037 
00038 void F77_sger(int *order, int *m, int *n, float *alpha, float *x, int *incx,
00039              float *y, int *incy, float *a, int *lda ) {
00040 
00041   float *A;
00042   int i,j,LDA;
00043 
00044   if (*order == TEST_ROW_MJR) {
00045      LDA = *n+1;
00046      A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
00047 
00048      for( i=0; i<*m; i++ ) {
00049        for( j=0; j<*n; j++ )
00050          A[ LDA*i+j ]=a[ (*lda)*j+i ];
00051      }
00052 
00053      cblas_sger(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA );
00054      for( i=0; i<*m; i++ )
00055        for( j=0; j<*n; j++ )
00056          a[ (*lda)*j+i ]=A[ LDA*i+j ];
00057      free(A);
00058   }
00059   else
00060      cblas_sger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda );
00061 }
00062 
00063 void F77_strmv(int *order, char *uplow, char *transp, char *diagn,
00064               int *n, float *a, int *lda, float *x, int *incx) {
00065   float *A;
00066   int i,j,LDA;
00067   enum CBLAS_TRANSPOSE trans;
00068   enum CBLAS_UPLO uplo;
00069   enum CBLAS_DIAG diag;
00070 
00071   get_transpose_type(transp,&trans); 
00072   get_uplo_type(uplow,&uplo); 
00073   get_diag_type(diagn,&diag); 
00074 
00075   if (*order == TEST_ROW_MJR) {
00076      LDA = *n+1;
00077      A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00078      for( i=0; i<*n; i++ )
00079        for( j=0; j<*n; j++ )
00080          A[ LDA*i+j ]=a[ (*lda)*j+i ];
00081      cblas_strmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
00082      free(A);
00083   }
00084   else if (*order == TEST_COL_MJR)
00085      cblas_strmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
00086   else {
00087      cblas_strmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
00088   }
00089 }
00090 
00091 void F77_strsv(int *order, char *uplow, char *transp, char *diagn, 
00092                int *n, float *a, int *lda, float *x, int *incx ) {
00093   float *A;
00094   int i,j,LDA;
00095   enum CBLAS_TRANSPOSE trans;
00096   enum CBLAS_UPLO uplo;
00097   enum CBLAS_DIAG diag;
00098 
00099   get_transpose_type(transp,&trans);
00100   get_uplo_type(uplow,&uplo);
00101   get_diag_type(diagn,&diag);
00102 
00103   if (*order == TEST_ROW_MJR) {
00104      LDA = *n+1;
00105      A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00106      for( i=0; i<*n; i++ )
00107         for( j=0; j<*n; j++ )
00108            A[ LDA*i+j ]=a[ (*lda)*j+i ];
00109      cblas_strsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
00110      free(A);
00111    }
00112    else
00113      cblas_strsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
00114 }
00115 void F77_ssymv(int *order, char *uplow, int *n, float *alpha, float *a, 
00116               int *lda, float *x, int *incx, float *beta, float *y,
00117               int *incy) {
00118   float *A;
00119   int i,j,LDA;
00120   enum CBLAS_UPLO uplo;
00121 
00122   get_uplo_type(uplow,&uplo);
00123 
00124   if (*order == TEST_ROW_MJR) {
00125      LDA = *n+1;
00126      A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00127      for( i=0; i<*n; i++ )
00128         for( j=0; j<*n; j++ )
00129            A[ LDA*i+j ]=a[ (*lda)*j+i ];
00130      cblas_ssymv(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx,
00131                  *beta, y, *incy );
00132      free(A);
00133    }
00134    else
00135      cblas_ssymv(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx,
00136                  *beta, y, *incy );
00137 }
00138 
00139 void F77_ssyr(int *order, char *uplow, int *n, float *alpha, float *x, 
00140              int *incx, float *a, int *lda) {
00141   float *A;
00142   int i,j,LDA;
00143   enum CBLAS_UPLO uplo;
00144 
00145   get_uplo_type(uplow,&uplo);
00146 
00147   if (*order == TEST_ROW_MJR) {
00148      LDA = *n+1;
00149      A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00150      for( i=0; i<*n; i++ )
00151         for( j=0; j<*n; j++ )
00152            A[ LDA*i+j ]=a[ (*lda)*j+i ];
00153      cblas_ssyr(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA);
00154      for( i=0; i<*n; i++ )
00155        for( j=0; j<*n; j++ )
00156          a[ (*lda)*j+i ]=A[ LDA*i+j ];
00157      free(A);
00158    }
00159    else
00160      cblas_ssyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda);
00161 }
00162 
00163 void F77_ssyr2(int *order, char *uplow, int *n, float *alpha, float *x, 
00164              int *incx, float *y, int *incy, float *a, int *lda) {
00165   float *A;
00166   int i,j,LDA;
00167   enum CBLAS_UPLO uplo;
00168 
00169   get_uplo_type(uplow,&uplo);
00170 
00171   if (*order == TEST_ROW_MJR) {
00172      LDA = *n+1;
00173      A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00174      for( i=0; i<*n; i++ )
00175         for( j=0; j<*n; j++ )
00176            A[ LDA*i+j ]=a[ (*lda)*j+i ];
00177      cblas_ssyr2(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA);
00178      for( i=0; i<*n; i++ )
00179        for( j=0; j<*n; j++ )
00180          a[ (*lda)*j+i ]=A[ LDA*i+j ];
00181      free(A);
00182    }
00183    else
00184      cblas_ssyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda);
00185 }
00186 
00187 void F77_sgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
00188                float *alpha, float *a, int *lda, float *x, int *incx, 
00189                float *beta, float *y, int *incy ) {
00190 
00191   float *A;
00192   int i,irow,j,jcol,LDA;
00193   enum CBLAS_TRANSPOSE trans;
00194 
00195   get_transpose_type(transp, &trans);
00196 
00197   if (*order == TEST_ROW_MJR) {
00198      LDA = *ku+*kl+2;
00199      A   = ( float* )malloc( (*n+*kl)*LDA*sizeof( float ) );
00200      for( i=0; i<*ku; i++ ){
00201         irow=*ku+*kl-i;
00202         jcol=(*ku)-i;
00203         for( j=jcol; j<*n; j++ )
00204            A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
00205      }
00206      i=*ku;
00207      irow=*ku+*kl-i;
00208      for( j=0; j<*n; j++ )
00209         A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00210      for( i=*ku+1; i<*ku+*kl+1; i++ ){
00211         irow=*ku+*kl-i;
00212         jcol=i-(*ku);
00213         for( j=jcol; j<(*n+*kl); j++ )
00214            A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
00215      }
00216      cblas_sgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, 
00217                   A, LDA, x, *incx, *beta, y, *incy );
00218      free(A);
00219   }
00220   else
00221      cblas_sgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha,
00222                   a, *lda, x, *incx, *beta, y, *incy );
00223 }
00224 
00225 void F77_stbmv(int *order, char *uplow, char *transp, char *diagn,
00226               int *n, int *k, float *a, int *lda, float *x, int *incx) {
00227   float *A;
00228   int irow, jcol, i, j, LDA;
00229   enum CBLAS_TRANSPOSE trans;
00230   enum CBLAS_UPLO uplo;
00231   enum CBLAS_DIAG diag;
00232 
00233   get_transpose_type(transp,&trans); 
00234   get_uplo_type(uplow,&uplo); 
00235   get_diag_type(diagn,&diag); 
00236 
00237   if (*order == TEST_ROW_MJR) {
00238      LDA = *k+1;
00239      A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) );
00240      if (uplo == CblasUpper) {
00241         for( i=0; i<*k; i++ ){
00242            irow=*k-i;
00243            jcol=(*k)-i;
00244            for( j=jcol; j<*n; j++ )
00245               A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
00246         }
00247         i=*k;
00248         irow=*k-i;
00249         for( j=0; j<*n; j++ )
00250            A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00251      }
00252      else {
00253        i=0;
00254        irow=*k-i;
00255        for( j=0; j<*n; j++ )
00256           A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00257        for( i=1; i<*k+1; i++ ){
00258           irow=*k-i;
00259           jcol=i;
00260           for( j=jcol; j<(*n+*k); j++ )
00261              A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
00262        }
00263      }
00264      cblas_stbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
00265      free(A);
00266    }
00267    else
00268      cblas_stbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00269 }
00270 
00271 void F77_stbsv(int *order, char *uplow, char *transp, char *diagn,
00272               int *n, int *k, float *a, int *lda, float *x, int *incx) {
00273   float *A;
00274   int irow, jcol, i, j, LDA;
00275   enum CBLAS_TRANSPOSE trans;
00276   enum CBLAS_UPLO uplo;
00277   enum CBLAS_DIAG diag;
00278 
00279   get_transpose_type(transp,&trans); 
00280   get_uplo_type(uplow,&uplo); 
00281   get_diag_type(diagn,&diag); 
00282 
00283   if (*order == TEST_ROW_MJR) {
00284      LDA = *k+1;
00285      A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) );
00286      if (uplo == CblasUpper) {
00287         for( i=0; i<*k; i++ ){
00288         irow=*k-i;
00289         jcol=(*k)-i;
00290         for( j=jcol; j<*n; j++ )
00291            A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
00292         }
00293         i=*k;
00294         irow=*k-i;
00295         for( j=0; j<*n; j++ )
00296            A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00297      }
00298      else {
00299         i=0;
00300         irow=*k-i;
00301         for( j=0; j<*n; j++ )
00302            A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00303         for( i=1; i<*k+1; i++ ){
00304            irow=*k-i;
00305            jcol=i;
00306            for( j=jcol; j<(*n+*k); j++ )
00307               A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
00308         }
00309      }
00310      cblas_stbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
00311      free(A);
00312   }
00313   else
00314      cblas_stbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00315 }
00316 
00317 void F77_ssbmv(int *order, char *uplow, int *n, int *k, float *alpha,
00318               float *a, int *lda, float *x, int *incx, float *beta, 
00319               float *y, int *incy) {
00320   float *A;
00321   int i,j,irow,jcol,LDA;
00322   enum CBLAS_UPLO uplo;
00323 
00324   get_uplo_type(uplow,&uplo);
00325 
00326   if (*order == TEST_ROW_MJR) {
00327      LDA = *k+1;
00328      A   = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) );
00329      if (uplo == CblasUpper) {
00330         for( i=0; i<*k; i++ ){
00331            irow=*k-i;
00332            jcol=(*k)-i;
00333            for( j=jcol; j<*n; j++ )
00334         A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
00335         }
00336         i=*k;
00337         irow=*k-i;
00338         for( j=0; j<*n; j++ )
00339            A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00340      }
00341      else {
00342         i=0;
00343         irow=*k-i;
00344         for( j=0; j<*n; j++ )
00345            A[ LDA*j+irow ]=a[ (*lda)*j+i ];
00346         for( i=1; i<*k+1; i++ ){
00347            irow=*k-i;
00348            jcol=i;
00349            for( j=jcol; j<(*n+*k); j++ )
00350               A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
00351         }
00352      }
00353      cblas_ssbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx,
00354                  *beta, y, *incy );
00355      free(A);
00356    }
00357    else
00358      cblas_ssbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx,
00359                  *beta, y, *incy );
00360 }
00361 
00362 void F77_sspmv(int *order, char *uplow, int *n, float *alpha, float *ap,
00363               float *x, int *incx, float *beta, float *y, int *incy) {
00364   float *A,*AP;
00365   int i,j,k,LDA;
00366   enum CBLAS_UPLO uplo;
00367 
00368   get_uplo_type(uplow,&uplo);
00369 
00370   if (*order == TEST_ROW_MJR) {
00371      LDA = *n;
00372      A   = ( float* )malloc( LDA*LDA*sizeof( float ) );
00373      AP  = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) );
00374      if (uplo == CblasUpper) {
00375         for( j=0, k=0; j<*n; j++ )
00376            for( i=0; i<j+1; i++, k++ )
00377               A[ LDA*i+j ]=ap[ k ];
00378         for( i=0, k=0; i<*n; i++ )
00379            for( j=i; j<*n; j++, k++ )
00380               AP[ k ]=A[ LDA*i+j ];
00381      }
00382      else {
00383         for( j=0, k=0; j<*n; j++ )
00384            for( i=j; i<*n; i++, k++ )
00385               A[ LDA*i+j ]=ap[ k ];
00386         for( i=0, k=0; i<*n; i++ )
00387            for( j=0; j<i+1; j++, k++ )
00388               AP[ k ]=A[ LDA*i+j ];
00389      }
00390      cblas_sspmv( CblasRowMajor, uplo, *n, *alpha, AP, x, *incx, *beta, y, 
00391                   *incy );
00392      free(A); free(AP);
00393   }
00394   else
00395      cblas_sspmv( CblasColMajor, uplo, *n, *alpha, ap, x, *incx, *beta, y, 
00396                   *incy );
00397 }
00398 
00399 void F77_stpmv(int *order, char *uplow, char *transp, char *diagn,
00400               int *n, float *ap, float *x, int *incx) {
00401   float *A, *AP;
00402   int i, j, k, LDA;
00403   enum CBLAS_TRANSPOSE trans;
00404   enum CBLAS_UPLO uplo;
00405   enum CBLAS_DIAG diag;
00406 
00407   get_transpose_type(transp,&trans); 
00408   get_uplo_type(uplow,&uplo); 
00409   get_diag_type(diagn,&diag); 
00410 
00411   if (*order == TEST_ROW_MJR) {
00412      LDA = *n;
00413      A   = ( float* )malloc( LDA*LDA*sizeof( float ) );
00414      AP  = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) );
00415      if (uplo == CblasUpper) {
00416         for( j=0, k=0; j<*n; j++ )
00417            for( i=0; i<j+1; i++, k++ )
00418               A[ LDA*i+j ]=ap[ k ];
00419         for( i=0, k=0; i<*n; i++ )
00420            for( j=i; j<*n; j++, k++ )
00421               AP[ k ]=A[ LDA*i+j ];
00422      }
00423      else {
00424         for( j=0, k=0; j<*n; j++ )
00425            for( i=j; i<*n; i++, k++ )
00426               A[ LDA*i+j ]=ap[ k ];
00427         for( i=0, k=0; i<*n; i++ )
00428            for( j=0; j<i+1; j++, k++ )
00429               AP[ k ]=A[ LDA*i+j ];
00430      }
00431      cblas_stpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00432      free(A); free(AP);
00433   }
00434   else
00435      cblas_stpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00436 }
00437 
00438 void F77_stpsv(int *order, char *uplow, char *transp, char *diagn,
00439               int *n, float *ap, float *x, int *incx) {
00440   float *A, *AP;
00441   int i, j, k, LDA;
00442   enum CBLAS_TRANSPOSE trans;
00443   enum CBLAS_UPLO uplo;
00444   enum CBLAS_DIAG diag;
00445 
00446   get_transpose_type(transp,&trans); 
00447   get_uplo_type(uplow,&uplo); 
00448   get_diag_type(diagn,&diag); 
00449 
00450   if (*order == TEST_ROW_MJR) {
00451      LDA = *n;
00452      A   = ( float* )malloc( LDA*LDA*sizeof( float ) );
00453      AP  = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) );
00454      if (uplo == CblasUpper) {
00455         for( j=0, k=0; j<*n; j++ )
00456            for( i=0; i<j+1; i++, k++ )
00457               A[ LDA*i+j ]=ap[ k ];
00458         for( i=0, k=0; i<*n; i++ )
00459            for( j=i; j<*n; j++, k++ )
00460               AP[ k ]=A[ LDA*i+j ];
00461 
00462      }
00463      else {
00464         for( j=0, k=0; j<*n; j++ )
00465            for( i=j; i<*n; i++, k++ )
00466               A[ LDA*i+j ]=ap[ k ];
00467         for( i=0, k=0; i<*n; i++ )
00468            for( j=0; j<i+1; j++, k++ )
00469               AP[ k ]=A[ LDA*i+j ];
00470      }
00471      cblas_stpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00472      free(A); free(AP);
00473   }
00474   else
00475      cblas_stpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00476 }
00477 
00478 void F77_sspr(int *order, char *uplow, int *n, float *alpha, float *x, 
00479              int *incx, float *ap ){
00480   float *A, *AP;
00481   int i,j,k,LDA;
00482   enum CBLAS_UPLO uplo;
00483 
00484   get_uplo_type(uplow,&uplo);
00485 
00486   if (*order == TEST_ROW_MJR) {
00487      LDA = *n;
00488      A   = ( float* )malloc( LDA*LDA*sizeof( float ) );
00489      AP  = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) );
00490      if (uplo == CblasUpper) {
00491         for( j=0, k=0; j<*n; j++ )
00492            for( i=0; i<j+1; i++, k++ )
00493               A[ LDA*i+j ]=ap[ k ];
00494         for( i=0, k=0; i<*n; i++ )
00495            for( j=i; j<*n; j++, k++ )
00496               AP[ k ]=A[ LDA*i+j ];
00497      }
00498      else {
00499         for( j=0, k=0; j<*n; j++ )
00500            for( i=j; i<*n; i++, k++ )
00501               A[ LDA*i+j ]=ap[ k ];
00502         for( i=0, k=0; i<*n; i++ )
00503            for( j=0; j<i+1; j++, k++ )
00504               AP[ k ]=A[ LDA*i+j ];
00505      }
00506      cblas_sspr( CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
00507      if (uplo == CblasUpper) {
00508         for( i=0, k=0; i<*n; i++ )
00509            for( j=i; j<*n; j++, k++ )
00510               A[ LDA*i+j ]=AP[ k ];
00511         for( j=0, k=0; j<*n; j++ )
00512            for( i=0; i<j+1; i++, k++ )
00513               ap[ k ]=A[ LDA*i+j ];
00514      }
00515      else {
00516         for( i=0, k=0; i<*n; i++ )
00517            for( j=0; j<i+1; j++, k++ )
00518               A[ LDA*i+j ]=AP[ k ];
00519         for( j=0, k=0; j<*n; j++ )
00520            for( i=j; i<*n; i++, k++ )
00521               ap[ k ]=A[ LDA*i+j ];
00522      }
00523      free(A); free(AP);
00524   }
00525   else
00526      cblas_sspr( CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
00527 }
00528 
00529 void F77_sspr2(int *order, char *uplow, int *n, float *alpha, float *x, 
00530              int *incx, float *y, int *incy, float *ap ){
00531   float *A, *AP;
00532   int i,j,k,LDA;
00533   enum CBLAS_UPLO uplo;
00534 
00535   get_uplo_type(uplow,&uplo);
00536 
00537   if (*order == TEST_ROW_MJR) {
00538      LDA = *n;
00539      A   = ( float* )malloc( LDA*LDA*sizeof( float ) );
00540      AP  = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) );
00541      if (uplo == CblasUpper) {
00542         for( j=0, k=0; j<*n; j++ )
00543            for( i=0; i<j+1; i++, k++ )
00544               A[ LDA*i+j ]=ap[ k ];
00545         for( i=0, k=0; i<*n; i++ )
00546            for( j=i; j<*n; j++, k++ )
00547               AP[ k ]=A[ LDA*i+j ];
00548      }
00549      else {
00550         for( j=0, k=0; j<*n; j++ )
00551            for( i=j; i<*n; i++, k++ )
00552               A[ LDA*i+j ]=ap[ k ];
00553         for( i=0, k=0; i<*n; i++ )
00554            for( j=0; j<i+1; j++, k++ )
00555               AP[ k ]=A[ LDA*i+j ];
00556      }
00557      cblas_sspr2( CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, AP );
00558      if (uplo == CblasUpper) {
00559         for( i=0, k=0; i<*n; i++ )
00560            for( j=i; j<*n; j++, k++ )
00561               A[ LDA*i+j ]=AP[ k ];
00562         for( j=0, k=0; j<*n; j++ )
00563            for( i=0; i<j+1; i++, k++ )
00564               ap[ k ]=A[ LDA*i+j ];
00565      }
00566      else {
00567         for( i=0, k=0; i<*n; i++ )
00568            for( j=0; j<i+1; j++, k++ )
00569               A[ LDA*i+j ]=AP[ k ];
00570         for( j=0, k=0; j<*n; j++ )
00571            for( i=j; i<*n; i++, k++ )
00572               ap[ k ]=A[ LDA*i+j ];
00573      }
00574      free(A);
00575      free(AP);
00576   }
00577   else
00578      cblas_sspr2( CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, ap );
00579 }


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