197 lines
		
	
	
		
			5.6 KiB
		
	
	
	
		
			C
		
	
	
	
			
		
		
	
	
			197 lines
		
	
	
		
			5.6 KiB
		
	
	
	
		
			C
		
	
	
	
| /***************************************************************************
 | |
| Copyright (c) 2014, The OpenBLAS Project
 | |
| All rights reserved.
 | |
| Redistribution and use in source and binary forms, with or without
 | |
| modification, are permitted provided that the following conditions are
 | |
| met:
 | |
| 1. Redistributions of source code must retain the above copyright
 | |
| notice, this list of conditions and the following disclaimer.
 | |
| 2. Redistributions in binary form must reproduce the above copyright
 | |
| notice, this list of conditions and the following disclaimer in
 | |
| the documentation and/or other materials provided with the
 | |
| distribution.
 | |
| 3. Neither the name of the OpenBLAS project nor the names of
 | |
| its contributors may be used to endorse or promote products
 | |
| derived from this software without specific prior written permission.
 | |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 | |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 | |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 | |
| ARE DISCLAIMED. IN NO EVENT SHALL THE OPENBLAS PROJECT OR CONTRIBUTORS BE
 | |
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 | |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 | |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 | |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 | |
| OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
 | |
| USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 | |
| *****************************************************************************/
 | |
| 
 | |
| /***********************************************************
 | |
|  * 2014-06-10 Saar
 | |
|  * 2015-09-07 grisuthedragon 
 | |
| ***********************************************************/
 | |
| 
 | |
| #include <stdio.h>
 | |
| #include <stdlib.h>
 | |
| #include "common.h"
 | |
| #ifdef FUNCTION_PROFILE
 | |
| #include "functable.h"
 | |
| #endif
 | |
| 
 | |
| #if defined(DOUBLE)
 | |
| #define ERROR_NAME "DIMATCOPY"
 | |
| #else
 | |
| #define ERROR_NAME "SIMATCOPY"
 | |
| #endif
 | |
| 
 | |
| #define BlasRowMajor 0
 | |
| #define BlasColMajor 1
 | |
| #define BlasNoTrans  0
 | |
| #define BlasTrans    1
 | |
| 
 | |
| #undef malloc
 | |
| #undef free
 | |
| 
 | |
| /* Enables the New IMATCOPY code with inplace operation if lda == ldb   */
 | |
| #define NEW_IMATCOPY
 | |
| 
 | |
| #ifndef CBLAS
 | |
| void NAME( char* ORDER, char* TRANS, blasint *rows, blasint *cols, FLOAT *alpha, FLOAT *a, blasint *lda, blasint *ldb)
 | |
