void test01()
{
{
String on1;
on1 = "//atp:77/root/cimv25:"
"TennisPlayer.last=\"Rafter\",first=\"Patrick\"";
String on2;
on2 = "//atp:77/root/cimv25:"
"TennisPlayer.first=\"Patrick\",last=\"Rafter\"";
CIMObjectPath r = on1;
PEGASUS_TEST_ASSERT(r.toString() != on1);
PEGASUS_TEST_ASSERT(r.toString() == on2);
CIMObjectPath r2 = r;
CIMObjectPath r3 = CIMObjectPath
("//atp:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
if (verbose)
{
XmlWriter::printValueReferenceElement(r, false);
cout << r.toString() << endl;
}
Buffer mofOut;
MofWriter::appendValueReferenceElement(mofOut, r);
r.clear();
}
{
CIMObjectPath r1 = CIMObjectPath
("MyClass.z=true,y=1234,x=\"Hello World\"");
CIMObjectPath r2 = CIMObjectPath
("myclass.X=\"Hello World\",Z=true,Y=1234");
CIMObjectPath r3 = CIMObjectPath ("myclass.X=\"Hello\",Z=true,Y=1234");
// cout << r1.toString() << endl;
// cout << r2.toString() << endl;
PEGASUS_TEST_ASSERT(r1 == r2);
PEGASUS_TEST_ASSERT(r1 != r3);
}
// Test case independence and order independence of parameters.
{
CIMObjectPath r1 = CIMObjectPath ("X.a=123,b=true");
CIMObjectPath r2 = CIMObjectPath ("x.B=TRUE,A=123");
PEGASUS_TEST_ASSERT(r1 == r2);
PEGASUS_TEST_ASSERT(r1.makeHashCode() == r2.makeHashCode());
CIMObjectPath r3 = CIMObjectPath ("x.B=TRUE,A=123,c=FALSE");
PEGASUS_TEST_ASSERT(r1 != r3);
String keyValue;
Array<CIMKeyBinding> kbArray;
{
Boolean found = false;
kbArray = r3.getKeyBindings();
for (Uint32 i = 0; i < kbArray.size(); i++)
{
if (verbose)
{
cout << "keyName= " << kbArray[i].getName().getString()
<< " Value= " << kbArray[i].getValue() << endl;
}
if ( kbArray[i].getName() == CIMName ("B") )
{
keyValue = kbArray[i].getValue();
if(keyValue == "TRUE")
found = true;
}
}
if(!found)
{
cerr << "Key Binding Test error " << endl;
exit(1);
}
//ATTN: KS 12 May 2002 P3 DEFER - keybinding manipulation. too
// simplistic.
// This code demonstrates that it is not easy to manipulate and
// test keybindings. Needs better tool both in CIMObjectPath and
// separate.
}
}
// Test building from component parts of CIM Reference.
{
CIMObjectPath r1 ("atp:77", CIMNamespaceName ("root/cimv25"),
CIMName ("TennisPlayer"));
CIMObjectPath r2 ("//atp:77/root/cimv25:TennisPlayer.");
//cout << "r1 " << r1.toString() << endl;
//cout << "r2 " << r2.toString() << endl;
PEGASUS_TEST_ASSERT(r1 == r2);
PEGASUS_TEST_ASSERT(r1.toString() == r2.toString());
}
{
String hostName = "atp:77";
String nameSpace = "root/cimv2";
String className = "tennisplayer";
CIMObjectPath r1;
r1.setHost(hostName);
r1.setNameSpace(nameSpace);
r1.setClassName(className);
PEGASUS_TEST_ASSERT(r1.getClassName().equal(CIMName ("TENNISPLAYER")));
PEGASUS_TEST_ASSERT(!r1.getClassName().equal(CIMName ("blob")));
String newHostName = r1.getHost();
//cout << "HostName = " << newHostName << endl;
CIMObjectPath r2 (hostName, nameSpace, className);
PEGASUS_TEST_ASSERT(r1 == r2);
}
// Test cases for the Hostname. CIMObjectPaths allows the
// host to include the domain. Eg. xyz.company.com
// First, try a good hostname
CIMObjectPath h0("//usoPen-9.ustA-1-a.org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h1("//usoPen-9:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h2("//usoPen-9/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h3("//usoPen-9.ustA-1-a.org:0/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h4("//usoPen-9.ustA-1-a.org:9876/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h5("//usoPen-9.ustA-1-a.org:65535/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h6("//usopen-9.usta-1-a.1org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h7("//192.168.1.com:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h8("//192.168.0.org/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h9("//192.168.1.80.com:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h10("//192.168.0.80.org/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h11("//192.168.1.80.255.com:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h12("//192.168.0.80.254.org/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h13("//192.168.257.80.com:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h14("//192.256.0.80.org/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h15("//localhost/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h16("//ou812/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h17("//u812/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
// Hostname with '_' character support checks, see bug#2556.
CIMObjectPath h18("//_atp:9999/_root/_cimv25:_TennisPlayer");
CIMObjectPath h19("//a_tp/_root/_cimv25:_TennisPlayer");
CIMObjectPath h20("//atp_:9999/_root/_cimv25:_TennisPlayer");
CIMObjectPath h21("//atp_-9:9999/_root/_cimv25:_TennisPlayer");
CIMObjectPath h22(
"//_a_t_p_-9.ustA-1-a.org:9999/_root/_cimv25:_TennisPlayer");
CIMObjectPath h23("//_/root/cimv25:_TennisPlayer");
CIMObjectPath h24("//_______/root/cimv25:_TennisPlayer");
// try IPAddress as hostname which should be good
CIMObjectPath h_ip0("//192.168.1.80:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath h_ip1("//192.168.0.255/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
// Try IPv6 Addresses.
CIMObjectPath ip6_1("//[::1]:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath ip6_2("//[::ffff:192.1.2.3]:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath ip6_3("//[fffe:233:321:234d:e45:fad4:78:12]:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
CIMObjectPath ip6_4("//[fffe::]:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
Boolean errorDetected = false;
// Invalid IPV6 Addresses
try
{ // IPv6 addresses must be enclosed in brackets
CIMObjectPath ip6_mb("//fffe::12ef:127/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{ // IPv6 address invalid
CIMObjectPath ip6_invalid("//[fffe::sd:77]/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
//Port number out of range.
CIMObjectPath h_Port("//usoPen-9.ustA-1-a.org:9876543210/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
//Port number out of range.
CIMObjectPath h_Port("//usoPen-9.ustA-1-a.org:65536/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
//Port number out of range.
CIMObjectPath h_Port("//usoPen-9.ustA-1-a.org:100000/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
//more than three digits in an octect
CIMObjectPath h_ErrIp0("//192.1600008.1.80:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Octet out of range
CIMObjectPath op("//192.168.256.80:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Missing port is okay, needs be ignored
CIMObjectPath op("//192.168.1.80:/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(!errorDetected);
errorDetected = false;
try
{
// Too many octets
CIMObjectPath op("//192.168.1.80.12/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Too few octets
CIMObjectPath op("//192.168.80:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Missing port is okay, needs be ignored
CIMObjectPath op("//usopen-9.usta-1-a.org:/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(!errorDetected);
errorDetected = false;
try
{
// Hostname (IP) without trailing '/' (with port)
CIMObjectPath op("//192.168.256.80:77");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Hostname (IP) without trailing '/' (without port)
CIMObjectPath op("//192.168.256.80");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Hostname without trailing '/' (with port)
CIMObjectPath op("//usopen-9.usta-1-a.org:77");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Hostname without trailing '/' (without port)
CIMObjectPath op("//usopen-9.usta-1-a.org");
}
catch (const Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Invalid first character
CIMObjectPath op("//+usopen-9.usta-1-a.1org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Non-alphanum char (?)
CIMObjectPath op("//usopen-9.usta?-1-a.org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Leading dot
CIMObjectPath op("//.usopen-9.usta-1-a.org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Dot in the wrong spot (before a -)
CIMObjectPath op("//usopen.-9.usta-1-a.org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Two dots in a row
CIMObjectPath op("//usopen-9.usta-1-a..org:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
errorDetected = false;
try
{
// Trailing dot
CIMObjectPath op("//usopen-9.usta-1-a.org.:77/root/cimv25:"
"TennisPlayer.first=\"Chris\",last=\"Evert\"");
}
catch (Exception&)
{
errorDetected = true;
}
PEGASUS_TEST_ASSERT(errorDetected);
}
/* --std=c90 -Wv */
void f1(void) { int i; struct tag { int x; } x; int *p; i(); x(); p(); }
void f2(void) { void h2(int, double); void g2(); h2(0, 1); g2(0, 1); } /* prototype vs. non-prototype */
void f3(void) { struct tag { int x; } h3(void), x; int g3(void), y; x = h3(); y = g3(); } /* struct vs. non-struct */
void f4(void) { struct tag h4(void); h4(); } /* error - incomplete return */
void f5(void) { void h5(int, double); void g5(void); h5(0, 1); g5(); } /* argument vs. no argument */
void f6(void) { struct tag; void h6(struct tag); struct tag *p; h6(*p); } /* error - incomplete argument */
void f7(void) { void h7(int, ...); int x; h7(x, x, 0); } /* arguments to variadic part */
void f8(void) { struct tag { int x; } x; void h8(int, struct tag, int *); h8(&x, x, &x); } /* error - incompatible argument */
void f9(void) { void h9(char, short, int, long); char c; short s; int i; long l; h9(c, s, i, l); } /* arguments that promote */
void f10(void) { void h10(int); h10(0, 1, 2); } /* error - extra arguments */
void f11(void) { void h11(int, ...); char c; short s; float f; double d; h11(1, c, s, f, d); } /* arguments to variadic part */
void f12(void) { void h12(int, ...); struct tag *p; h12(0, *p, *p); } /* incomplete arguments to variadic part */
int nnls(double* a, int mda, int m, int n, double* b,
double* x, double* rnorm, double* w, double* zz, int* index,
int* mode, int maxIter)
{
/* System generated locals */
int a_dim1, a_offset, idx1, idx2;
double d1, d2;
/* Local variables */
static int iter;
static double temp, wmax;
static int i__, j, l;
static double t, alpha, asave;
static int itmax, izmax, nsetp;
static double unorm, ztest, cc;
double dummy[2];
static int ii, jj, ip;
static double sm;
static int iz, jz;
static double up, ss;
static int rtnkey, iz1, iz2, npp1;
/* ------------------------------------------------------------------
*/
/* int INDEX(N) */
/* double precision A(MDA,N), B(M), W(N), X(N), ZZ(M) */
/* ------------------------------------------------------------------
*/
/* Parameter adjustments */
a_dim1 = mda;
a_offset = a_dim1 + 1;
a -= a_offset;
--b;
--x;
--w;
--zz;
--index;
/* Function Body */
*mode = 1;
if (m <= 0 || n <= 0) {
*mode = 2;
return 0;
}
iter = 0;
// MODIFYING MAX NUMBER OF NNLS ITERATIONS ALLOWED
//itmax = n;
//itmax = n * 3;
//itmax = n * 10;
itmax = n * maxIter;
/* INITIALIZE THE ARRAYS INDEX() AND X(). */
idx1 = n;
for (i__ = 1; i__ <= idx1; ++i__) {
x[i__] = 0.;
/* L20: */
index[i__] = i__;
}
iz2 = n;
iz1 = 1;
nsetp = 0;
npp1 = 1;
/* ****** MAIN LOOP BEGINS HERE ****** */
L30:
/* QUIT IF ALL COEFFICIENTS ARE ALREADY IN THE SOLUTION.
*/
/* OR IF M COLS OF A HAVE BEEN TRIANGULARIZED. */
if (iz1 > iz2 || nsetp >= m) {
goto L350;
}
/* COMPUTE COMPONENTS OF THE DUAL (NEGATIVE GRADIENT) VECTOR W().
*/
idx1 = iz2;
for (iz = iz1; iz <= idx1; ++iz) {
j = index[iz];
sm = 0.;
idx2 = m;
for (l = npp1; l <= idx2; ++l) {
/* L40: */
sm += a[l + j * a_dim1] * b[l];
}
w[j] = sm;
/* L50: */
}
/* FIND LARGEST POSITIVE W(J). */
L60:
wmax = 0.;
idx1 = iz2;
for (iz = iz1; iz <= idx1; ++iz) {
j = index[iz];
if (w[j] > wmax) {
wmax = w[j];
izmax = iz;
}
/* L70: */
}
/* IF WMAX .LE. 0. GO TO TERMINATION. */
/* THIS INDICATES SATISFACTION OF THE KUHN-TUCKER CONDITIONS.
*/
if (wmax <= 0.) {
goto L350;
}
iz = izmax;
j = index[iz];
/* THE SIGN OF W(J) IS OK FOR J TO BE MOVED TO SET P. */
/* BEGIN THE TRANSFORMATION AND CHECK NEW DIAGONAL ELEMENT TO AVOID */
/* NEAR LINEAR DEPENDENCE. */
asave = a[npp1 + j * a_dim1];
idx1 = npp1 + 1;
h12(c__1, &npp1, &idx1, m, &a[j * a_dim1 + 1], &c__1, &up, dummy, &
c__1, &c__1, &c__0);
unorm = 0.;
if (nsetp != 0) {
idx1 = nsetp;
for (l = 1; l <= idx1; ++l) {
/* L90: */
/* Computing 2nd power */
d1 = a[l + j * a_dim1];
unorm += d1 * d1;
}
}
unorm = sqrt(unorm);
d2 = unorm + (d1 = a[npp1 + j * a_dim1], nnls_abs(d1)) * .01;
if ((d2- unorm) > 0.) {
/* COL J IS SUFFICIENTLY INDEPENDENT. COPY B INTO ZZ, UPDATE Z
Z */
/* AND SOLVE FOR ZTEST ( = PROPOSED NEW VALUE FOR X(J) ). */
idx1 = m;
for (l = 1; l <= idx1; ++l) {
/* L120: */
zz[l] = b[l];
}
idx1 = npp1 + 1;
h12(c__2, &npp1, &idx1, m, &a[j * a_dim1 + 1], &c__1, &up, (zz+1), &
c__1, &c__1, &c__1);
ztest = zz[npp1] / a[npp1 + j * a_dim1];
/* SEE IF ZTEST IS POSITIVE */
if (ztest > 0.) {
goto L140;
}
}
/* REJECT J AS A CANDIDATE TO BE MOVED FROM SET Z TO SET P. */
/* RESTORE A(NPP1,J), SET W(J)=0., AND LOOP BACK TO TEST DUAL */
/* COEFFS AGAIN. */
a[npp1 + j * a_dim1] = asave;
w[j] = 0.;
goto L60;
/* THE INDEX J=INDEX(IZ) HAS BEEN SELECTED TO BE MOVED FROM */
/* SET Z TO SET P. UPDATE B, UPDATE INDICES, APPLY HOUSEHOLDER */
/* TRANSFORMATIONS TO COLS IN NEW SET Z, ZERO SUBDIAGONAL ELTS IN */
/* COL J, SET W(J)=0. */
L140:
idx1 = m;
for (l = 1; l <= idx1; ++l) {
/* L150: */
b[l] = zz[l];
}
index[iz] = index[iz1];
index[iz1] = j;
++iz1;
nsetp = npp1;
++npp1;
if (iz1 <= iz2) {
idx1 = iz2;
for (jz = iz1; jz <= idx1; ++jz) {
jj = index[jz];
h12(c__2, &nsetp, &npp1, m,
&a[j * a_dim1 + 1], &c__1, &up,
&a[jj * a_dim1 + 1], &c__1, &mda, &c__1);
/* L160: */
}
}
if (nsetp != m) {
idx1 = m;
for (l = npp1; l <= idx1; ++l) {
/* L180: */
// SS: CHECK THIS DAMAGE....
a[l + j * a_dim1] = 0.;
}
}
w[j] = 0.;
/* SOLVE THE TRIANGULAR SYSTEM. */
/* STORE THE SOLUTION TEMPORARILY IN ZZ().
*/
rtnkey = 1;
goto L400;
L200:
/* ****** SECONDARY LOOP BEGINS HERE ****** */
/* ITERATION COUNTER. */
L210:
++iter;
if (iter > itmax) {
*mode = 3;
/* The following lines were replaced after the f2c translation */
/* s_wsfe(&io___22); */
/* do_fio(&c__1, " NNLS quitting on iteration count.", 34L); */
/* e_wsfe(); */
fprintf(stdout, "\n NNLS quitting on iteration count.\n");
fflush(stdout);
goto L350;
}
/* SEE IF ALL NEW CONSTRAINED COEFFS ARE FEASIBLE. */
/* IF NOT COMPUTE ALPHA. */
alpha = 2.;
idx1 = nsetp;
for (ip = 1; ip <= idx1; ++ip) {
l = index[ip];
if (zz[ip] <= 0.) {
t = -x[l] / (zz[ip] - x[l]);
if (alpha > t) {
alpha = t;
jj = ip;
}
}
/* L240: */
}
/* IF ALL NEW CONSTRAINED COEFFS ARE FEASIBLE THEN ALPHA WILL */
/* STILL = 2. IF SO EXIT FROM SECONDARY LOOP TO MAIN LOOP. */
if (alpha == 2.) {
goto L330;
}
/* OTHERWISE USE ALPHA WHICH WILL BE BETWEEN 0. AND 1. TO */
/* INTERPOLATE BETWEEN THE OLD X AND THE NEW ZZ. */
idx1 = nsetp;
for (ip = 1; ip <= idx1; ++ip) {
l = index[ip];
x[l] += alpha * (zz[ip] - x[l]);
/* L250: */
}
/* MODIFY A AND B AND THE INDEX ARRAYS TO MOVE COEFFICIENT I */
/* FROM SET P TO SET Z. */
i__ = index[jj];
L260:
x[i__] = 0.;
if (jj != nsetp) {
++jj;
idx1 = nsetp;
for (j = jj; j <= idx1; ++j) {
ii = index[j];
index[j - 1] = ii;
g1(&a[j - 1 + ii * a_dim1], &a[j + ii * a_dim1],
&cc, &ss, &a[j - 1 + ii * a_dim1]);
// SS: CHECK THIS DAMAGE...
a[j + ii * a_dim1] = 0.;
idx2 = n;
for (l = 1; l <= idx2; ++l) {
if (l != ii) {
/* Apply procedure G2 (CC,SS,A(J-1,L),A(J,
L)) */
temp = a[j - 1 + l * a_dim1];
// SS: CHECK THIS DAMAGE
a[j - 1 + l * a_dim1] = cc * temp + ss * a[j + l * a_dim1];
a[j + l * a_dim1] = -ss * temp + cc * a[j + l * a_dim1];
}
/* L270: */
}
/* Apply procedure G2 (CC,SS,B(J-1),B(J)) */
temp = b[j - 1];
b[j - 1] = cc * temp + ss * b[j];
b[j] = -ss * temp + cc * b[j];
/* L280: */
}
}
npp1 = nsetp;
--nsetp;
--iz1;
index[iz1] = i__;
/* SEE IF THE REMAINING COEFFS IN SET P ARE FEASIBLE. THEY SHOULD
*/
/* BE BECAUSE OF THE WAY ALPHA WAS DETERMINED. */
/* IF ANY ARE INFEASIBLE IT IS DUE TO ROUND-OFF ERROR. ANY */
/* THAT ARE NONPOSITIVE WILL BE SET TO ZERO */
/* AND MOVED FROM SET P TO SET Z. */
idx1 = nsetp;
for (jj = 1; jj <= idx1; ++jj) {
i__ = index[jj];
if (x[i__] <= 0.) {
goto L260;
}
/* L300: */
}
/* COPY B( ) INTO ZZ( ). THEN SOLVE AGAIN AND LOOP BACK. */
idx1 = m;
for (i__ = 1; i__ <= idx1; ++i__) {
/* L310: */
zz[i__] = b[i__];
}
rtnkey = 2;
goto L400;
L320:
goto L210;
/* ****** END OF SECONDARY LOOP ****** */
L330:
idx1 = nsetp;
for (ip = 1; ip <= idx1; ++ip) {
i__ = index[ip];
/* L340: */
x[i__] = zz[ip];
}
/* ALL NEW COEFFS ARE POSITIVE. LOOP BACK TO BEGINNING. */
goto L30;
/* ****** END OF MAIN LOOP ****** */
/* COME TO HERE FOR TERMINATION. */
/* COMPUTE THE NORM OF THE FINAL RESIDUAL VECTOR. */
L350:
sm = 0.;
if (npp1 <= m) {
idx1 = m;
for (i__ = npp1; i__ <= idx1; ++i__) {
/* L360: */
/* Computing 2nd power */
d1 = b[i__];
sm += d1 * d1;
}
} else {
idx1 = n;
for (j = 1; j <= idx1; ++j) {
/* L380: */
w[j] = 0.;
}
}
*rnorm = sqrt(sm);
return 0;
/* THE FOLLOWING BLOCK OF CODE IS USED AS AN INTERNAL SUBROUTINE */
/* TO SOLVE THE TRIANGULAR SYSTEM, PUTTING THE SOLUTION IN ZZ(). */
L400:
idx1 = nsetp;
for (l = 1; l <= idx1; ++l) {
ip = nsetp + 1 - l;
if (l != 1) {
idx2 = ip;
for (ii = 1; ii <= idx2; ++ii) {
zz[ii] -= a[ii + jj * a_dim1] * zz[ip + 1];
/* L410: */
}
}
jj = index[ip];
zz[ip] /= a[ip + jj * a_dim1];
/* L430: */
}
switch ((int)rtnkey) {
case 1: goto L200;
case 2: goto L320;
}
/* The next line was added after the f2c translation to keep
compilers from complaining about a void return from a non-void
function. */
return 0;
} /* nnls_ */
int64_t nnls_algorithm(double *a, int64_t m,int64_t n, double *b, double *x, double *rnorm) {
int64_t pfeas;
int ret=0;
int64_t iz;
int64_t jz;
int64_t k, j=0, l, itmax, izmax=0, ii, jj=0, ip;
double d1, d2, sm, up, ss;
double temp, wmax, t, alpha, asave, dummy, unorm, ztest, cc;
/* Check the parameters and data */
if(m <= 0 || n <= 0 || a == NULL || b == NULL || x == NULL)
return(2);
/* Allocate memory for working space, if required */
double *w = calloc(n, sizeof(double));
double *zz = calloc(m, sizeof(double));
int64_t *index = calloc(n, sizeof(int64_t));
if(w == NULL || zz == NULL || index == NULL)
return(2);
/* Initialize the arrays INDEX[] and X[] */
for(k=0; k<n; k++) {
x[k]=0.;
index[k]=k;
}
int64_t iz2 = n - 1;
int64_t iz1 = 0;
int64_t iter=0;
int64_t nsetp=0;
int64_t npp1=0;
/* Main loop; quit if all coeffs are already in the solution or */
/* if M cols of A have been triangularized */
if(n < 3)
itmax=n*3;
else
itmax=n*n;
while(iz1 <= iz2 && nsetp < m) {
/* Compute components of the dual (negative gradient) vector W[] */
for(iz=iz1; iz<=iz2; iz++) {
j=index[iz];
sm=0.;
for(l=npp1; l<m; l++)
sm+=a[j*m + l]*b[l];
w[j]=sm;
}
while(1) {
/* Find largest positive W[j] */
for(wmax=0., iz=iz1; iz<=iz2; iz++) {
j=index[iz]; if(w[j]>wmax) {wmax=w[j]; izmax=iz;}}
/* Terminate if wmax<=0.; */
/* it indicates satisfaction of the Kuhn-Tucker conditions */
if(wmax<=0.0)
break;
iz=izmax;
j=index[iz];
/* The sign of W[j] is ok for j to be moved to set P. */
/* Begin the transformation and check new diagonal element to avoid */
/* near linear dependence. */
asave=a[j*m + npp1];
h12(1, npp1, npp1+1, m, &a[j*m +0], 1, &up, &dummy, 1, 1, 0);
unorm=0.;
if(nsetp!=0){
for(l=0; l<nsetp; l++) {
d1=a[j*m + l];
unorm+=d1*d1;
}
}
unorm=sqrt(unorm);
d2=unorm+(d1=a[j*m + npp1], fabs(d1)) * 0.01;
if((d2-unorm)>0.) {
/* Col j is sufficiently independent. Copy B into ZZ, update ZZ */
/* and solve for ztest ( = proposed new value for X[j] ) */
for(l=0; l<m; l++) zz[l]=b[l];
h12(2, npp1, npp1+1, m, &a[j*m + 0], 1, &up, zz, 1, 1, 1);
ztest=zz[npp1]/a[j*m +npp1];
/* See if ztest is positive */
if(ztest>0.) break;
}
/* Reject j as a candidate to be moved from set Z to set P. Restore */
/* A[npp1,j], set W[j]=0., and loop back to test dual coeffs again */
a[j*m+ npp1]=asave; w[j]=0.;
} /* while(1) */
if(wmax<=0.0)
break;
/* Index j=INDEX[iz] has been selected to be moved from set Z to set P. */
/* Update B and indices, apply householder transformations to cols in */
/* new set Z, zero subdiagonal elts in col j, set W[j]=0. */
for(l=0; l<m; ++l)
b[l]=zz[l];
index[iz]=index[iz1];
index[iz1]=j;
iz1++;
npp1++;
nsetp=npp1;
if(iz1<=iz2) {
for(jz=iz1; jz<=iz2; jz++) {
jj=index[jz];
h12(2, nsetp-1, npp1, m, &a[j*m +0], 1, &up, &a[jj*m +0], 1, m, 1);
}
}
if(nsetp!=m) {
for(l=npp1; l<m; l++)
a[j*m +l]=0.;
}
w[j]=0.;
/* Solve the triangular system; store the solution temporarily in Z[] */
for(l=0; l<nsetp; l++) {
ip=nsetp-(l+1);
if(l!=0) for(ii=0; ii<=ip; ii++) zz[ii]-=a[jj*m + ii]*zz[ip+1];
jj=index[ip]; zz[ip]/=a[jj*m +ip];
}
/* Secondary loop begins here */
while(++iter < itmax) {
/* See if all new constrained coeffs are feasible; if not, compute alpha */
for(alpha = 2.0, ip = 0; ip < nsetp; ip++) {
l=index[ip];
if(zz[ip]<=0.) {
t = -x[l]/(zz[ip]-x[l]);
if(alpha > t) {
alpha = t;
jj = ip - 1;
}
}
}
/* If all new constrained coeffs are feasible then still alpha==2. */
/* If so, then exit from the secondary loop to main loop */
if(alpha==2.0)
break;
/* Use alpha (0.<alpha<1.) to interpolate between old X and new ZZ */
for(ip=0; ip<nsetp; ip++) {
l = index[ip];
x[l] += alpha*(zz[ip]-x[l]);
}
/* Modify A and B and the INDEX arrays to move coefficient i */
/* from set P to set Z. */
k=index[jj+1]; pfeas=1;
do {
x[k]=0.;
if(jj!=(nsetp-1)) {
jj++;
for(j=jj+1; j<nsetp; j++) {
ii=index[j]; index[j-1]=ii;
g1(a[ii*m + (j-1)], a[ii*m + j], &cc, &ss, &a[ii*m + j-1]);
for(a[ii*m + j]=0., l=0; l<n; l++) if(l!=ii) {
/* Apply procedure G2 (CC,SS,A(J-1,L),A(J,L)) */
temp=a[l*m + j-1];
a[l*m + j-1]=cc*temp+ss*a[l*m + j];
a[l*m + j]=-ss*temp+cc*a[l*m + j];
}
/* Apply procedure G2 (CC,SS,B(J-1),B(J)) */
temp=b[j-1]; b[j-1]=cc*temp+ss*b[j]; b[j]=-ss*temp+cc*b[j];
}
}
npp1=nsetp-1; nsetp--; iz1--; index[iz1]=k;
/* See if the remaining coeffs in set P are feasible; they should */
/* be because of the way alpha was determined. If any are */
/* infeasible it is due to round-off error. Any that are */
/* nonpositive will be set to zero and moved from set P to set Z */
for(jj=0, pfeas=1; jj<nsetp; jj++) {
k=index[jj]; if(x[k]<=0.) {pfeas=0; break;}
}
} while(pfeas==0);
/* Copy B[] into zz[], then solve again and loop back */
for(k=0; k<m; k++)
zz[k]=b[k];
for(l=0; l<nsetp; l++) {
ip=nsetp-(l+1);
if(l!=0) for(ii=0; ii<=ip; ii++) zz[ii]-=a[jj*m + ii]*zz[ip+1];
jj=index[ip]; zz[ip]/=a[jj*m + ip];
}
} /* end of secondary loop */
if(iter>=itmax) {
ret = 1;
break;
}
for(ip=0; ip<nsetp; ip++) {
k=index[ip];
x[k]=zz[ip];
}
} /* end of main loop */
/* Compute the norm of the final residual vector */
sm=0.;
if (rnorm != NULL) {
if (npp1<m)
for (k=npp1; k<m; k++)
sm+=(b[k] * b[k]);
else
for (j=0; j<n; j++)
w[j]=0.;
*rnorm=sqrt(sm);
}
/* Free working space, if it was allocated here */
free(w);
free(zz);
free(index);
return(ret);
}
