3 #include "gromacs/utility/real.h"
5 #include "../gmx_lapack.h"
6 #include "lapack_limits.h"
10 F77_FUNC(slascl,SLASCL)(const char *type,
21 const char ch=toupper(*type);
22 int i,j,k,l,k1,k2,k3,k4;
24 float minval,smlnum,bignum;
25 float cfromc, ctoc, cfrom1, cto1, mul;
30 minval = GMX_FLOAT_MIN;
31 smlnum = minval / GMX_FLOAT_EPS;
32 bignum = 1.0 / smlnum;
39 cfrom1 = cfromc * smlnum;
42 if(fabs(cfrom1)>fabs(ctoc) && fabs(ctoc)>GMX_FLOAT_MIN) {
46 } else if(fabs(cto1)>fabs(cfromc)) {
64 /* Lower triangular matrix */
71 /* Upper triangular matrix */
73 k = (j < (*m-1)) ? j : (*m-1);
80 /* Upper Hessenberg matrix */
82 k = ((j+1) < (*m-1)) ? (j+1) : (*m-1);
89 /* Symmetric band matrix, lower bandwidth KL, upper KU,
90 * only the lower half stored.
95 k = (k3 < (k4-j)) ? k3 : (k4-j);
102 /* Symmetric band matrix, lower bandwidth KL, upper KU,
103 * only the upper half stored.
108 k = ((k1-j) > 0) ? (k1-j) : 0;
110 a[j*(*lda)+i] *= mul;
115 /* Band matrix, lower bandwidth KL, upper KU. */
120 k4 = *kl + *ku - 1 + *m;
122 k = ((k1-j) > k2) ? (k1-j) : k2;
123 l = (k3 < (k4-j)) ? k3 : (k4-j);
125 a[j*(*lda)+i] *= mul;