[Math-atlas-commits] CVS: AtlasBase/Clint atlas-lp.base,1.40,1.41 From: R. Clint Whaley - 2010-04-07 17:22 ```Update of /cvsroot/math-atlas/AtlasBase/Clint In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv16570/Clint Modified Files: atlas-lp.base Log Message: Index: atlas-lp.base =================================================================== RCS file: /cvsroot/math-atlas/AtlasBase/Clint/atlas-lp.base,v retrieving revision 1.40 retrieving revision 1.41 diff -C2 -d -r1.40 -r1.41 *** atlas-lp.base 6 Apr 2010 15:54:09 -0000 1.40 --- atlas-lp.base 7 Apr 2010 17:22:08 -0000 1.41 *************** *** 2787,2790 **** --- 2787,2804 ---- /* + * Enumerated type for LAPACK's matrix types: + * G : general rectangular matrix + * L : Lower triangular + * U : Upper triangular + * H : Upper hessenburg + * B : symmetric band matrix wt lower bandwidth KL & upper BW KU + * and wt only the lower half stored + * Q : symmetric band matrix wt lower bandwidth KL & upper BW KU + * and wt only the upper half stored + * Z : band matrix wt lower bandwidth KL & upper BW KU + */ + enum ATL_LAMATTYPE + {LAMATG=0, LAMATL=1, LAMATU=2, LAMATH=3, LAMATB=4, LAMATQ=5, LAMATZ=6}; + /* * Define LAPACK flag arguments as powers of two so we can | them together * for calls to ILAENV *************** *** 3243,3244 **** --- 3257,3325 ---- nb = ATL_ilaenv(LAIS_OPT_NB, @(ilart), opts, M, N, K, -1); } + @ROUT lascl + int Mjoin(PATL,lascl) + ( + const enum ATL_LAMATTYPE mtyp, /* matrix type */ + ATL_CINT KL, /* lower bandwidth for banded mat types */ + ATL_CINT KU, /* upper bandwidth for banded mat types */ + const TYPE den0, /* denominator of scaling fraction */ + const TYPE num0, /* numerator of scaling fraction */ + ATL_CINT M, /* matrix rows for non-band matrices */ + ATL_CINT N, /* matrix cols for non-band matrices */ + TYPE *A, /* matrix to safely scale by fraction */ + ATL_CINT lda + ) + /* + * Safely scales the matrix A by the fraction (num0/den0) + */ + { + if (den0 == 0.0 || den0 != den0) /* illegal to have 0 or NaN denom */ + return(-4); + if (num0 != num0) /* NaN not allowed for numerator */ + return(-5); + switch (mtyp) + { + case LAMATG: + case LAMATL: + case LAMATU: + case LAMATH: + if (!N || !M) + return(0); + if (M < 0) + return(-6); + if (N < 0) + return(-7); + if (lda < M) + return(-9); + break; + case LAMATB: + if (!N || !KL) + return(0); + if (N < 0) + return(-7); + if (KL < 0) + return(-2); + break; + case LAMATQ: + if (!N || !KU) + return(0); + if (N < 0) + return(-7); + if (KU < 0) + return(-3); + break; + case LAMATZ: + if (M < 0) + return(-6); + if (N < 0) + return(-7); + if (KL < 0) + return(-2); + if (KU < 0) + return(-3); + break; + default: + return(-1); + } + return(0); + } ```