/* ---------------------------------------------------------------------- */
int ffff (integer ndim, const doublereal *u, const integer *icp, const doublereal *par, integer ijac, doublereal *f, doublereal *dfdu)
{
/* System generated locals */
integer dfdu_dim1;
/* Local variables */
doublereal c, fa, fb, fc, dfa, dfb, dfc;
doublereal tmp[9];
/*The reduced system for traveling waves is defined here. */
/*A separate subroutine is used because the system and the Jacobian are also needed in the subroutines*/
/*BCND and ICND below. The computation should be done with JAC=0. The derivatives*/
/* below are for use in BCND and ICND only. */
/* A0, A1, A2: */
dfdu_dim1 = ndim;
tmp[1] = (1 - par[1]) * 2 + par[1] * 2;
tmp[2] = par[1];
/* B0, B1, B2: */
tmp[3] = (1 - par[1]) * 2;
tmp[4] = par[1];
tmp[5] = 0.;
/* C0, C1, C2: */
tmp[6] = 0.;
tmp[7] = 1 - par[1] + par[1];
tmp[8] = -(1 - par[1]) + (-par[1]);
fa = tmp[1] * u[0] + tmp[2] * (u[0] * u[0]);
fb = tmp[3] + tmp[4] * u[0] + tmp[5] * (u[0] * u[0]);
fc = tmp[6] + tmp[7] * u[0] + tmp[8] * (u[0] * u[0]);
c = par[9];
f[0] = fa * u[1];
f[1] = -c * u[1] - fb * (u[1] * u[1]) - fc;
if (ijac == 0) {
return 0;
}
dfa = tmp[1] + tmp[2] * 2 * u[0];
dfb = tmp[4] + tmp[5] * 2 * u[0];
dfc = tmp[7] + tmp[8] * 2 * u[0];
ARRAY2D(dfdu,0,0) = dfa * u[1];
ARRAY2D(dfdu,0,1) = fa;
ARRAY2D(dfdu,1,0) = -dfb * (u[1] * u[1]) - dfc;
ARRAY2D(dfdu,1,1) = -c - fb * 2 * u[1];
return 0;
}
/* ---------------------------------------------------------------------- */
int func (integer ndim, const doublereal *u, const integer *icp,
const doublereal *par, integer ijac,
doublereal *f, doublereal *dfdu, doublereal *dfdp)
{
/* System generated locals */
integer dfdu_dim1, dfdp_dim1;
/* Local variables */
doublereal x1, x2, x3, x4, x5;
dfdp_dim1 = ndim;
dfdu_dim1 = ndim;
x1 = u[0];
x2 = par[1];
x3 = par[2];
x4 = par[3];
x5 = par[4];
f[0] = x1 * x1 + x2 * x2 + x3 * x3 + x4 * x4 + x5 * x5 - 1;
if (ijac == 0) {
return 0;
}
ARRAY2D(dfdu,0,0) = x1 * 2;
if (ijac == 1) {
return 0;
}
/* *Parameter derivatives */
ARRAY2D(dfdp,0,1) = x2 * 2;
ARRAY2D(dfdp,0,2) = x3 * 2;
ARRAY2D(dfdp,0,3) = x4 * 2;
ARRAY2D(dfdp,0,4) = x5 * 2;
return 0;
}
int
reduce(integer *iam, integer *kwt, logical *par, doublereal ***a1, doublereal ***a2, doublereal ***bb, doublereal ***cc, doublereal **dd, integer *na, integer *nov, integer *ncb, integer *nrc, doublereal ***s1, doublereal ***s2, doublereal ***ca1, integer *icf1, integer *icf2, integer *icf11, integer *ipr, integer *nbc)
{
/* System generated locals */
integer icf1_dim1, icf2_dim1, icf11_dim1, ipr_dim1;
doublereal zero, tpiv;
real xkwt;
integer nbcp1, ibuf1, ipiv1, jpiv1, ipiv2, jpiv2, i, k, l;
integer i1, i2, k1, k2, i3, iprow, k3, l2, l3, ic, ir;
doublereal rm;
doublereal tmp;
integer icp1;
integer itmp;
doublereal piv1, piv2;
doublereal *buf=NULL;
#ifdef USAGE
struct rusage *init, *mainloop,*pivoting,*elimination;
usage_start(&init);
#endif
/* Parameter adjustments */
ipr_dim1 = *nov;
icf11_dim1 = *nov;
icf2_dim1 = *nov;
icf1_dim1 = *nov;
zero = 0.;
nbcp1 = *nbc + 1;
xkwt = (real) (*kwt);
/* Initialization */
for (i = 0; i < *na; ++i) {
for (k1 = 0; k1 < *nov; ++k1) {
ARRAY2D(icf1, k1, i) = k1 + 1;
ARRAY2D(icf2, k1, i) = k1 + 1;
ARRAY2D(ipr, k1, i) = k1 + 1;
for (k2 = 0; k2 < *nov; ++k2) {
s2[i][k1][k2] = 0.;
s1[i][k1][k2] = 0.;
}
}
}
for (ir = 0; ir < *nov; ++ir) {
for (ic = 0; ic < *nov; ++ic) {
s1[0][ir][ic] = a1[0][ir][ic];
}
}
#ifdef USAGE
usage_end(init,"reduce initialization");
usage_start(&mainloop);
#endif
/* The reduction process is done concurrently */
for (i1 = 0; i1 < *na - 1; ++i1) {
i2 = i1 + 1;
i3 = i2 + 1;
for (ic = 0; ic < *nov; ++ic) {
icp1 = ic + 1;
/* Complete pivoting; rows are swapped physically, columns swap in
dices */
piv1 = zero;
ipiv1 = ic + 1;
jpiv1 = ic + 1;
for (k1 = ic; k1 < *nov; ++k1) {
for (k2 = ic; k2 < *nov; ++k2) {
tpiv = a2[i1][k1][ARRAY2D(icf2, k2, i1) - 1];
if (tpiv < zero) {
tpiv = -tpiv;
}
if (piv1 < tpiv) {
piv1 = tpiv;
ipiv1 = k1 + 1;
jpiv1 = k2 + 1;
}
}
}
piv2 = zero;
ipiv2 = 1;
jpiv2 = ic + 1;
for (k1 = 0; k1 < *nov; ++k1) {
for (k2 = ic; k2 < *nov; ++k2) {
tpiv = a1[i2][k1][ARRAY2D(icf1, k2, i2) - 1];
if (tpiv < zero) {
tpiv = -tpiv;
}
if (piv2 < tpiv) {
piv2 = tpiv;
ipiv2 = k1 + 1;
jpiv2 = k2 + 1;
}
}
}
if (piv1 >= piv2) {
ARRAY2D(ipr, ic, i1) = ipiv1;
itmp = ARRAY2D(icf2, ic, i1);
ARRAY2D(icf2, ic, i1) = ARRAY2D(icf2, (jpiv1 - 1), i1);
ARRAY2D(icf2, (jpiv1 - 1), i1) = itmp;
itmp = ARRAY2D(icf1, ic, i2);
ARRAY2D(icf1, ic, i2) = ARRAY2D(icf1, (jpiv1 - 1), i2);
ARRAY2D(icf1, (jpiv1 - 1), i2) = itmp;
/* Swapping */
for (l = 0; l < *nov; ++l) {
tmp = s1[i1][ic][l];
s1[i1][ic][l] = s1[i1][ipiv1 - 1][l];
s1[i1][ipiv1 - 1][l] = tmp;
if (l >= ic) {
tmp = a2[i1][ic][ARRAY2D(icf2, l, i1) - 1];
a2[i1][ic][ARRAY2D(icf2, l, i1) - 1] =
a2[i1][ipiv1 - 1][ARRAY2D(icf2, l, i1) - 1];
a2[i1][ipiv1 - 1][ARRAY2D(icf2, l, i1) - 1] = tmp;
}
tmp = s2[i1][ic][l];
s2[i1][ic][l] = s2[i1][ipiv1 - 1][l];
s2[i1][ipiv1 - 1][l] = tmp;
}
for (l = 0; l < *ncb; ++l) {
tmp = bb[i1][ic][l];
bb[i1][ic][l] = bb[i1][ipiv1 - 1][l];
bb[i1][ipiv1 - 1][l] = tmp;
}
} else {
ARRAY2D(ipr, ic, i1) = *nov + ipiv2;
itmp = ARRAY2D(icf2, ic, i1);
ARRAY2D(icf2, ic, i1) = ARRAY2D(icf2, (jpiv2 - 1), i1);
ARRAY2D(icf2, (jpiv2 - 1), i1) = itmp;
itmp = ARRAY2D(icf1, ic, i2);
ARRAY2D(icf1, ic, i2) = ARRAY2D(icf1, (jpiv2 - 1), i2);
ARRAY2D(icf1, (jpiv2 - 1), i2) = itmp;
/* Swapping */
for (l = 0; l < *nov; ++l) {
if (l >= ic) {
tmp = a2[i1][ic][ARRAY2D(icf2, l, i1) - 1];
a2[i1][ic][ARRAY2D(icf2, l, i1) - 1] =
a1[i2][ipiv2 - 1][ARRAY2D(icf2, l, i1) - 1];
a1[i2][ipiv2 - 1][ARRAY2D(icf2, l, i1) - 1] = tmp;
}
tmp = s2[i1][ic][l];
s2[i1][ic][l] = a2[i2][ipiv2 - 1][l];
a2[i2][ipiv2 - 1][l] = tmp;
tmp = s1[i1][ic][l];
s1[i1][ic][l] = s1[i2][ipiv2 - 1][l];
s1[i2][ipiv2 - 1][l] = tmp;
}
for (l = 0; l < *ncb; ++l) {
tmp = bb[i1][ic][l];
bb[i1][ic][l] = bb[i2][ipiv2 - 1][l];
bb[i2][ipiv2 - 1][l] = tmp;
}
}
/* End of pivoting; Elimination starts here */
for (ir = icp1; ir < *nov; ++ir) {
/*for (ir = *nov - 1; ir >= icp1; ir--) {*/
rm = a2[i1][ir][ARRAY2D(icf2, ic, i1) - 1] /
a2[i1][ic][ARRAY2D(icf2, ic, i1) - 1];
a2[i1][ir][ARRAY2D(icf2, ic, i1) - 1] = rm;
if (rm != (double)0.) {
for (l = icp1; l < *nov; ++l) {
a2[i1][ir][ARRAY2D(icf2, l, i1) - 1] -=
rm * a2[i1][ic][ARRAY2D(icf2, l, i1) - 1];
}
for (l = 0; l < *nov; ++l) {
s1[i1][ir][l] -= rm * s1[i1][ic][l];
s2[i1][ir][l] -= rm * s2[i1][ic][l];
}
for (l = 0; l < *ncb; ++l) {
bb[i1][ir][l] -= rm * bb[i1][ic][l];
}
}
}
for (ir = 0; ir < *nov; ++ir) {
/*for (ir = *nov - 1; ir >= 0; ir--) {*/
rm = a1[i2][ir][ARRAY2D(icf1, ic, i2) - 1] /
a2[i1][ic][ARRAY2D(icf2, ic, i1) - 1];
a1[i2][ir][ARRAY2D(icf1, ic, i2) - 1] = rm;
if (rm != (double)0.) {
for (l = icp1; l < *nov; ++l) {
a1[i2][ir][ARRAY2D(icf1, l, i2) - 1] -=
rm * a2[i1][ic][ARRAY2D(icf2, l, i1) - 1];
}
for (l = 0; l < *nov; ++l) {
s1[i2][ir][l] -= rm * s1[i1][ic][l];
a2[i2][ir][l] -= rm * s2[i1][ic][l];
}
for (l = 0; l < *ncb; ++l) {
bb[i2][ir][l] -= rm * bb[i1][ic][l];
}
}
}
for (ir = nbcp1 - 1; ir < *nrc; ++ir) {
/*for (ir = *nrc - 1; ir >= nbcp1 - 1; ir--) {*/
rm = cc[i2][ir][ARRAY2D(icf2, ic, i1) - 1] /
a2[i1][ic][ARRAY2D(icf2, ic, i1) - 1];
cc[i2][ir][ARRAY2D(icf2, ic, i1) - 1] = rm;
if (rm != (double)0.) {
for (l = icp1; l < *nov; ++l) {
cc[i2][ir][ARRAY2D(icf2, l, i1) - 1] -=
rm * a2[i1][ic][ARRAY2D(icf2, l, i1) - 1];
}
for (l = 0; l < *nov; ++l) {
cc[0][ir][l] -= rm * s1[i1][ic][l];
cc[i3][ir][l] -= rm * s2[i1][ic][l];
}
for (l = 0; l < *ncb; ++l) {
dd[ir][l] -= rm * bb[i1][ic][l];
}
}
}
/* L2: */
}
/* L3: */
}
/* Initialization */
for (i = 0; i < *nov; ++i) {
ARRAY2D(icf2, i, (*na - 1)) = i + 1;
}
#ifdef USAGE
usage_end(mainloop,"reduce mainloop");
#endif
#ifdef DEBUG
{
FILE *icf1_fp,*icf2_fp,*ipr_fp,*s1_fp,*s2_fp;
FILE *a1_fp,*a2_fp,*bb_fp,*cc_fp,*dd_fp;
int i,j,k;
char *prefix="test";
char filename[80];
strcpy(filename,prefix);
strcat(filename,".icf1");
icf1_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".icf2");
icf2_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".ipr");
ipr_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".s1");
s1_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".s2");
s2_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".a1");
a1_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".a2");
a2_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".bb");
bb_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".cc");
cc_fp = fopen(filename,"w");
strcpy(filename,prefix);
strcat(filename,".dd");
dd_fp = fopen(filename,"w");
for (i = 0; i < *na; ++i) {
for (j = 0; j < *nov; ++j) {
fprintf(icf1_fp,"%d \n",ARRAY2D(icf1, j, i));
fprintf(icf2_fp,"%d \n",ARRAY2D(icf2, j, i));
fprintf(ipr_fp, "%d \n",ARRAY2D(ipr, j, i));
for (k = 0; k < *nov; ++k) {
fprintf(s1_fp,"%d \n",s1[i][j][k]);
fprintf(s2_fp,"%d \n",s2[i][j][k]);
fprintf(a1_fp,"%d \n",a1[i][j][k]);
fprintf(a2_fp,"%d \n",a2[i][j][k]);
}
for (k = 0; k < *ncb;k++) {
fprintf(bb_fp,"%d \n",bb[i][j][k]);
}
for (k = 0; k < *nrc;k++) {
fprintf(cc_fp,"%d \n",cc[i][k][j]);
}
}
}
for(i=0;i < *nrc;i++) {
for(j=0;j < *ncb;j++) {
fprintf(dd_fp,"%d \n",dd[i][j]);
}
}
}
exit(0);
#endif
return 0;
}
void setubv_make_boundary(integer ndim, integer na, integer nbc,
integer ncb, integer nra, BCNI_TYPE((*bcni)),
iap_type *iap, rap_type *rap, doublereal *par,
integer *icp, doublereal ***ccbc, doublereal **dd, doublereal *fc,
doublereal *rlcur, doublereal *rlold,
doublereal **ups, doublereal **uoldps, doublereal **dups)
{
integer i,j,k;
integer dbc_dim1 = nbc;
doublereal *dbc = (doublereal *)malloc(sizeof(doublereal)*(nbc)*(2*ndim + NPARX));
doublereal *fbc = (doublereal *)malloc(sizeof(doublereal)*(nbc));
doublereal *ubc0 = (doublereal *)malloc(sizeof(doublereal)*ndim);
doublereal *ubc1 = (doublereal *)malloc(sizeof(doublereal)*ndim);
/* Set constants. */
for (i = 0; i < ncb; ++i) {
par[icp[i]] = rlcur[i];
}
/* ** Time evolution computations (parabolic systems) */
if (iap->ips == 14 || iap->ips == 16) {
rap->tivp = rlold[0];
}
/* Boundary condition part of FC */
if (nbc > 0) {
for (i = 0; i < ndim; ++i) {
ubc0[i] = ups[0][i];
ubc1[i] = ups[na][i];
}
(*(bcni))(iap, rap, ndim, par, icp, nbc, ubc0, ubc1, fbc, 2, dbc);
for (i = 0; i < nbc; ++i) {
fc[i] = -fbc[i];
for (k = 0; k < ndim; ++k) {
/*NOTE!!
This needs to split up. Only the first processor does the first part
and only the last processors does the last part.
(I leave this non-parallel for now since
a) it doesn't play well with HomCont
b) there is almost nothing to be gained -- Bart)
*/
ccbc[0][i][k] = ARRAY2D(dbc, i, k);
ccbc[1][i][k] = ARRAY2D(dbc ,i , ndim + k);
}
for (k = 0; k < ncb; ++k) {
dd[i][k] = ARRAY2D(dbc, i, (ndim *2) + icp[k]);
}
}
/* Save difference : */
for (j = 0; j < na + 1; ++j) {
for (i = 0; i < nra; ++i) {
dups[j][i] = ups[j][i] - uoldps[j][i];
}
}
}
free(dbc);
free(fbc);
free(ubc0);
free(ubc1);
}
int
setubv_make_aa_bb_cc_dd(integer ndim, integer na, integer ncol, integer nint,
#ifdef MANIFOLD
integer nalc,
#endif
integer ncb, integer nrc, integer nra,
FUNI_TYPE((*funi)), ICNI_TYPE((*icni)),
iap_type *iap, rap_type *rap, doublereal *par, integer *icp,
doublereal ***aa, doublereal ***bb, doublereal ***cc, doublereal **dd,
doublereal **fa, doublereal *fc,
doublereal **ups, doublereal **uoldps, doublereal **udotps, doublereal **upoldp,
doublereal *dtm, doublereal *thu, doublereal *wi, doublereal **wp, doublereal **wt)
{
/* System generated locals */
integer dicd_dim1, dfdu_dim1, dfdp_dim1;
/* Local variables */
integer i, j, k, l, m;
integer k1, l1;
integer i1,j1;
integer ib, ic;
integer ic1;
doublereal ddt;
#ifdef MANIFOLD
integer udotps_off;
#endif
doublereal *dicd, *ficd, *dfdp, *dfdu, *uold;
doublereal *f;
doublereal *u, *wploc;
doublereal *uic, *uio, *prm, *uid, *uip;
#ifdef USAGE
struct rusage *setubv_make_aa_bb_cc_usage,*fa_usage;
usage_start(&setubv_make_aa_bb_cc_usage);
#endif
if (nint > 0) {
dicd = (doublereal *)malloc(sizeof(doublereal)*nint*(ndim + NPARX));
ficd = (doublereal *)malloc(sizeof(doublereal)*nint);
}
else
ficd = dicd = NULL;
dfdp = (doublereal *)malloc(sizeof(doublereal)*ndim*NPARX);
dfdu = (doublereal *)malloc(sizeof(doublereal)*ndim*ndim);
uold = (doublereal *)malloc(sizeof(doublereal)*ndim);
f = (doublereal *)malloc(sizeof(doublereal)*ndim);
u = (doublereal *)malloc(sizeof(doublereal)*ndim);
wploc= (doublereal *)malloc(sizeof(doublereal)*(ncol+1));
uic = (doublereal *)malloc(sizeof(doublereal)*ndim);
uio = (doublereal *)malloc(sizeof(doublereal)*ndim);
prm = (doublereal *)malloc(sizeof(doublereal)*NPARX);
uid = (doublereal *)malloc(sizeof(doublereal)*ndim);
uip = (doublereal *)malloc(sizeof(doublereal)*ndim);
dicd_dim1 = nint;
dfdu_dim1 = ndim;
dfdp_dim1 = ndim;
/* Generate AA, BB and DD: */
/* Initialize to zero. */
for (i = 0; i < nint; ++i) {
for (k = 0; k < ncb; ++k) {
dd[i][k] = 0.;
}
fc[i] = 0;
}
/* Partition the mesh intervals */
/*j will be replaced with 0 and na*/
for (j = 0; j < na; ++j) {
doublereal *up = ups[j];
doublereal *up1 = ups[j + 1];
doublereal *uoldp = uoldps[j];
doublereal *uoldp1 = uoldps[j + 1];
ddt = 1. / dtm[j];
for (ic = 0; ic < ncol; ++ic) {
for (k = 0; k < ndim; ++k) {
u[k] = wt[ncol][ic] * up1[k];
uold[k] = wt[ncol][ic] * uoldp1[k];
for (l = 0; l < ncol; ++l) {
l1 = l * ndim + k;
u[k] += wt[l][ic] * up[l1];
uold[k] += wt[l][ic] * uoldp[l1];
}
}
for (i = 0; i < NPARX; ++i) {
prm[i] = par[i];
}
/*
Ok this is a little wierd, so hold tight. This function
is actually a pointer to a wrapper function, which eventually
calls the user defined func_. Which wrapper is used
depends on what kind of problem it is.
*/
(*(funi))(iap, rap, ndim, u, uold, icp, prm, 2, f, dfdu, dfdp);
/* transpose dfdu for optimal access */
{
integer ii, jj;
doublereal tmp;
for (ii = 0; ii < ndim; ++ii) {
for (jj = 0; jj < ii; ++jj) {
tmp = dfdu[ii + jj * ndim];
dfdu[ii + jj * ndim] = dfdu[jj + ii * ndim];
dfdu[jj + ii * ndim] = tmp;
}
}
ic1 = ic * ndim;
for (ib = 0; ib < ncol + 1; ++ib) {
wploc[ib] = ddt * wp[ib][ic];
}
for (i = 0; i < ndim; ++i) {
double *aa_offset = aa[j][ic1 + i];
double *dfdu_offset = &ARRAY2D(dfdu, 0, i);
for (ib = 0; ib < ncol + 1; ++ib) {
double wt_tmp = -wt[ib][ic];
for (k = 0; k < ndim; ++k) {
aa_offset[k] = wt_tmp * dfdu_offset[k];
}
aa_offset[i] += wploc[ib];
aa_offset += ndim;
}
for (k = 0; k < ncb; ++k) {
bb[j][ic1 + i][k] = -ARRAY2D(dfdp, i, icp[k]);
}
fa[j][ic1 + i] = f[i] - wploc[ncol] * up1[i];
for (k = 0; k < ncol; ++k) {
k1 = k * ndim + i;
fa[j][ic1 + i] -= wploc[k] * up[k1];
}
}
}
}
}
/* generate CC and DD; the boundary conditions are not
done parallelly */
/* Integral constraints : */
if (nint > 0) {
for (j = 0; j < na; ++j) {
int jp1 = j + 1;
for (k = 0; k <= ncol; ++k) {
for (i = 0; i < ndim; ++i) {
i1 = k * ndim + i;
j1 = j;
if (k == ncol) {
i1 = i;
}
if (k == ncol) {
j1 = jp1;
}
uic[i] = ups[j1][i1];
uio[i] = uoldps[j1][i1];
uid[i] = udotps[j1][i1];
uip[i] = upoldp[j1][i1];
}
(*(icni))(iap, rap, ndim, par, icp, nint, uic, uio,
uid, uip, ficd, 2, dicd);
for (m = 0; m < nint; ++m) {
k1 = k * ndim;
for (i = 0; i < ndim; ++i) {
cc[j][m][k1+i] =
dtm[j] * wi[k ] * ARRAY2D(dicd, m, i);
}
fc[m] -= dtm[j] * wi[k] * ficd[m];
for (i = 0; i < ncb; ++i) {
dd[m][i] += dtm[j] * wi[k] * ARRAY2D(dicd, m, ndim + icp[i]);
}
}
}
}
}
/* Pseudo-arclength equation : */
#ifdef MANIFOLD
udotps_off=iap->ntst + 1;
#endif
for (j = 0; j < na; ++j) {
#ifdef MANIFOLD
for (m = 0; m < nalc; ++m) {
doublereal *udot_offset = udotps[j + m * udotps_off];
doublereal *cc_offset = cc[j][nrc - nalc + m];
#else
doublereal *udot_offset = udotps[j];
doublereal *cc_offset = cc[j][nrc - 1];
#endif
for (i = 0; i < ndim; ++i) {
for (k = 0; k < ncol; ++k) {
k1 = k * ndim + i;
cc_offset[k1] =
dtm[j] * thu[i] * wi[k] * udot_offset[k1];
}
cc_offset[nra + i] =
dtm[j] * thu[i] * wi[ncol] *
#ifndef MANIFOLD
udotps[j + 1][i];
#else
udotps[j + 1 + m*udotps_off][i];
}
#endif
}
}
free(dicd );
free(ficd );
free(dfdp );
free(dfdu );
free(uold );
free(f );
free(u );
free(wploc);
free(uic );
free(uio );
free(prm );
free(uid );
free(uip );
#ifdef USAGE
usage_end(setubv_make_aa_bb_cc_usage,"in setubv worker");
#endif
return 0;
}
/* ---------------------------------------------------------------------- */
int func (integer ndim, const doublereal *u, const integer *icp,
const doublereal *par, integer ijac,
doublereal *f, doublereal *dfdu, doublereal *dfdp)
{
/* System generated locals */
integer dfdu_dim1, dfdp_dim1;
/* Local variables */
doublereal drda, drdk, drds, a, d, r, s, a0, s0, al, rh, rk;
dfdp_dim1 = ndim;
dfdu_dim1 = ndim;
s = u[0];
a = u[1];
s0 = par[1];
a0 = par[2];
al = par[3];
rh = par[4];
rk = par[5];
d = s + 1 + rk * (s * s);
r = s * a / d;
f[0] = s0 - s - rh * r;
f[1] = al * (a0 - a) - rh * r;
if (ijac == 0) {
return 0;
}
drds = (a * d - s * a * (rk * 2 * s + 1)) / (d * d);
drda = s / d;
drdk = -(s * (s * s)) * a / (d * d);
ARRAY2D(dfdu,0,0) = -1 - rh * drds;
ARRAY2D(dfdu,0,1) = -rh * drda;
ARRAY2D(dfdu,1,0) = -rh * drds;
ARRAY2D(dfdu,1,1) = -al - rh * drda;
if (ijac == 1) {
return 0;
}
/* *Parameter derivatives */
ARRAY2D(dfdp,0,1) = 1.;
ARRAY2D(dfdp,0,2) = 0.;
ARRAY2D(dfdp,0,3) = 0.;
ARRAY2D(dfdp,0,4) = -r;
ARRAY2D(dfdp,0,5) = -rh * drdk;
ARRAY2D(dfdp,1,1) = 0.;
ARRAY2D(dfdp,1,2) = al;
ARRAY2D(dfdp,1,3) = a0 - a;
ARRAY2D(dfdp,1,4) = -r;
ARRAY2D(dfdp,1,5) = -rh * drdk;
return 0;
}
void Window::setupVertexCoordinates()
{
unsigned tileW = (4*scale);
unsigned tileH = (6*scale);
// printf("Scale %d\n",scale);
unsigned width = rect.Width, height = rect.Height;
unsigned nWide = width/tileW;
unsigned nHigh = height/tileH;
// unsigned xOff = rect.X/tileW;
// unsigned yOff = rect.Y/tileH;
vertices = nWide * nHigh * 4;
if(vertexCoordinates!=NULL)
free(vertexCoordinates);
vertexCoordinates = (float*)malloc(sizeof(float) * nWide * nHigh * 12);
if(texCoordinates!=NULL)
free(texCoordinates);
texCoordinates =(float*)malloc(sizeof(float) * nWide * nHigh * 8);
if(colCoordinates!=NULL)
free(colCoordinates);
colCoordinates =(float*)malloc(sizeof(float) * nWide * nHigh * 16);
if(bgColCoordinates!=NULL)
free(bgColCoordinates);
bgColCoordinates =(float*)malloc(sizeof(float) * nWide * nHigh * 16);
for(int j=0; j < nHigh; j++)
{
for(int i=0; i < nWide; i++)
{
// verts
int k = ARRAY2D(i,j,nWide)*12;
vertexCoordinates[k+0] = i*tileW; vertexCoordinates[k+1] = j*tileH; vertexCoordinates[k+2] = 0;
vertexCoordinates[k+3] = tileW+(i*tileW); vertexCoordinates[k+4] = j*tileH; vertexCoordinates[k+5] = 0;
vertexCoordinates[k+6] = tileW+(i*tileW); vertexCoordinates[k+7] = tileH+(j*tileH); vertexCoordinates[k+8] = 0;
vertexCoordinates[k+9] = i*tileW; vertexCoordinates[k+10]= tileH+(j*tileH); vertexCoordinates[k+11] = 0;
// texture
int l = ARRAY2D(i,j,nWide)*8;
int row = (BLOCK+16) / 16;
int column = (BLOCK+16) % 16;
float ratio = 0.0625f;
texCoordinates[l+0] = ratio* column; texCoordinates[l+1] = ratio* row;
texCoordinates[l+2] = ratio+ratio* column; texCoordinates[l+3] = ratio* row;
texCoordinates[l+4] = ratio+ratio* column; texCoordinates[l+5] = ratio+ratio* row;
texCoordinates[l+6] = ratio* column; texCoordinates[l+7] = ratio+ratio* row;
// colour
int m = ARRAY2D(i,j,nWide)*16;
colCoordinates[m+0] = 0.0f; colCoordinates[m+1] = 0.0f; colCoordinates[m+2] = 0.0f; colCoordinates[m+3] = 1.0f;
colCoordinates[m+4] = 0.0f; colCoordinates[m+5] = 0.0f; colCoordinates[m+6] = 0.0f; colCoordinates[m+7] = 1.0f;
colCoordinates[m+8] = 0.0f; colCoordinates[m+9] = 0.0f; colCoordinates[m+10]= 0.0f; colCoordinates[m+11] = 1.0f;
colCoordinates[m+12] =0.0f; colCoordinates[m+13] =0.0f; colCoordinates[m+14]= 0.0f; colCoordinates[m+15] = 1.0f;
bgColCoordinates[m+0] = 1.0f; bgColCoordinates[m+1] = 0.0f; bgColCoordinates[m+2] = 0.0f; bgColCoordinates[m+3] = 1.0f;
bgColCoordinates[m+4] = 1.0f; bgColCoordinates[m+5] = 0.0f; bgColCoordinates[m+6] = 0.0f; bgColCoordinates[m+7] = 1.0f;
bgColCoordinates[m+8] = 1.0f; bgColCoordinates[m+9] = 0.0f; bgColCoordinates[m+10]= 0.0f; bgColCoordinates[m+11] = 1.0f;
bgColCoordinates[m+12] =1.0f; bgColCoordinates[m+13] =0.0f; bgColCoordinates[m+14]= 0.0f; bgColCoordinates[m+15] = 1.0f;
}
}
}
void Window::border(float *tex, float *col, float *bgCol)
{
unsigned tileW = (4*scale);
unsigned tileH = (6*scale);
unsigned width = rect.Width, height = rect.Height;
unsigned nWide = width/tileW;
unsigned nHigh = height/tileH;
int tl,tr,br,bl,h,v,jl,jr;
switch(borderStyle)
{
case Border_Single:
tl=CORNER_TOP_LEFT_SINGLE,tr=CORNER_TOP_RIGHT_SINGLE;
br=CORNER_BOTTOM_RIGHT_SINGLE,bl=CORNER_BOTTOM_LEFT_SINGLE;
h=LINE_HORIZONTAL_SINGLE,v=LINE_VERTICAL_SINGLE;
jl=JOINT_SINGLE_LEFT_SINGLE ,jr=JOINT_SINGLE_RIGHT_SINGLE;
break;
case Border_Double:
tl=CORNER_TOP_LEFT_DOUBLE,tr=CORNER_TOP_RIGHT_DOUBLE;
br=CORNER_BOTTOM_RIGHT_DOUBLE,bl=CORNER_BOTTOM_LEFT_DOUBLE;
h=LINE_HORIZONTAL_DOUBLE,v=LINE_VERTICAL_DOUBLE;
jl=JOINT_DOUBLE_LEFT_SINGLE ,jr= JOINT_DOUBLE_RIGHT_SINGLE;
break;
case Border_Block:
tl=BLOCK,tr=BLOCK,br=BLOCK,bl=BLOCK,h=BLOCK,v=BLOCK;
jl=BLOCK,jr=BLOCK;
break;
default:
return;
break;
}
// top left
{
Ascii a(tl+16,borderColour,Colour(0,0,0));
int texI = ARRAY2D(0,0,nWide)*8;
int colI = ARRAY2D(0,0,nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],a);
}
// top right
{
Ascii a(tr+16,borderColour,Colour(0,0,0));
int texI = ARRAY2D((nWide-1),0,nWide)*8;
int colI = ARRAY2D((nWide-1),0,nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],a);
}
// bottom left
{
Ascii a(bl+16,borderColour,Colour(0,0,0));
int texI = ARRAY2D(0,(nHigh-1),nWide)*8;
int colI = ARRAY2D(0,(nHigh-1),nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],a);
}
// bottom right
{
Ascii a(br+16,borderColour,Colour(0,0,0));
int texI = ARRAY2D((nWide-1),(nHigh-1),nWide)*8;
int colI = ARRAY2D((nWide-1),(nHigh-1),nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],a);
}
// vertical
for(int j=1;j<nHigh-1;j++)
{
Ascii b(v+16,borderColour,Colour(0,0,0));
int texI = ARRAY2D(0,j,nWide)*8;
int colI = ARRAY2D(0,j,nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],b);
texI = ARRAY2D((nWide-1),j,nWide)*8;
colI = ARRAY2D((nWide-1),j,nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],b);
}
// horizontal
int centre = round(nWide/2.0)-round(centreLabel.getString().size()/2.0)-1;
int left = 1;
int right = nWide-rightLabel.getString().size()-3;
for(int i=1;i<nWide-1;i++)
{
Ascii b, c = Ascii(h+16,borderColour,Colour(0,0,0));
if(centreLabel.getString().size() != 0 && i >= centre-1 && i-centre <= centreLabel.getString().size()+1)
{ // centre
// printf("Centre label: %s\n",centreLabel.getString().c_str());
if(i == centre)
b = Ascii(jr+16,borderColour,Colour(0,0,0));
else if(i-centre == centreLabel.getString().size()+1)
b = Ascii(jl+16,borderColour,Colour(0,0,0));
else
b = Ascii(CHAR_TO_ASCII(centreLabel.getString()[i-centre-1])+16,centreLabel.getColour(),Colour(0,0,0));
}
else if(leftLabel.getString().size() != 0 && i >= 1 && i-left <= leftLabel.getString().size()+1)
{ // left
if(i == left)
b = Ascii(jr+16,borderColour,Colour(0,0,0));
else if(i-left == leftLabel.getString().size()+1)
b = Ascii(jl+16,borderColour,Colour(0,0,0));
else
b = Ascii(CHAR_TO_ASCII(leftLabel.getString()[i-left-1])+16,leftLabel.getColour(),Colour(0,0,0));
}
else if(rightLabel.getString().size() != 0 && i >= right-1 && i-right <= rightLabel.getString().size()+1)
{ // right
if(i == right)
b = Ascii(jr+16,borderColour,Colour(0,0,0));
else if(i-right == rightLabel.getString().size()+1)
b = Ascii(jl+16,borderColour,Colour(0,0,0));
else
b = Ascii(CHAR_TO_ASCII(rightLabel.getString()[i-right-1])+16,rightLabel.getColour(),Colour(0,0,0));
}
else
b = c;
int texI = ARRAY2D(i,0,nWide)*8;
int colI = ARRAY2D(i,0,nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],b);
texI = ARRAY2D(i,(nHigh-1),nWide)*8;
colI = ARRAY2D(i,(nHigh-1),nWide)*16;
displayTile(&tex[texI],&col[colI],&bgCol[colI],c);
}
}
/* ---------------------------------------------------------------------- */
int func (integer ndim, const doublereal *u, const integer *icp,
const doublereal *par, integer ijac,
doublereal *f, doublereal *dfdu, doublereal *dfdp)
{
/* System generated locals */
integer dfdu_dim1, dfdp_dim1;
/* Local variables */
doublereal r, x, y, z, a3, b3, be, ga, rn;
dfdp_dim1 = ndim;
dfdu_dim1 = ndim;
/* Function Body */
rn = par[1];
be = par[2];
ga = par[3];
r = par[4];
a3 = par[5];
b3 = par[6];
x = u[0];
y = u[1];
z = u[2];
f[0] = (-(be + rn) * x + be * y - a3 * (x * (x * x)) + b3 * ((y-x) * ((y-x) * (y-x)))) / r;
f[1] = be * x - (be + ga) * y - z - b3 * ((y-x) * ((y-x) * (y-x)));
f[2] = y;
if (ijac == 0) {
return 0;
}
ARRAY2D(dfdu,0,0) = (-(be + rn) - a3 * 3 * (x * x) - b3 * 3 * ((y-x) * (y-x))) / r;
ARRAY2D(dfdu,0,1) = (be + b3 * 3 * ((y-x) * (y-x))) / r;
ARRAY2D(dfdu,0,2) = 0.;
ARRAY2D(dfdu,1,0) = be + b3 * 3 * ((y-x) * (y-x));
ARRAY2D(dfdu,1,1) = -(be + ga) - b3 * 3 * ((y-x) * (y-x));
ARRAY2D(dfdu,1,2) = -1.;
ARRAY2D(dfdu,2,0) = 0.;
ARRAY2D(dfdu,2,1) = 1.;
ARRAY2D(dfdu,2,2) = 0.;
if (ijac == 1) {
return 0;
}
/* *Parameter derivatives */
ARRAY2D(dfdp,0,1) = -x / r;
ARRAY2D(dfdp,1,1) = 0.;
ARRAY2D(dfdp,2,1) = 0.;
ARRAY2D(dfdp,0,2) = (-x + y) / r;
ARRAY2D(dfdp,1,2) = x - y;
ARRAY2D(dfdp,2,2) = 0.;
ARRAY2D(dfdp,0,3) = 0.;
ARRAY2D(dfdp,1,3) = -y;
ARRAY2D(dfdp,2,3) = 0.;
ARRAY2D(dfdp,0,4) = -f[0] / r;
ARRAY2D(dfdp,1,4) = 0.;
ARRAY2D(dfdp,2,4) = 0.;
ARRAY2D(dfdp,0,5) = x * (x * x) / r;
ARRAY2D(dfdp,1,5) = 0.;
ARRAY2D(dfdp,2,5) = 0.;
ARRAY2D(dfdp,0,6) = (y-x) * ((y-x) * (y-x)) / r;
ARRAY2D(dfdp,1,6) = -((y-x) * ((y-x) * (y-x)));
ARRAY2D(dfdp,2,6) = 0.;
return 0;
}
/* ---------------------------------------------------------------------- */
int func (integer ndim, const doublereal *u, const integer *icp,
const doublereal *par, integer ijac,
doublereal *f, doublereal *dfdu, doublereal *dfdp)
{
/* System generated locals */
integer dfdu_dim1, dfdp_dim1;
/* Local variables */
integer i, j;
doublereal x, y, z, p1, p2, p3, p4;
dfdp_dim1 = ndim;
dfdu_dim1 = ndim;
x = u[0];
y = u[1];
z = u[2];
p1 = par[1];
p2 = par[2];
p3 = par[3];
p4 = par[4];
f[0] = (-p4 * (x * (x * x) / 3 - x) + (z - x) / p2 - y) / p1;
f[1] = x - p3;
f[2] = -(z - x) / p2;
if (ijac == 0) {
return 0;
}
ARRAY2D(dfdu,0,0) = (-p4 * (x * x - 1) - 1 / p2) / p1;
ARRAY2D(dfdu,0,1) = -1 / p1;
ARRAY2D(dfdu,0,2) = 1 / (p2 * p1);
ARRAY2D(dfdu,1,0) = 1.;
ARRAY2D(dfdu,1,1) = 0.;
ARRAY2D(dfdu,1,2) = 0.;
ARRAY2D(dfdu,2,0) = 1 / p2;
ARRAY2D(dfdu,2,1) = 0.;
ARRAY2D(dfdu,2,2) = -1 / p2;
if (ijac == 1) {
return 0;
}
/* *Parameter derivatives */
for (i = 0; i < 3; ++i) {
for (j = 0; j < 9; ++j) {
ARRAY2D(dfdp, i, j) = 0.;
}
}
ARRAY2D(dfdp,0,1) = -(-p4 * (x * (x * x) / 3 - x) +
(z - x) / p2 - y) / (p1 * p1);
ARRAY2D(dfdp,0,2) = -(z - x) / (p2 * p2 * p1);
ARRAY2D(dfdp,0,3) = 0.;
ARRAY2D(dfdp,0,4) = -(x * (x * x) / 3 - x) / p1;
ARRAY2D(dfdp,1,1) = 0.;
ARRAY2D(dfdp,1,2) = 0.;
ARRAY2D(dfdp,1,3) = -1.;
ARRAY2D(dfdp,1,4) = 0.;
ARRAY2D(dfdp,2,1) = 0.;
ARRAY2D(dfdp,2,2) = (z - x) / (p2 * p2);
ARRAY2D(dfdp,2,3) = 0.;
ARRAY2D(dfdp,2,4) = 0.;
return 0;
}
/* Subroutine */ int
flowkm(integer ndim, doublereal **c0, doublereal **c1, integer iid, doublecomplex *ev)
{
/* System generated locals */
integer rwork_dim1;
/* Local variables */
doublereal beta, *svde, *svds, svdu[1], *svdv;
integer i, j;
doublereal *v, *x;
logical infev;
doublereal const__;
integer ndimm1;
doublereal nrmc0x, nrmc1x, *qzalfi, *qzbeta;
integer svdinf;
doublereal *qzalfr;
integer qzierr;
doublereal *svdwrk, qzz[1], *rwork;
rwork = (doublereal *)malloc(sizeof(doublereal)*ndim*ndim);
svde = (doublereal *)malloc(sizeof(doublereal)*ndim);
svds = (doublereal *)malloc(sizeof(doublereal)*(ndim+1));
svdv = (doublereal *)malloc(sizeof(doublereal)*ndim*ndim);
v = (doublereal *)malloc(sizeof(doublereal)*ndim);
x = (doublereal *)malloc(sizeof(doublereal)*ndim);
qzalfi = (doublereal *)malloc(sizeof(doublereal)*ndim);
qzbeta = (doublereal *)malloc(sizeof(doublereal)*ndim);
qzalfr = (doublereal *)malloc(sizeof(doublereal)*ndim);
svdwrk = (doublereal *)malloc(sizeof(doublereal)*ndim);
/* Subroutine to compute Floquet multipliers via the "deflated circuit */
/* pencil" method. This routine is called by the AUTO routine FNSPBV */
/* storage for SVD computations */
/* compute right singular vectors only */
/* storage for generalized eigenvalue computations */
/* LOGICAL QZMATZ */
/* don't want to accumulate the transforms --- vectors not needed */
/* BLAS routines */
/* routines from EISPACK */
/* own routines */
/* Jim Demmel's svd routine ([email protected]) */
/* builtin F77 functions */
/* xx DOUBLE COMPLEX DCMPLX */
/* Make sure that you have enough local storage. */
/* Parameter adjustments */
/*--ev;*/
rwork_dim1 = ndim;
/* Change sign of P1 so that we get the sign of the multipliers right. */
for (j = 0; j < ndim; ++j) {
for (i = 0; i < ndim; ++i) {
c1[j][i] = -c1[j][i];
}
}
/* Print the undeflated circuit pencil (C0, C1). */
if (iid > 4) {
fprintf(fp9," Undeflated circuit pencil (C0, C1) \n");
fprintf(fp9," C0 : \n");
for (i = 0; i < ndim; ++i) {
for (j = 0; j < ndim; ++j) {
fprintf(fp9," %23.16f",c0[j][i]);
}
fprintf(fp9,"\n");
}
fprintf(fp9," C1 : \n");
for (i = 0; i < ndim; ++i) {
for (j = 0; j < ndim; ++j) {
fprintf(fp9," %23.16f",c1[j][i]);
}
fprintf(fp9,"\n");
}
}
/* PART I: */
/* ======= */
/* Deflate the Floquet multiplier at +1.0 so that the deflated */
/* circuit pencil is not defective at periodic branch turning points. */
/* The matrix (C0 - C1) should be (nearly) singular. Find an approximatio
n*/
/* to the right null vector (call it X). This will be our approximation
*/
/* to the eigenvector corresponding to the fixed multiplier at +1.0. */
/* There are many ways to get this approximation. We could use */
/* 1) p'(0) = f(p(0)) */
/* 2) AUTO'86 routine NLVC applied to C0-C1 */
/* 3) the right singular vector corresponding to the smallest */
/* singular value of C0-C1 */
/* I've chosen option 3) because it should introduce as little roundoff
*/
/* error as possible. Although it is more expensive, this is insignifican
t*/
/* relative to the rest of the AUTO computations. Also, the SVD does give
a*/
/* version of the Householder matrix which we would have to compute */
/* anyways. But note that it gives V = ( X perp | X ) and not (X | Xperp)
,*/
/* which the Householder routine would give. This will permute the deflat
ed*/
/* circuit pencil, so that the part to be deflated is in the last column,
*/
/* not it the first column, as was shown in the paper. */
for (j = 0; j < ndim; ++j) {
for (i = 0; i < ndim; ++i) {
ARRAY2D(rwork, i, j) = c0[j][i] - c1[j][i];
}
}
{
/* This is here since I don't want to change the calling sequence of the
BLAS routines. */
integer tmp = 1;
doublereal tmp_tol = 1.0E-16;
ezsvd(rwork, &ndim, &ndim, &ndim, svds, svde, svdu, &tmp,
svdv, &ndim, svdwrk, &tmp, &svdinf, &tmp_tol);
}
if (svdinf != 0) {
fprintf(fp9," NOTE : Warning from subroutine FLOWKM SVD routine returned SVDINF = %4ld Floquet multiplier calculations may be wrong\n",svdinf);
}
/* Apply a Householder matrix (call it H1) based on the null vector */
/* to (C0, C1) from the right. H1 = SVDV = ( Xperp | X ), where X */
/* is the null vector. */
{
/* This is here since I don't want to change the calling sequence of the
BLAS routines. */
doublereal tmp1 = 1.0;
doublereal tmp0 = 0.0;
logical tmp_false = FALSE_;
dgemm("n", "n", &ndim, &ndim, &ndim, &tmp1, *c0, &ndim, svdv,
&ndim, &tmp0, rwork, &ndim, 1L, 1L);
dgemc(&ndim, &ndim, rwork, &ndim, *c0, &ndim, &tmp_false);
dgemm("n", "n", &ndim, &ndim, &ndim, &tmp1, *c1, &ndim, svdv,
&ndim, &tmp0, rwork, &ndim, 1L, 1L);
dgemc(&ndim, &ndim, rwork, &ndim, *c1, &ndim, &tmp_false);
}
/* Apply a Householder matrix (call it H2) based on */
/* (C0*X/||C0*X|| + C1*X/||C1*X||) / 2 */
/* to (C0*H1, C1*H1) from the left. */
{
/* This is here since I don't want to change the calling sequence of the
BLAS routines. */
integer tmp = 1;
nrmc0x = dnrm2(&ndim, &c0[ndim - 1][0], &tmp);
nrmc1x = dnrm2(&ndim, &c1[ndim - 1][0], &tmp);
}
for (i = 0; i < ndim; ++i) {
x[i] = (c0[ndim - 1][i] / nrmc0x + c1[ndim - 1][i] / nrmc1x) / 2.;
}
dhhpr(1, ndim, ndim, x, 1, &beta, v);
dhhap(1, ndim, ndim, ndim, &beta, v, LEFT, c0, ndim);
dhhap(1, ndim, ndim, ndim, &beta, v, LEFT, c1, ndim);
/* Rescale so that (H2^T)*C0*(H1)(1,NDIM) ~= (H2^T)*C1*(H1)(1,NDIM) ~= 1.0
*/
/* Computing MAX */
const__ = max(fabs(c0[ndim - 1][0]),fabs(c1[ndim - 1][0]));
for (j = 0; j < ndim; ++j) {
for (i = 0; i < ndim; ++i) {
c0[j][i] /= const__;
c1[j][i] /= const__;
}
}
/* Finished the deflation process! Print the deflated circuit pencil. */
if (iid > 4) {
fprintf(fp9," Deflated cicuit pencil (H2^T)*(C0, C1)*(H1) \n");
fprintf(fp9," (H2^T)*C0*(H1) : \n");
for (i = 0; i < ndim; ++i) {
for (j = 0; j < ndim; ++j) {
fprintf(fp9," %23.16f",c0[j][i]);
}
fprintf(fp9,"\n");
}
fprintf(fp9," (H2^T)*C1*(H1) : \n");
for (i = 0; i < ndim; ++i) {
for (j = 0; j < ndim; ++j) {
fprintf(fp9," %23.16f",c1[j][i]);
}
fprintf(fp9,"\n");
}
}
/* At this point we have */
/* (C0Bar, C1Bar) */
/* ::= (H2^T)*(C0, C1)*(H1). */
/* (( B0^T | Beta0 ) ( B1^T | Beta1 )) 1 */
/* = (( ----------------- ), ( ----------------- )) */
/* (( C0BarDef | Delta0 ) ( C1BarDef | Delta1 )) NDIM-1 */
/* NDIM-1 1 NDIM-1 1 */
/* and approximations to the Floquet multipliers are */
/* (Beta0/Beta1) union the eigenvalues of the deflated pencil */
/* (C0BarDef, C1BarDef). */
/* PART II: */
/* ======== */
/* Compute the eigenvalues of the deflated circuit pencil */
/* (C0BarDef, C1BarDef) */
/* by using the QZ routines from EISPACK. */
ndimm1 = ndim - 1;
/* reduce the generalized eigenvalue problem to a simpler form */
/* (C0BarDef,C1BarDef) = (upper hessenberg, upper triangular) */
qzhes(ndim, ndimm1, &c0[0][1], &c1[0][1], FALSE_ , qzz);
/* now reduce to an even simpler form */
/* (C0BarDef,C1BarDef) = (quasi-upper triangular, upper triangular) */
qzit(ndim, ndimm1, &c0[0][1], &c1[0][1], QZEPS1, FALSE_ , qzz, &qzierr);
if (qzierr != 0) {
fprintf(fp9," NOTE : Warning from subroutine FLOWKM : QZ routine returned QZIERR = %4ld Floquet multiplier calculations may be wrong \n",qzierr);
}
/* compute the generalized eigenvalues */
qzval(ndim, ndimm1, &c0[0][1], &c1[0][1], qzalfr, qzalfi,
qzbeta, FALSE_, qzz);
/* Pack the eigenvalues into complex form. */
ev[0].r = c0[ndim - 1][0] / c1[ndim - 1][0];
ev[0].i = 0.;
infev = FALSE_;
for (j = 0; j < ndimm1; ++j) {
if (qzbeta[j] != 0.) {
ev[j + 1].r = qzalfr[j] / qzbeta[j];
ev[j + 1].i = qzalfi[j] / qzbeta[j];
} else {
ev[j + 1].r = 1e30, ev[j + 1].i = 1e30;
infev = TRUE_;
}
}
if (infev) {
fprintf(fp9," NOTE : Warning from subroutine FLOWKM : Infinite Floquet multiplier represented by CMPLX( 1.0D+30, 1.0D+30 )\n");
}
free(svde);
free(svds);
free(svdv);
free(v);
free(x);
free(qzalfi);
free(qzbeta);
free(qzalfr);
free(svdwrk);
free(rwork);
return 0;
} /* flowkm_ */
int main(int argc, char *argv[]) {
FILE *fpin, *fpout;
int ibr,ntot,itp,lab,nfpr,isw,ntpl,nar,nrowpr,ntst,ncol,npar1;
int i,j;
fpin = fopen("fort.28","r");
fpout = fopen("fort.38","w");
if(fpin == NULL) {
fprintf(stderr,"Could not open input file fort.28, exitting\n");
exit(1);
}
if(fpout == NULL) {
fprintf(stderr,"Could not open output file fort.38, exitting\n");
exit(1);
}
fscanf(fpin,"%d %d %d %d %d %d %d %d %d %d %d %d",
&ibr,&ntot,&itp,&lab,&nfpr,&isw,&ntpl,&nar,
&nrowpr,&ntst,&ncol,&npar1);
while(!feof(fpin)) {
if(ntst == 0) {
doublereal tmp;
fprintf(fpout,"%5d%5d%5d%5d%5d%5d%5d%5d%7d%5d%5d%5d\n",
ibr,ntot,itp,lab,nfpr,isw,ntpl,nar,
nrowpr,ntst,ncol,npar1);
/* write out first column */
fscanf(fpin,"%lf", &tmp);
fprintf(fpout," %18.10E",tmp);
/* write out rest of columns */
for(i=0;i<nar - 1;i++) {
fscanf(fpin,"%lf", &tmp);
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",tmp);
}
fprintf(fpout,"\n ");
/* write out the parameters*/
for(i=0;i<npar1;i++) {
fscanf(fpin,"%lf", &tmp);
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",tmp);
}
fprintf(fpout,"\n");
} else {
doublereal *tm;
doublereal *u;
doublereal tmp;
integer itmp;
integer u_dim1;
tm=(doublereal *)malloc(sizeof(doublereal)*ntpl);
u=(doublereal *)malloc(sizeof(doublereal)*ntpl*(nar-1));
u_dim1 = nar - 1;
fprintf(fpout,"%5d%5d%5d%5d%5d%5d%5d%5d%7d%5d%5d%5d\n",
ibr,ntot,itp,lab,nfpr,isw,ntpl*2-1,nar,
nrowpr+2*ntpl-2,ntst*2,ncol,npar1);
for(j=0;j<ntpl;j++) {
/* write out first column */
fscanf(fpin,"%lf", &tm[j]);
fprintf(fpout," %18.10E",tm[j]/2.0);
/* write out rest of columns */
for(i=0;i<nar - 1;i++) {
fscanf(fpin,"%lf", &ARRAY2D(u,i,j));
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",ARRAY2D(u,i,j));
}
fprintf(fpout,"\n");
}
for(j=1;j<ntpl;j++) {
/* write out first column */
fprintf(fpout," %18.10E",(1.0+tm[j])/2.0);
/* write out rest of columns */
for(i=0;i<nar - 1;i++) {
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",ARRAY2D(u,i,j) + ARRAY2D(u,i,ntpl-1) - ARRAY2D(u,i,0));
}
fprintf(fpout,"\n");
}
/* write out ICP*/
for(i=0;i<nfpr;i++) {
fscanf(fpin,"%ld", &itmp);
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%5ld",itmp);
}
fprintf(fpout,"\n ");
/* write out RLDOT*/
for(i=0;i<nfpr;i++) {
fscanf(fpin,"%lf", &tmp);
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",tmp);
}
fprintf(fpout,"\n ");
#ifdef ORIG
#define OFFSET 2
#else
#define OFFSET 1
#endif
for(j=0;j<ntpl;j++) {
/* write out rest of columns */
for(i=0;i<nar - OFFSET;i++) {
fscanf(fpin,"%lf", &ARRAY2D(u,i,j));
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",ARRAY2D(u,i,j));
}
/* go to the end of line*/
while(fgetc(fpin)!='\n');
fprintf(fpout,"\n ");
}
for(j=1;j<ntpl;j++) {
/* write out rest of columns */
for(i=0;i<nar - OFFSET;i++) {
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
fprintf(fpout,"%18.10E",ARRAY2D(u,i,j));
}
fprintf(fpout,"\n ");
}
/* write out the parameters*/
for(i=0;i<npar1;i++) {
fscanf(fpin,"%lf", &tmp);
if(i % 7 ==0 && i != 0)
fprintf(fpout,"\n ");
if(i==10)
fprintf(fpout,"%18.10E",tmp*2.0);
else
fprintf(fpout,"%18.10E",tmp);
}
fprintf(fpout,"\n");
free(tm);
free(u);
}
fscanf(fpin,"%d %d %d %d %d %d %d %d %d %d %d %d",
&ibr,&ntot,&itp,&lab,&nfpr,&isw,&ntpl,&nar,
&nrowpr,&ntst,&ncol,&npar1);
}
return 0;
}
void Heightmap::put(unsigned i,unsigned j,double value)
{
heights[ARRAY2D(i,j,Size)] = value;
}
double Heightmap::at(unsigned i,unsigned j)
{
return heights[ARRAY2D(i,j,Size)];
}
