| private static formk ( int n, int nsub, int ind, int _ind_offset, int nenter, int ileave, int indx2, int _indx2_offset, int iupdat, bool updatd, double wn, int _wn_offset, double wn1, int _wn1_offset, int m, double ws, int _ws_offset, double wy, int _wy_offset, double sy, int _sy_offset, double theta, int col, int head, int &info ) : void | ||
| n | int | |
| nsub | int | |
| ind | int | |
| _ind_offset | int | |
| nenter | int | |
| ileave | int | |
| indx2 | int | |
| _indx2_offset | int | |
| iupdat | int | |
| updatd | bool | |
| wn | double | |
| _wn_offset | int | |
| wn1 | double | |
| _wn1_offset | int | |
| m | int | |
| ws | double | |
| _ws_offset | int | |
| wy | double | |
| _wy_offset | int | |
| sy | double | |
| _sy_offset | int | |
| theta | double | |
| col | int | |
| head | int | |
| info | int | |
| return | void | |
private static void formk(int n, int nsub, int[] ind, int _ind_offset,
int nenter, int ileave, int[] indx2, int _indx2_offset,
int iupdat, bool updatd, double[] wn, int _wn_offset, double[] wn1, int _wn1_offset,
int m, double[] ws, int _ws_offset, double[] wy, int _wy_offset,
double[] sy, int _sy_offset, double theta, int col, int head,
ref int info)
{
int m2 = 0;
int ipntr = 0;
int jpntr = 0;
int iy = 0;
int is2 = 0;
int jy = 0;
int js = 0;
int is1 = 0;
int js1 = 0;
int k1 = 0;
int i = 0;
int k = 0;
int col2 = 0;
int pbegin = 0;
int pend = 0;
int dbegin = 0;
int dend = 0;
int upcl = 0;
double temp1 = 0.0d;
double temp2 = 0.0d;
double temp3 = 0.0d;
double temp4 = 0.0d;
if (updatd)
{
if ((iupdat > m))
{
// c shift old part of WN1.
{
for (jy = 1; jy <= (m - 1); jy++)
{
js = (m + jy);
dcopy((m - jy), wn1, ((jy + 1) - (1)) + ((jy + 1) - (1)) * ((2 * m))
+ _wn1_offset, 1, wn1, (jy - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset, 1);
dcopy((m - jy), wn1, ((js + 1) - (1)) + ((js + 1) - (1)) * ((2 * m))
+ _wn1_offset, 1, wn1, (js - (1)) + (js - (1)) * ((2 * m)) + _wn1_offset, 1);
dcopy((m - 1), wn1, ((m + 2) - (1)) + ((jy + 1) - (1)) * ((2 * m))
+ _wn1_offset, 1, wn1, ((m + 1) - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset, 1);
}
}
}
//
// c put new rows in blocks (1,1), (2,1) and (2,2).
pbegin = 1;
pend = nsub;
dbegin = (nsub + 1);
dend = n;
iy = col;
is2 = (m + col);
ipntr = ((head + col) - 1);
if ((ipntr > m))
{
ipntr = (ipntr - m);
}
jpntr = head;
{
for (jy = 1; jy <= col; jy++)
{
js = (m + jy);
temp1 = 0.0;
temp2 = 0.0;
temp3 = 0.0;
// c compute element jy of row 'col' of Y'ZZ'Y
{
for (k = pbegin; k <= pend; k++)
{
k1 = ind[(k - (1)) + _ind_offset];
temp1 = (temp1 + (wy[(k1 - (1)) + (ipntr - (1))
* (n) + _wy_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
}
}
// c compute elements jy of row 'col' of L_a and S'AA'S
{
for (k = dbegin; k <= dend; k++)
{
k1 = ind[(k - (1)) + _ind_offset];
temp2 = (temp2 + (ws[(k1 - (1)) + (ipntr - (1))
* (n) + _ws_offset] * ws[(k1 - (1)) + (jpntr - (1)) * (n) + _ws_offset]));
temp3 = (temp3 + (ws[(k1 - (1)) + (ipntr - (1))
* (n) + _ws_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
}
}
wn1[(iy - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] = temp1;
wn1[(is2 - (1)) + (js - (1)) * ((2 * m)) + _wn1_offset] = temp2;
wn1[(is2 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] = temp3;
jpntr = ((jpntr) % (m) + 1);
}
}
//
// c put new column in block (2,1).
jy = col;
jpntr = ((head + col) - 1);
if ((jpntr > m))
{
jpntr = (jpntr - m);
}
ipntr = head;
{
for (i = 1; i <= col; i++)
{
is2 = (m + i);
temp3 = 0.0;
// c compute element i of column 'col' of R_z
{
for (k = pbegin; k <= pend; k++)
{
k1 = ind[(k - (1)) + _ind_offset];
temp3 = (temp3 + (ws[(k1 - (1)) + (ipntr - (1))
* (n) + _ws_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
}
}
ipntr = ((ipntr) % (m) + 1);
wn1[(is2 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] = temp3;
}
}
upcl = (col - 1);
}
else
{
upcl = col;
}
//
// c modify the old parts in blocks (1,1) and (2,2) due to changes
// c in the set of free variables.
ipntr = head;
{
for (iy = 1; iy <= upcl; iy++)
{
is2 = (m + iy);
jpntr = head;
{
for (jy = 1; jy <= iy; jy++)
{
js = (m + jy);
temp1 = 0.0;
temp2 = 0.0;
temp3 = 0.0;
temp4 = 0.0;
{
for (k = 1; k <= nenter; k++)
{
k1 = indx2[(k - (1)) + _indx2_offset];
temp1 = (temp1 + (wy[(k1 - (1)) + (ipntr - (1))
* (n) + _wy_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
temp2 = (temp2 + (ws[(k1 - (1)) + (ipntr - (1))
* (n) + _ws_offset] * ws[(k1 - (1)) + (jpntr - (1)) * (n) + _ws_offset]));
}
}
{
for (k = ileave; k <= n; k++)
{
k1 = indx2[(k - (1)) + _indx2_offset];
temp3 = (temp3 + (wy[(k1 - (1)) + (ipntr
- (1)) * (n) + _wy_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
temp4 = (temp4 + (ws[(k1 - (1)) + (ipntr
- (1)) * (n) + _ws_offset] * ws[(k1 - (1)) + (jpntr - (1)) * (n) + _ws_offset]));
}
}
wn1[(iy - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] =
((wn1[(iy - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] + temp1) - temp3);
wn1[(is2 - (1)) + (js - (1)) * ((2 * m)) + _wn1_offset] =
((wn1[(is2 - (1)) + (js - (1)) * ((2 * m)) + _wn1_offset] - temp2) + temp4);
jpntr = ((jpntr) % (m) + 1);
}
}
ipntr = ((ipntr) % (m) + 1);
}
}
//
// c modify the old parts in block (2,1).
ipntr = head;
{
for (is2 = (m + 1); is2 <= (m + upcl); is2++)
{
jpntr = head;
{
for (jy = 1; jy <= upcl; jy++)
{
temp1 = 0.0;
temp3 = 0.0;
{
for (k = 1; k <= nenter; k++)
{
k1 = indx2[(k - (1)) + _indx2_offset];
temp1 = (temp1 + (ws[(k1 - (1)) + (ipntr
- (1)) * (n) + _ws_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
}
}
{
for (k = ileave; k <= n; k++)
{
k1 = indx2[(k - (1)) + _indx2_offset];
temp3 = (temp3 + (ws[(k1 - (1)) + (ipntr - (1))
* (n) + _ws_offset] * wy[(k1 - (1)) + (jpntr - (1)) * (n) + _wy_offset]));
}
}
if ((is2 <= (jy + m)))
{
wn1[(is2 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] =
((wn1[(is2 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] + temp1) - temp3);
}
else
{
wn1[(is2 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] =
((wn1[(is2 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] - temp1) + temp3);
}
jpntr = ((jpntr) % (m) + 1);
}
}
ipntr = ((ipntr) % (m) + 1);
}
}
//
// c Form the upper triangle of WN = [D+Y' ZZ'Y/theta -L_a'+R_z' ]
// c [-L_a +R_z S'AA'S*theta]
//
m2 = (2 * m);
{
for (iy = 1; iy <= col; iy++)
{
is2 = (col + iy);
is1 = (m + iy);
{
for (jy = 1; jy <= iy; jy++)
{
js = (col + jy);
js1 = (m + jy);
wn[(jy - (1)) + (iy - (1)) * ((2 * m)) + _wn_offset] =
(wn1[(iy - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset] / theta);
wn[(js - (1)) + (is2 - (1)) * ((2 * m)) + _wn_offset] =
(wn1[(is1 - (1)) + (js1 - (1)) * ((2 * m)) + _wn1_offset] * theta);
}
}
{
for (jy = 1; jy <= (iy - 1); jy++)
{
wn[(jy - (1)) + (is2 - (1)) * ((2 * m)) + _wn_offset] =
(-(wn1[(is1 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset]));
}
}
{
for (jy = iy; jy <= col; jy++)
{
wn[(jy - (1)) + (is2 - (1)) * ((2 * m)) + _wn_offset] =
wn1[(is1 - (1)) + (jy - (1)) * ((2 * m)) + _wn1_offset];
}
}
wn[(iy - (1)) + (iy - (1)) * ((2 * m)) + _wn_offset] = (wn[(iy - (1)) + (iy - (1)) * ((2 * m))
+ _wn_offset] + sy[(iy - (1)) + (iy - (1)) * (m) + _sy_offset]);
}
}
//
// c Form the upper triangle of WN= [ LL' L^-1(-L_a'+R_z')]
// c [(-L_a +R_z)L'^-1 S'AA'S*theta ]
//
// c first Cholesky factor (1,1) block of wn to get LL'
// c with L' stored in the upper triangle of wn.
dpofa(wn, _wn_offset, m2, col, ref info);
if ((info != 0))
{
info = -1;
return;
}
// c then form L^-1(-L_a'+R_z') in the (1,2) block.
col2 = (2 * col);
{
for (js = (col + 1); js <= col2; js++)
{
dtrsl(wn, _wn_offset, m2, col, wn, (1 - (1))
+ (js - (1)) * ((2 * m)) + _wn_offset, 11, ref info);
}
}
//
// c Form S'AA'S*theta + (L^-1(-L_a'+R_z'))'L^-1(-L_a'+R_z') in the
// c upper triangle of (2,2) block of wn.
//
//
{
for (is2 = (col + 1); is2 <= col2; is2++)
{
{
for (js = is2; js <= col2; js++)
{
wn[(is2 - (1)) + (js - (1)) * ((2 * m)) + _wn_offset] =
(wn[(is2 - (1)) + (js - (1)) * ((2 * m)) + _wn_offset]
+ ddot(col, wn, (1 - (1)) + (is2 - (1)) * ((2 * m))
+ _wn_offset, 1, wn, (1 - (1)) + (js - (1)) * ((2 * m)) + _wn_offset, 1));
}
}
}
}
//
// c Cholesky factorization of (2,2) block of wn.
//
dpofa(wn, ((col + 1) - (1)) + ((col + 1) - (1))
* ((2 * m)) + _wn_offset, m2, col, ref info);
if ((info != 0))
{
info = -2;
return;
}
}