| {
 | |
| 
 | |
| 	char Order, Trans;
 | |
| 	int order=-1,trans=-1;
 | |
| 	blasint info = -1;
 | |
| 	FLOAT *b;
 | |
| 	size_t msize;
 | |
| 
 | |
| 	Order = *ORDER;
 | |
| 	Trans = *TRANS;
 | |
| 
 | |
| 	TOUPPER(Order);
 | |
| 	TOUPPER(Trans);
 | |
| 
 | |
| 	if ( Order == 'C' ) order = BlasColMajor;
 | |
| 	if ( Order == 'R' ) order = BlasRowMajor;
 | |
| 	if ( Trans == 'N' ) trans = BlasNoTrans;
 | |
| 	if ( Trans == 'R' ) trans = BlasNoTrans;
 | |
| 	if ( Trans == 'T' ) trans = BlasTrans;
 | |
| 	if ( Trans == 'C' ) trans = BlasTrans;
 | |
| #else 
 | |
| void CNAME( enum CBLAS_ORDER CORDER, enum CBLAS_TRANSPOSE CTRANS, blasint crows, blasint ccols, FLOAT calpha, FLOAT *a, blasint clda, blasint cldb)
 | |
| {
 | |
| 	int order=-1,trans=-1;
 | |
| 	blasint info = -1;
 | |
| 	FLOAT *b;
 | |
| 	size_t msize;
 | |
| 	blasint *lda, *ldb, *rows, *cols; 
 | |
| 	FLOAT *alpha; 
 | |
| 
 | |
| 	if ( CORDER == CblasColMajor) order = BlasColMajor; 
 | |
| 	if ( CORDER == CblasRowMajor) order = BlasRowMajor; 
 | |
| 	if ( CTRANS == CblasNoTrans || CTRANS == CblasConjNoTrans) trans = BlasNoTrans; 
 | |
| 	if ( CTRANS == CblasTrans   || CTRANS == CblasConjTrans  ) trans = BlasTrans; 
 | |
| 
 | |
| 	rows = &crows; 
 | |
| 	cols = &ccols; 
 | |
| 	alpha = &calpha; 
 | |
| 	lda = &clda; 
 | |
| 	ldb = &cldb; 	
 | |
| #endif 
 | |
| 
 | |
| 	if ( order == BlasColMajor)
 | |
| 	{
 | |
|         	if ( trans == BlasNoTrans  &&  *ldb < *rows ) info = 8;
 | |
|         	if ( trans == BlasTrans    &&  *ldb < *cols ) info = 8;
 | |
| 	}
 | |
| 	if ( order == BlasRowMajor)
 | |
| 	{
 | |
|         	if ( trans == BlasNoTrans  &&  *ldb < *cols ) info = 8;
 | |
|         	if ( trans == BlasTrans    &&  *ldb < *rows ) info = 8;
 | |
| 	}
 | |
| 
 | |
| 	if ( order == BlasColMajor &&  *lda < *rows ) info = 7;
 | |
| 	if ( order == BlasRowMajor &&  *lda < *cols ) info = 7;
 | |
| 	if ( *cols <= 0 ) info = 4;
 | |
| 	if ( *rows <= 0 ) info = 3;
 | |
| 	if ( trans < 0  ) info = 2;
 | |
| 	if ( order < 0  ) info = 1;
 | |
| 
 | |
| 	if (info >= 0) {
 | |
|     		BLASFUNC(xerbla)(ERROR_NAME, &info, sizeof(ERROR_NAME));
 | |
|     		return;
 | |
|   	}
 | |
| 
 | |
| #ifdef NEW_IMATCOPY
 | |
|     if ( *lda == *ldb ) {
 | |
|         if ( order == BlasColMajor )
 | |
|         {
 | |
|             if ( trans == BlasNoTrans )
 | |
|             {
 | |
|                 IMATCOPY_K_CN(*rows, *cols, *alpha, a, *lda );
 | |
|                 return;
 | |
|             }
 | |
|             else if ( *rows == *cols )
 | |
|             {
 | |
|                 IMATCOPY_K_CT(*rows, *cols, *alpha, a, *lda );
 | |
|                 return;
 | |
|             }
 | |
|         }
 | |
|         else
 | |
|         {
 | |
|             if ( trans == BlasNoTrans )
 | |
|             {
 | |
|                 IMATCOPY_K_RN(*rows, *cols, *alpha, a, *lda );
 | |
|                 return;
 | |
|             }
 | |
|             else if ( *rows == *cols )
 | |
|             {
 | |
|                 IMATCOPY_K_RT(*rows, *cols, *alpha, a, *lda );
 | |
|                 return;
 | |
|             }
 | |
|         }
 | |
|     }
 | |
| #endif
 | |
| 
 | |
| 	msize = (size_t)(*rows) * (*cols) * sizeof(FLOAT);
 | |
| 
 | |
| 	b = malloc(msize);
 | |
| 	if ( b == NULL )
 | |
| 	{
 | |
| 		printf("Memory alloc failed in imatcopy\n");
 | |
| 		exit(1);
 | |
| 	}
 | |
| 
 | |
| 	if ( order == BlasColMajor )
 | |
| 	{
 | |
| 		if ( trans == BlasNoTrans )
 | |
| 		{
 | |
| 			OMATCOPY_K_CN(*rows, *cols, *alpha, a, *lda, b, *rows );
 | |
| 			OMATCOPY_K_CN(*rows, *cols, (FLOAT) 1.0 , b, *rows, a, *ldb );
 | |
| 		}
 | |
| 		else
 | |
| 		{
 | |
| 			OMATCOPY_K_CT(*rows, *cols, *alpha, a, *lda, b, *cols );
 | |
| 			OMATCOPY_K_CN(*cols, *rows, (FLOAT) 1.0, b, *cols, a, *ldb );
 | |
| 		}
 | |
| 	}
 | |
| 	else
 | |
| 	{
 | |
| 		if ( trans == BlasNoTrans )
 | |
| 		{
 | |
| 			OMATCOPY_K_RN(*rows, *cols, *alpha, a, *lda, b, *cols );
 | |
| 			OMATCOPY_K_RN(*rows, *cols, (FLOAT) 1.0, b, *cols, a, *ldb );
 | |
| 		}
 | |
| 		else
 | |
| 		{
 | |
| 			OMATCOPY_K_RT(*rows, *cols, *alpha, a, *lda, b, *rows );
 | |
| 			OMATCOPY_K_RN(*cols, *rows, (FLOAT) 1.0, b, *rows, a, *ldb );
 | |
| 		}
 | |
| 	}
 | |
| 
 | |
| 	free(b);
 | |
| 	return;
 | |
| 
 | |
| }
 | |
| 
 | |
| 
 |