c_dblas2.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_dgemv(int *order, char *transp, int *m, int *n, double *alpha, 
00012                double *a, int *lda, double *x, int *incx, double *beta, 
00013                double *y, int *incy ) {
00014 
00015   double *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   = ( double* )malloc( (*m)*LDA*sizeof( double ) );
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_dgemv( 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_dgemv( CblasColMajor, trans,
00032                   *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy );
00033   else
00034      cblas_dgemv( UNDEFINED, trans,
00035                   *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy );
00036 }
00037 
00038 void F77_dger(int *order, int *m, int *n, double *alpha, double *x, int *incx,
00039              double *y, int *incy, double *a, int *lda ) {
00040 
00041   double *A;
00042   int i,j,LDA;
00043 
00044   if (*order == TEST_ROW_MJR) {
00045      LDA = *n+1;
00046      A   = ( double* )malloc( (*m)*LDA*sizeof( double ) );
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_dger(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_dger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda );
00061 }
00062 
00063 void F77_dtrmv(int *order, char *uplow, char *transp, char *diagn,
00064               int *n, double *a, int *lda, double *x, int *incx) {
00065   double *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   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
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_dtrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
00082      free(A);
00083   }
00084   else if (*order == TEST_COL_MJR)
00085      cblas_dtrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
00086   else {
00087      cblas_dtrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
00088   }
00089 }
00090 
00091 void F77_dtrsv(int *order, char *uplow, char *transp, char *diagn, 
00092                int *n, double *a, int *lda, double *x, int *incx ) {
00093   double *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   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
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_dtrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
00110      free(A);
00111    }
00112    else
00113      cblas_dtrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
00114 }
00115 void F77_dsymv(int *order, char *uplow, int *n, double *alpha, double *a, 
00116               int *lda, double *x, int *incx, double *beta, double *y,
00117               int *incy) {
00118   double *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   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
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_dsymv(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx,
00131                  *beta, y, *incy );
00132      free(A);
00133    }
00134    else
00135      cblas_dsymv(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx,
00136                  *beta, y, *incy );
00137 }
00138 
00139 void F77_dsyr(int *order, char *uplow, int *n, double *alpha, double *x, 
00140              int *incx, double *a, int *lda) {
00141   double *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   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
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_dsyr(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_dsyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda);
00161 }
00162 
00163 void F77_dsyr2(int *order, char *uplow, int *n, double *alpha, double *x, 
00164              int *incx, double *y, int *incy, double *a, int *lda) {
00165   double *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   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
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_dsyr2(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_dsyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda);
00185 }
00186 
00187 void F77_dgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
00188                double *alpha, double *a, int *lda, double *x, int *incx, 
00189                double *beta, double *y, int *incy ) {
00190 
00191   double *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   = ( double* )malloc( (*n+*kl)*LDA*sizeof( double ) );
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_dgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, 
00217                   A, LDA, x, *incx, *beta, y, *incy );
00218      free(A);
00219   }
00220   else
00221      cblas_dgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha,
00222                   a, *lda, x, *incx, *beta, y, *incy );
00223 }
00224 
00225 void F77_dtbmv(int *order, char *uplow, char *transp, char *diagn,
00226               int *n, int *k, double *a, int *lda, double *x, int *incx) {
00227   double *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 = ( double* )malloc( (*n+*k)*LDA*sizeof( double ) );
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_dtbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
00265      free(A);
00266    }
00267    else
00268      cblas_dtbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00269 }
00270 
00271 void F77_dtbsv(int *order, char *uplow, char *transp, char *diagn,
00272               int *n, int *k, double *a, int *lda, double *x, int *incx) {
00273   double *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 = ( double* )malloc( (*n+*k)*LDA*sizeof( double ) );
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_dtbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
00311      free(A);
00312   }
00313   else
00314      cblas_dtbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00315 }
00316 
00317 void F77_dsbmv(int *order, char *uplow, int *n, int *k, double *alpha,
00318               double *a, int *lda, double *x, int *incx, double *beta, 
00319               double *y, int *incy) {
00320   double *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   = ( double* )malloc( (*n+*k)*LDA*sizeof( double ) );
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_dsbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx,
00354                  *beta, y, *incy );
00355      free(A);
00356    }
00357    else
00358      cblas_dsbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx,
00359                  *beta, y, *incy );
00360 }
00361 
00362 void F77_dspmv(int *order, char *uplow, int *n, double *alpha, double *ap,
00363               double *x, int *incx, double *beta, double *y, int *incy) {
00364   double *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   = ( double* )malloc( LDA*LDA*sizeof( double ) );
00373      AP  = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
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_dspmv( CblasRowMajor, uplo, *n, *alpha, AP, x, *incx, *beta, y, 
00391                   *incy );
00392      free(A);
00393      free(AP);
00394   }
00395   else
00396      cblas_dspmv( CblasColMajor, uplo, *n, *alpha, ap, x, *incx, *beta, y, 
00397                   *incy );
00398 }
00399 
00400 void F77_dtpmv(int *order, char *uplow, char *transp, char *diagn,
00401               int *n, double *ap, double *x, int *incx) {
00402   double *A, *AP;
00403   int i, j, k, LDA;
00404   enum CBLAS_TRANSPOSE trans;
00405   enum CBLAS_UPLO uplo;
00406   enum CBLAS_DIAG diag;
00407 
00408   get_transpose_type(transp,&trans); 
00409   get_uplo_type(uplow,&uplo); 
00410   get_diag_type(diagn,&diag); 
00411 
00412   if (*order == TEST_ROW_MJR) {
00413      LDA = *n;
00414      A   = ( double* )malloc( LDA*LDA*sizeof( double ) );
00415      AP  = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
00416      if (uplo == CblasUpper) {
00417         for( j=0, k=0; j<*n; j++ )
00418            for( i=0; i<j+1; i++, k++ )
00419               A[ LDA*i+j ]=ap[ k ];
00420         for( i=0, k=0; i<*n; i++ )
00421            for( j=i; j<*n; j++, k++ )
00422               AP[ k ]=A[ LDA*i+j ];
00423      }
00424      else {
00425         for( j=0, k=0; j<*n; j++ )
00426            for( i=j; i<*n; i++, k++ )
00427               A[ LDA*i+j ]=ap[ k ];
00428         for( i=0, k=0; i<*n; i++ )
00429            for( j=0; j<i+1; j++, k++ )
00430               AP[ k ]=A[ LDA*i+j ];
00431      }
00432      cblas_dtpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00433      free(A);
00434      free(AP);
00435   }
00436   else
00437      cblas_dtpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00438 }
00439 
00440 void F77_dtpsv(int *order, char *uplow, char *transp, char *diagn,
00441               int *n, double *ap, double *x, int *incx) {
00442   double *A, *AP;
00443   int i, j, k, LDA;
00444   enum CBLAS_TRANSPOSE trans;
00445   enum CBLAS_UPLO uplo;
00446   enum CBLAS_DIAG diag;
00447 
00448   get_transpose_type(transp,&trans); 
00449   get_uplo_type(uplow,&uplo); 
00450   get_diag_type(diagn,&diag); 
00451 
00452   if (*order == TEST_ROW_MJR) {
00453      LDA = *n;
00454      A   = ( double* )malloc( LDA*LDA*sizeof( double ) );
00455      AP  = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
00456      if (uplo == CblasUpper) {
00457         for( j=0, k=0; j<*n; j++ )
00458            for( i=0; i<j+1; i++, k++ )
00459               A[ LDA*i+j ]=ap[ k ];
00460         for( i=0, k=0; i<*n; i++ )
00461            for( j=i; j<*n; j++, k++ )
00462               AP[ k ]=A[ LDA*i+j ];
00463 
00464      }
00465      else {
00466         for( j=0, k=0; j<*n; j++ )
00467            for( i=j; i<*n; i++, k++ )
00468               A[ LDA*i+j ]=ap[ k ];
00469         for( i=0, k=0; i<*n; i++ )
00470            for( j=0; j<i+1; j++, k++ )
00471               AP[ k ]=A[ LDA*i+j ];
00472      }
00473      cblas_dtpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00474      free(A);
00475      free(AP);
00476   }
00477   else
00478      cblas_dtpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00479 }
00480 
00481 void F77_dspr(int *order, char *uplow, int *n, double *alpha, double *x, 
00482              int *incx, double *ap ){
00483   double *A, *AP;
00484   int i,j,k,LDA;
00485   enum CBLAS_UPLO uplo;
00486 
00487   get_uplo_type(uplow,&uplo);
00488 
00489   if (*order == TEST_ROW_MJR) {
00490      LDA = *n;
00491      A   = ( double* )malloc( LDA*LDA*sizeof( double ) );
00492      AP  = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
00493      if (uplo == CblasUpper) {
00494         for( j=0, k=0; j<*n; j++ )
00495            for( i=0; i<j+1; i++, k++ )
00496               A[ LDA*i+j ]=ap[ k ];
00497         for( i=0, k=0; i<*n; i++ )
00498            for( j=i; j<*n; j++, k++ )
00499               AP[ k ]=A[ LDA*i+j ];
00500      }
00501      else {
00502         for( j=0, k=0; j<*n; j++ )
00503            for( i=j; i<*n; i++, k++ )
00504               A[ LDA*i+j ]=ap[ k ];
00505         for( i=0, k=0; i<*n; i++ )
00506            for( j=0; j<i+1; j++, k++ )
00507               AP[ k ]=A[ LDA*i+j ];
00508      }
00509      cblas_dspr( CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
00510      if (uplo == CblasUpper) {
00511         for( i=0, k=0; i<*n; i++ )
00512            for( j=i; j<*n; j++, k++ )
00513               A[ LDA*i+j ]=AP[ k ];
00514         for( j=0, k=0; j<*n; j++ )
00515            for( i=0; i<j+1; i++, k++ )
00516               ap[ k ]=A[ LDA*i+j ];
00517      }
00518      else {
00519         for( i=0, k=0; i<*n; i++ )
00520            for( j=0; j<i+1; j++, k++ )
00521               A[ LDA*i+j ]=AP[ k ];
00522         for( j=0, k=0; j<*n; j++ )
00523            for( i=j; i<*n; i++, k++ )
00524               ap[ k ]=A[ LDA*i+j ];
00525      }
00526      free(A);
00527      free(AP);
00528   }
00529   else
00530      cblas_dspr( CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
00531 }
00532 
00533 void F77_dspr2(int *order, char *uplow, int *n, double *alpha, double *x, 
00534              int *incx, double *y, int *incy, double *ap ){
00535   double *A, *AP;
00536   int i,j,k,LDA;
00537   enum CBLAS_UPLO uplo;
00538 
00539   get_uplo_type(uplow,&uplo);
00540 
00541   if (*order == TEST_ROW_MJR) {
00542      LDA = *n;
00543      A   = ( double* )malloc( LDA*LDA*sizeof( double ) );
00544      AP  = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
00545      if (uplo == CblasUpper) {
00546         for( j=0, k=0; j<*n; j++ )
00547            for( i=0; i<j+1; i++, k++ )
00548               A[ LDA*i+j ]=ap[ k ];
00549         for( i=0, k=0; i<*n; i++ )
00550            for( j=i; j<*n; j++, k++ )
00551               AP[ k ]=A[ LDA*i+j ];
00552      }
00553      else {
00554         for( j=0, k=0; j<*n; j++ )
00555            for( i=j; i<*n; i++, k++ )
00556               A[ LDA*i+j ]=ap[ k ];
00557         for( i=0, k=0; i<*n; i++ )
00558            for( j=0; j<i+1; j++, k++ )
00559               AP[ k ]=A[ LDA*i+j ];
00560      }
00561      cblas_dspr2( CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, AP );
00562      if (uplo == CblasUpper) {
00563         for( i=0, k=0; i<*n; i++ )
00564            for( j=i; j<*n; j++, k++ )
00565               A[ LDA*i+j ]=AP[ k ];
00566         for( j=0, k=0; j<*n; j++ )
00567            for( i=0; i<j+1; i++, k++ )
00568               ap[ k ]=A[ LDA*i+j ];
00569      }
00570      else {
00571         for( i=0, k=0; i<*n; i++ )
00572            for( j=0; j<i+1; j++, k++ )
00573               A[ LDA*i+j ]=AP[ k ];
00574         for( j=0, k=0; j<*n; j++ )
00575            for( i=j; i<*n; i++, k++ )
00576               ap[ k ]=A[ LDA*i+j ];
00577      }
00578      free(A);
00579      free(AP);
00580   }
00581   else
00582      cblas_dspr2( CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, ap );
00583 }

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