181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray/*
281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray * cblas_chpr.c
381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray * The program is a C interface to chpr.
481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray *
581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray * Keita Teranishi  3/23/98
681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray *
781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray */
881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#include <stdio.h>
981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#include <stdlib.h>
1081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#include "cblas.h"
1181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#include "cblas_f77.h"
1281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murrayvoid cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
1381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray                const int N, const float alpha, const void *X,
1481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray                const int incX, void *A)
1581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray{
1681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   char UL;
1781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#ifdef F77_CHAR
1881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   F77_CHAR F77_UL;
1981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#else
2081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   #define F77_UL &UL
2181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#endif
2281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
2381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#ifdef F77_INT
2481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   F77_INT F77_N=N, F77_incX=incX;
2581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#else
2681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   #define F77_N N
2781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   #define F77_incX incx
2881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray#endif
2981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   int n, i, tincx, incx=incX;
3081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   float *x=(float *)X, *xx=(float *)X, *tx, *st;
3181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
3281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   extern int CBLAS_CallFromC;
3381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   extern int RowMajorStrg;
3481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   RowMajorStrg = 0;
3581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
3681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   CBLAS_CallFromC = 1;
3781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   if (order == CblasColMajor)
3881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   {
3981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      if (Uplo == CblasLower) UL = 'L';
4081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      else if (Uplo == CblasUpper) UL = 'U';
4181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      else
4281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      {
4381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n",Uplo );
4481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         CBLAS_CallFromC = 0;
4581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         RowMajorStrg = 0;
4681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         return;
4781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      }
4881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      #ifdef F77_CHAR
4981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         F77_UL = C2F_CHAR(&UL);
5081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      #endif
5181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
5281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      F77_chpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
5381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
5481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   }  else if (order == CblasRowMajor)
5581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   {
5681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      RowMajorStrg = 1;
5781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      if (Uplo == CblasUpper) UL = 'L';
5881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      else if (Uplo == CblasLower) UL = 'U';
5981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      else
6081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      {
6181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n", Uplo);
6281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         CBLAS_CallFromC = 0;
6381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         RowMajorStrg = 0;
6481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         return;
6581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      }
6681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      #ifdef F77_CHAR
6781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         F77_UL = C2F_CHAR(&UL);
6881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      #endif
6981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      if (N > 0)
7081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      {
7181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         n = N << 1;
7281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         x = malloc(n*sizeof(float));
7381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         tx = x;
7481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         if( incX > 0 ) {
7581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            i = incX << 1;
7681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            tincx = 2;
7781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            st= x+n;
7881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         } else {
7981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            i = incX *(-2);
8081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            tincx = -2;
8181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            st = x-2;
8281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            x +=(n-2);
8381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         }
8481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         do
8581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         {
8681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            *x = *xx;
8781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            x[1] = -xx[1];
8881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            x += tincx ;
8981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            xx += i;
9081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         }
9181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         while (x != st);
9281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         x=tx;
9381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         #ifdef F77_INT
9481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            F77_incX = 1;
9581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         #else
9681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray            incx = 1;
9781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray         #endif
9881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      }
9981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      else x = (float *) X;
10081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
10181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      F77_chpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
10281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray
10381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   } else
10481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   {
10581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      cblas_xerbla(1, "cblas_chpr","Illegal Order setting, %d\n", order);
10681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      CBLAS_CallFromC = 0;
10781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      RowMajorStrg = 0;
10881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray      return;
10981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   }
11081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   if(X!=x)
11181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray     free(x);
11281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   CBLAS_CallFromC = 0;
11381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   RowMajorStrg = 0;
11481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray   return;
11581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray}
116