interface/zimatcopy.c

   1 /***************************************************************************
   2 Copyright (c) 2014, The OpenBLAS Project
   3 All rights reserved.
   4 Redistribution and use in source and binary forms, with or without
   5 modification, are permitted provided that the following conditions are
   6 met:
   7 1. Redistributions of source code must retain the above copyright
   8 notice, this list of conditions and the following disclaimer.
   9 2. Redistributions in binary form must reproduce the above copyright
  10 notice, this list of conditions and the following disclaimer in
  11 the documentation and/or other materials provided with the
  12 distribution.
  13 3. Neither the name of the OpenBLAS project nor the names of
  14 its contributors may be used to endorse or promote products
  15 derived from this software without specific prior written permission.
  16 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
  17 AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  18 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  19 ARE DISCLAIMED. IN NO EVENT SHALL THE OPENBLAS PROJECT OR CONTRIBUTORS BE
  20 LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  21 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  22 SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  23 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  24 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
  25 USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26 *****************************************************************************/
  27
  28 /***********************************************************
  29  * 2014-06-10 Saar
  30  * 2015-09-07 grisuthedragon
  31 ***********************************************************/
  32
  33 #include <stdio.h>
  34 #include <stdlib.h>
  35 #include "common.h"
  36 #ifdef FUNCTION_PROFILE
  37 #include "functable.h"
  38 #endif
  39
  40 #if defined(DOUBLE)
  41 #define ERROR_NAME "ZIMATCOPY"
  42 #else
  43 #define ERROR_NAME "CIMATCOPY"
  44 #endif
  45
  46 #define BlasRowMajor     0
  47 #define BlasColMajor     1
  48 #define BlasNoTrans      0
  49 #define BlasTrans        1
  50 #define BlasTransConj    2
  51 #define BlasConj         3
  52
  53 #define NEW_IMATCOPY
  54
  55 #ifndef CBLAS
  56 void NAME( char* ORDER, char* TRANS, blasint *rows, blasint *cols, FLOAT *alpha, FLOAT *a, blasint *lda, blasint *ldb)
  57 {
  58
  59         char Order, Trans;
  60         int order=-1,trans=-1;
  61         blasint info = -1;
  62         FLOAT *b;
  63         size_t msize;
  64
  65         Order = *ORDER;
  66         Trans = *TRANS;
  67
  68         TOUPPER(Order);
  69         TOUPPER(Trans);
  70
  71         if ( Order == 'C' ) order = BlasColMajor;
  72         if ( Order == 'R' ) order = BlasRowMajor;
  73         if ( Trans == 'N' ) trans = BlasNoTrans;
  74         if ( Trans == 'T' ) trans = BlasTrans;
  75         if ( Trans == 'C' ) trans = BlasTransConj;
  76         if ( Trans == 'R' ) trans = BlasConj;
  77
  78 #else
  79 void CNAME( enum CBLAS_ORDER CORDER, enum CBLAS_TRANSPOSE CTRANS, blasint crows, blasint ccols, FLOAT *alpha, FLOAT *a, blasint clda, blasint cldb)
  80 {
  81
  82         blasint *rows, *cols, *lda, *ldb;
  83         int order=-1,trans=-1;
  84         blasint info = -1;
  85         FLOAT *b;
  86         size_t msize;
  87
  88         if ( CORDER == CblasColMajor ) order = BlasColMajor;
  89         if ( CORDER == CblasRowMajor ) order = BlasRowMajor;
  90
  91         if ( CTRANS == CblasNoTrans) trans = BlasNoTrans;
  92         if ( CTRANS == CblasConjNoTrans ) trans = BlasConj;
  93         if ( CTRANS == CblasTrans) trans = BlasTrans;
  94         if ( CTRANS == CblasConjTrans) trans = BlasTransConj;
  95
  96         rows = &crows;
  97         cols = &ccols;
  98         lda  = &clda;
  99         ldb  = &cldb;
 100 #endif
 101
 102         if ( order == BlasColMajor)
 103         {
 104                 if ( trans == BlasNoTrans      &&  *ldb < *rows ) info = 9;
 105                 if ( trans == BlasConj         &&  *ldb < *rows ) info = 9;
 106                 if ( trans == BlasTrans        &&  *ldb < *cols ) info = 9;
 107                 if ( trans == BlasTransConj    &&  *ldb < *cols ) info = 9;
 108         }
 109         if ( order == BlasRowMajor)
 110         {
 111                 if ( trans == BlasNoTrans    &&  *ldb < *cols ) info = 9;
 112                 if ( trans == BlasConj       &&  *ldb < *cols ) info = 9;
 113                 if ( trans == BlasTrans      &&  *ldb < *rows ) info = 9;
 114                 if ( trans == BlasTransConj  &&  *ldb < *rows ) info = 9;
 115         }
 116
 117         if ( order == BlasColMajor &&  *lda < *rows ) info = 7;
 118         if ( order == BlasRowMajor &&  *lda < *cols ) info = 7;
 119         if ( *cols <= 0 ) info = 4;
 120         if ( *rows <= 0 ) info = 3;
 121         if ( trans < 0  ) info = 2;
 122         if ( order < 0  ) info = 1;
 123
 124         if (info >= 0) {
 125                 BLASFUNC(xerbla)(ERROR_NAME, &info, sizeof(ERROR_NAME));
 126                 return;
 127         }
 128
 129 #ifdef NEW_IMATCOPY
 130     if (*lda == *ldb) {
 131         if ( order == BlasColMajor )
 132         {
 133
 134             if ( trans == BlasNoTrans )
 135             {
 136                 IMATCOPY_K_CN(*rows, *cols, alpha[0], alpha[1], a, *lda );
 137             }
 138             if ( trans == BlasConj )
 139             {
 140                 IMATCOPY_K_CNC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 141             }
 142             if ( trans == BlasTrans )
 143             {
 144                 IMATCOPY_K_CT(*rows, *cols, alpha[0], alpha[1], a, *lda );
 145             }
 146             if ( trans == BlasTransConj )
 147             {
 148                 IMATCOPY_K_CTC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 149             }
 150         }
 151         else
 152         {
 153
 154             if ( trans == BlasNoTrans )
 155             {
 156                 IMATCOPY_K_RN(*rows, *cols, alpha[0], alpha[1], a, *lda );
 157             }
 158             if ( trans == BlasConj )
 159             {
 160                 IMATCOPY_K_RNC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 161             }
 162             if ( trans == BlasTrans )
 163             {
 164                 IMATCOPY_K_RT(*rows, *cols, alpha[0], alpha[1], a, *lda );
 165             }
 166             if ( trans == BlasTransConj )
 167             {
 168                 IMATCOPY_K_RTC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 169             }
 170         }
 171         return;
 172     }
 173 #endif
 174
 175         if ( *lda >  *ldb )
 176                 msize = (*lda) * (*ldb)  * sizeof(FLOAT) * 2;
 177         else
 178                 msize = (*ldb) * (*ldb)  * sizeof(FLOAT) * 2;
 179
 180         b = malloc(msize);
 181         if ( b == NULL )
 182         {
 183                 printf("Memory alloc failed\n");
 184                 exit(1);
 185         }
 186
 187
 188         if ( order == BlasColMajor )
 189         {
 190
 191                 if ( trans == BlasNoTrans )
 192                 {
 193                         OMATCOPY_K_CN(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 194                         OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 195                         free(b);
 196                         return;
 197                 }
 198                 if ( trans == BlasConj )
 199                 {
 200                         OMATCOPY_K_CNC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 201                         OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 202                         free(b);
 203                         return;
 204                 }
 205                 if ( trans == BlasTrans )
 206                 {
 207                         OMATCOPY_K_CT(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 208                         OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 209                         free(b);
 210                         return;
 211                 }
 212                 if ( trans == BlasTransConj )
 213                 {
 214                         OMATCOPY_K_CTC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 215                         OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 216                         free(b);
 217                         return;
 218                 }
 219
 220         }
 221         else
 222         {
 223
 224                 if ( trans == BlasNoTrans )
 225                 {
 226                         OMATCOPY_K_RN(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 227                         OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 228                         free(b);
 229                         return;
 230                 }
 231                 if ( trans == BlasConj )
 232                 {
 233                         OMATCOPY_K_RNC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 234                         OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 235                         free(b);
 236                         return;
 237                 }
 238                 if ( trans == BlasTrans )
 239                 {
 240                         OMATCOPY_K_RT(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 241                         OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 242                         free(b);
 243                         return;
 244                 }
 245                 if ( trans == BlasTransConj )
 246                 {
 247                         OMATCOPY_K_RTC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 248                         OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 249                         free(b);
 250                         return;
 251                 }
 252
 253         }
 254         free(b);
 255         return;
 256
 257 }
 258
 259