/* DenseMtx_mmm.c */ #include "../Iter.h" /*--------------------------------------------------------------------*/ /* ------------------------------------------- performs the matrix-matrix operations C = beta*C + alpha*(A)*(B) A, B and C must be column major. Parameters --- A_opt -- form of op( A ) to be used = 'N' or 'n', op( A ) = A. = 'T' or 't', op( A ) = A'. = 'C' or 'c', op( A ) = A*. B_opt -- form of op( B ) to be used = 'N' or 'n', op( B ) = B. = 'T' or 't', op( B ) = B'. = 'C' or 'c', op( B ) = B*. return values --- 1 -- normal return -1 -- C, A, B, alpha or beta is NULL -2 -- type of A, B or C are invalid -3 -- row or column of A and B is not match -4 -- invalid option for A or B created -- 98dec11, ycp ------------------------------------------- */ int DenseMtx_mmm( char *A_opt, char *B_opt, double *beta, DenseMtx *mtxC, double *alpha, DenseMtx *mtxA, DenseMtx *mtxB ) { int nrowA, ncolA, rowincA, colincA; int nrowB, ncolB, rowincB, colincB; int nrowC, ncolC, rowincC, colincC; int ierr, i, k, j, l; double *Ai, *Bj, *Ci, r_alpha, r_beta, r_temp, im_temp, im_alpha, im_beta; double one[2]={1.0, 0.0}, zero[2]={0.0, 0.0}, aconj[2], bconj[2] ; double temp[2]={0.0, 0.0}, result[2]={1.0, 0.0} ; if ( beta == NULL || alpha == NULL || mtxC == NULL || mtxA == NULL || mtxB == NULL ){ fprintf(stderr, "\n fatal error in Input" "\n one or more of beta, alpha, mtxC, mtxB and" " mtxA is NULL\n") ; return(-1) ; } if ( (DENSEMTX_IS_REAL(mtxA) != DENSEMTX_IS_REAL(mtxB)) || (DENSEMTX_IS_REAL(mtxA) != DENSEMTX_IS_REAL(mtxC)) ){ fprintf(stderr,"mtxA, mtxB and mtxC do not have the same data type\n"); return(-2); } DenseMtx_dimensions(mtxA, &nrowA, &ncolA); DenseMtx_dimensions(mtxB, &nrowB, &ncolB); DenseMtx_dimensions(mtxC, &nrowC, &ncolC); rowincA=DenseMtx_rowIncrement(mtxA); colincA=DenseMtx_columnIncrement(mtxA); rowincB=DenseMtx_rowIncrement(mtxB); colincB=DenseMtx_columnIncrement(mtxB); rowincC=DenseMtx_rowIncrement(mtxC); colincC=DenseMtx_columnIncrement(mtxC); r_alpha=*alpha; r_beta =*beta; r_temp =*temp; if ( B_opt[0] == 'N' || B_opt[0] == 'n' ){ if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := beta*c+alpha*A*B*/ if (ncolA != nrowB || nrowC != nrowA || ncolC != ncolB) { fprintf(stderr,"Error in Input DenseMtx_mmm\n"); return(-3); } } else if ( (A_opt[0] == 'T' || A_opt[0] == 't') || (A_opt[0] == 'C' || A_opt[0] == 'c') ){ if (nrowA != nrowB || nrowC != ncolA || ncolC != ncolB) { fprintf(stderr,"Error in Input DenseMtx_mmm\n"); exit(-3); } } else { fprintf(stderr,"Invalid option for mtxA\n"); return(-4); } } else if ( (B_opt[0] == 'T' || B_opt[0] == 't') || (B_opt[0] == 'C' || B_opt[0] == 'c') ){ if (A_opt[0] == 'N' || A_opt[0] == 'n'){ if (ncolA != ncolB || nrowC != nrowA || ncolC != nrowB) { fprintf(stderr,"Error in Input DenseMtx_mmm\n"); return(-3); } } else if ( (A_opt[0] == 'T' || A_opt[0] == 't') || (A_opt[0] == 'C' || A_opt[0] == 'c') ){ if (nrowA != ncolB || nrowC != ncolA || ncolC != nrowB) { fprintf(stderr,"Error in Input DenseMtx_mmm\n"); return(-3); } } else { fprintf(stderr,"Invalid option for mtxA\n"); return(-4); } } else { fprintf(stderr,"Invalid option for mtxB\n"); return(-4); } if (DENSEMTX_IS_REAL(mtxA)) { if ( r_alpha == *zero ) { if( r_beta == *zero ) { DenseMtx_zero (mtxC); } else { DenseMtx_scale(mtxC,&r_beta); } return(1); } if ( B_opt[0] == 'N' || B_opt[0] == 'n' ){ if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := beta*c+alpha*A*B*/ for (i=0; i