cblas_cher2.c
Go to the documentation of this file.
00001 /*
00002  * cblas_cher2.c
00003  * The program is a C interface to cher2.
00004  * 
00005  * Keita Teranishi  3/23/98
00006  *
00007  */
00008 #include <stdio.h>
00009 #include <stdlib.h>
00010 #include "cblas.h"
00011 #include "cblas_f77.h"
00012 void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
00013                  const int N, const void *alpha, const void *X, const int incX,
00014                  const void *Y, const int incY, void *A, const int lda)
00015 {
00016    char UL;
00017 #ifdef F77_CHAR
00018    F77_CHAR F77_UL;
00019 #else
00020    #define F77_UL &UL
00021 #endif
00022 
00023 #ifdef F77_INT
00024    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
00025 #else
00026    #define F77_N N
00027    #define F77_lda lda
00028    #define F77_incX incx
00029    #define F77_incY incy
00030 #endif
00031    int n, i, j, tincx, tincy, incx=incX, incy=incY;
00032    float *x=(float *)X, *xx=(float *)X, *y=(float *)Y, 
00033          *yy=(float *)Y, *tx, *ty, *stx, *sty;
00034 
00035    extern int CBLAS_CallFromC;
00036    extern int RowMajorStrg;
00037    RowMajorStrg = 0;
00038  
00039    CBLAS_CallFromC = 1;
00040    if (order == CblasColMajor)
00041    {
00042       if (Uplo == CblasLower) UL = 'L';
00043       else if (Uplo == CblasUpper) UL = 'U';
00044       else 
00045       {
00046          cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n",Uplo );
00047          CBLAS_CallFromC = 0;
00048          RowMajorStrg = 0;
00049          return;
00050       }
00051       #ifdef F77_CHAR
00052          F77_UL = C2F_CHAR(&UL);
00053       #endif
00054 
00055       F77_cher2(F77_UL, &F77_N, alpha, X, &F77_incX, 
00056                                             Y, &F77_incY, A, &F77_lda);
00057 
00058    }  else if (order == CblasRowMajor)
00059    {
00060       RowMajorStrg = 1;
00061       if (Uplo == CblasUpper) UL = 'L';
00062       else if (Uplo == CblasLower) UL = 'U';
00063       else 
00064       {
00065          cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n", Uplo);
00066          CBLAS_CallFromC = 0;
00067          RowMajorStrg = 0;
00068          return;
00069       }
00070       #ifdef F77_CHAR
00071          F77_UL = C2F_CHAR(&UL);
00072       #endif
00073       if (N > 0)
00074       {
00075          n = N << 1;
00076          x = malloc(n*sizeof(float));
00077          y = malloc(n*sizeof(float));         
00078          tx = x;
00079          ty = y;
00080          if( incX > 0 ) {
00081             i = incX << 1 ;
00082             tincx = 2;
00083             stx= x+n;
00084          } else { 
00085             i = incX *(-2);
00086             tincx = -2;
00087             stx = x-2; 
00088             x +=(n-2); 
00089          }
00090          
00091          if( incY > 0 ) {
00092             j = incY << 1;
00093             tincy = 2;
00094             sty= y+n;
00095          } else { 
00096             j = incY *(-2);
00097             tincy = -2;
00098             sty = y-2; 
00099             y +=(n-2); 
00100          }
00101 
00102          do
00103          {
00104             *x = *xx;
00105             x[1] = -xx[1];
00106             x += tincx ;
00107             xx += i;
00108          }
00109          while (x != stx);
00110 
00111          do
00112          {
00113             *y = *yy;
00114             y[1] = -yy[1];
00115             y += tincy ;
00116             yy += j;
00117          }
00118          while (y != sty);
00119 
00120          x=tx;
00121          y=ty;
00122 
00123          #ifdef F77_INT
00124             F77_incX = 1;
00125             F77_incY = 1;
00126          #else
00127             incx = 1;
00128             incy = 1;
00129          #endif
00130       }  else 
00131       {
00132          x = (float *) X;
00133          y = (float *) Y;
00134       }
00135       F77_cher2(F77_UL, &F77_N, alpha, y, &F77_incY, x, 
00136                                       &F77_incX, A, &F77_lda);
00137    } else 
00138    {
00139       cblas_xerbla(1, "cblas_cher2","Illegal Order setting, %d\n", order);
00140       CBLAS_CallFromC = 0;
00141       RowMajorStrg = 0;
00142       return;
00143    }
00144    if(X!=x)
00145       free(x);
00146    if(Y!=y)
00147       free(y);
00148 
00149    CBLAS_CallFromC = 0;
00150    RowMajorStrg = 0;
00151    return;
00152 }


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