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 #ifdef NEW_IMATCOPY
 129     if (*lda == *ldb && *cols == *rows) {
 130         if ( order == BlasColMajor )
 131         {
 132
 133             if ( trans == BlasNoTrans )
 134             {
 135                 IMATCOPY_K_CN(*rows, *cols, alpha[0], alpha[1], a, *lda );
 136             }
 137             if ( trans == BlasConj )
 138             {
 139                 IMATCOPY_K_CNC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 140             }
 141             if ( trans == BlasTrans )
 142             {
 143                 IMATCOPY_K_CT(*rows, *cols, alpha[0], alpha[1], a, *lda );
 144             }
 145             if ( trans == BlasTransConj )
 146             {
 147                 IMATCOPY_K_CTC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 148             }
 149         }
 150         else
 151         {
 152
 153             if ( trans == BlasNoTrans )
 154             {
 155                 IMATCOPY_K_RN(*rows, *cols, alpha[0], alpha[1], a, *lda );
 156             }
 157             if ( trans == BlasConj )
 158             {
 159                 IMATCOPY_K_RNC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 160             }
 161             if ( trans == BlasTrans )
 162             {
 163                 IMATCOPY_K_RT(*rows, *cols, alpha[0], alpha[1], a, *lda );
 164             }
 165             if ( trans == BlasTransConj )
 166             {
 167                 IMATCOPY_K_RTC(*rows, *cols, alpha[0], alpha[1], a, *lda );
 168             }
 169         }
 170         return;
 171     }
 172 #endif
 173
 174         if ( *lda >  *ldb )
 175                 msize = (*lda) * (*ldb)  * sizeof(FLOAT) * 2;
 176         else
 177                 msize = (*ldb) * (*ldb)  * sizeof(FLOAT) * 2;
 178
 179         b = malloc(msize);
 180         if ( b == NULL )
 181         {
 182                 printf("Memory alloc failed in zimatcopy\n");
 183                 exit(1);
 184         }
 185
 186
 187         if ( order == BlasColMajor )
 188         {
 189
 190                 if ( trans == BlasNoTrans )
 191                 {
 192                         OMATCOPY_K_CN(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 193                         OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 194                         free(b);
 195                         return;
 196                 }
 197                 if ( trans == BlasConj )
 198                 {
 199                         OMATCOPY_K_CNC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 200                         OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 201                         free(b);
 202                         return;
 203                 }
 204                 if ( trans == BlasTrans )
 205                 {
 206                         OMATCOPY_K_CT(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 207                         OMATCOPY_K_CN(*cols, *rows, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 208                         free(b);
 209                         return;
 210                 }
 211                 if ( trans == BlasTransConj )
 212                 {
 213                         OMATCOPY_K_CTC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 214                         OMATCOPY_K_CN(*cols, *rows, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 215                         free(b);
 216                         return;
 217                 }
 218
 219         }
 220         else
 221         {
 222
 223                 if ( trans == BlasNoTrans )
 224                 {
 225                         OMATCOPY_K_RN(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 226                         OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 227                         free(b);
 228                         return;
 229                 }
 230                 if ( trans == BlasConj )
 231                 {
 232                         OMATCOPY_K_RNC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 233                         OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 234                         free(b);
 235                         return;
 236                 }
 237                 if ( trans == BlasTrans )
 238                 {
 239                         OMATCOPY_K_RT(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 240                         OMATCOPY_K_RN(*cols, *rows, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 241                         free(b);
 242                         return;
 243                 }
 244                 if ( trans == BlasTransConj )
 245                 {
 246                         OMATCOPY_K_RTC(*rows, *cols, alpha[0], alpha[1], a, *lda, b, *ldb );
 247                         OMATCOPY_K_RN(*cols, *rows, (FLOAT) 1.0, (FLOAT) 0.0 , b, *ldb, a, *ldb );
 248                         free(b);
 249                         return;
 250                 }
 251
 252         }
 253         free(b);
 254         return;
 255
 256 }
 257
 258