int unitfix(int ctrl, struct wcsprm *wcs)
{
int i, k, status = FIXERR_NO_CHANGE;
char orig_unit[80], msg[WCSERR_MSG_LENGTH];
const char *function = "unitfix";
struct wcserr **err;
if (wcs == 0x0) return FIXERR_NULL_POINTER;
err = &(wcs->err);
strcpy(msg, "Changed units: ");
for (i = 0; i < wcs->naxis; i++) {
strncpy(orig_unit, wcs->cunit[i], 80);
if (wcsutrne(ctrl, wcs->cunit[i], &(wcs->err)) == 0) {
k = strlen(msg);
sprintf(msg+k, "'%s' -> '%s', ", orig_unit, wcs->cunit[i]);
status = FIXERR_UNITS_ALIAS;
}
}
if (status == FIXERR_UNITS_ALIAS) {
k = strlen(msg) - 2;
msg[k] = '\0';
wcserr_set(WCSERR_SET(FIXERR_UNITS_ALIAS), msg);
status = FIXERR_SUCCESS;
}
return status;
}
int lindist(int sequence, struct linprm *lin, struct disprm *dis, int ndpmax)
{
static const char *function = "lindist";
int status;
struct wcserr **err;
if (lin == 0x0) return LINERR_NULL_POINTER;
err = &(lin->err);
if (sequence == 1) {
if (lin->m_dispre) {
disfree(lin->m_dispre);
free(lin->m_dispre);
}
lin->dispre = dis;
lin->m_flag = LINSET;
lin->m_dispre = dis;
} else if (sequence == 2) {
if (lin->m_disseq) {
disfree(lin->m_disseq);
free(lin->m_disseq);
}
lin->disseq = dis;
lin->m_flag = LINSET;
lin->m_disseq = dis;
} else {
return wcserr_set(WCSERR_SET(LINERR_DISTORT_INIT),
"Invalid sequence (%d)", sequence);
}
if (dis) {
if ((status = disinit(1, lin->naxis, dis, ndpmax))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
}
return 0;
}
int tabcpy(int alloc, const struct tabprm *tabsrc, struct tabprm *tabdst)
{
static const char *function = "tabcpy";
int k, m, M, n, N, status;
double *dstp, *srcp;
struct wcserr **err;
if (tabsrc == 0x0) return TABERR_NULL_POINTER;
if (tabdst == 0x0) return TABERR_NULL_POINTER;
err = &(tabdst->err);
M = tabsrc->M;
if (M <= 0) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"M must be positive, got %d", M);
}
if ((status = tabini(alloc, M, tabsrc->K, tabdst))) {
return status;
}
N = M;
for (m = 0; m < M; m++) {
tabdst->map[m] = tabsrc->map[m];
tabdst->crval[m] = tabsrc->crval[m];
N *= tabsrc->K[m];
}
for (m = 0; m < M; m++) {
if ((srcp = tabsrc->index[m])) {
dstp = tabdst->index[m];
for (k = 0; k < tabsrc->K[m]; k++) {
*(dstp++) = *(srcp++);
}
}
}
srcp = tabsrc->coord;
dstp = tabdst->coord;
for (n = 0; n < N; n++) {
*(dstp++) = *(srcp++);
}
return 0;
}
int unitfix(int ctrl, struct wcsprm *wcs)
{
int i, k, result, status = FIXERR_NO_CHANGE;
char orig_unit[80], msg[WCSERR_MSG_LENGTH], msgtmp[WCSERR_MSG_LENGTH];
const char *function = "unitfix";
struct wcserr **err;
if (wcs == 0x0) return FIXERR_NULL_POINTER;
err = &(wcs->err);
strncpy(msg, "Changed units: ", WCSERR_MSG_LENGTH);
for (i = 0; i < wcs->naxis; i++) {
strncpy(orig_unit, wcs->cunit[i], 80);
result = wcsutrne(ctrl, wcs->cunit[i], &(wcs->err));
if (result == 0 || result == 12) {
k = strlen(msg);
if (k < WCSERR_MSG_LENGTH-1) {
wcsutil_null_fill(80, orig_unit);
sprintf(msgtmp, "'%s' -> '%s', ", orig_unit, wcs->cunit[i]);
strncpy(msg+k, msgtmp, WCSERR_MSG_LENGTH-1-k);
status = FIXERR_UNITS_ALIAS;
}
}
}
if (status == FIXERR_UNITS_ALIAS) {
/* Chop off the trailing ", ". */
k = strlen(msg) - 2;
msg[k] = '\0';
wcserr_set(WCSERR_SET(FIXERR_UNITS_ALIAS), msg);
status = 0;
}
return status;
}
int linset(struct linprm *lin)
{
static const char *function = "linset";
int i, j, naxis, status;
double *pc, *piximg;
struct wcserr **err;
if (lin == 0x0) return LINERR_NULL_POINTER;
err = &(lin->err);
naxis = lin->naxis;
/* Check for a unit matrix. */
lin->unity = 1;
pc = lin->pc;
for (i = 0; i < naxis; i++) {
for (j = 0; j < naxis; j++) {
if (j == i) {
if (*(pc++) != 1.0) {
lin->unity = 0;
break;
}
} else {
if (*(pc++) != 0.0) {
lin->unity = 0;
break;
}
}
}
}
if (lin->unity) {
if (lin->flag == LINSET) {
/* Free memory that may have been allocated previously. */
if (lin->piximg) free(lin->piximg);
if (lin->imgpix) free(lin->imgpix);
}
lin->piximg = 0x0;
lin->imgpix = 0x0;
lin->i_naxis = 0;
/* Check cdelt. */
for (i = 0; i < naxis; i++) {
if (lin->cdelt[i] == 0.0) {
return wcserr_set(LIN_ERRMSG(LINERR_SINGULAR_MTX));
}
}
} else {
if (lin->flag != LINSET || lin->i_naxis < naxis) {
if (lin->flag == LINSET) {
/* Free memory that may have been allocated previously. */
if (lin->piximg) free(lin->piximg);
if (lin->imgpix) free(lin->imgpix);
}
/* Allocate memory for internal arrays. */
if ((lin->piximg = calloc(naxis*naxis, sizeof(double))) == 0x0) {
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
if ((lin->imgpix = calloc(naxis*naxis, sizeof(double))) == 0x0) {
free(lin->piximg);
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lin->i_naxis = naxis;
}
/* Compute the pixel-to-image transformation matrix. */
pc = lin->pc;
piximg = lin->piximg;
for (i = 0; i < naxis; i++) {
for (j = 0; j < naxis; j++) {
if (lin->disseq == 0x0) {
/* No sequent distortions, incorporate cdelt into piximg. */
*(piximg++) = lin->cdelt[i] * (*(pc++));
} else {
*(piximg++) = *(pc++);
}
}
}
/* Compute the image-to-pixel transformation matrix. */
if ((status = matinv(naxis, lin->piximg, lin->imgpix))) {
return wcserr_set(LIN_ERRMSG(status));
}
}
/* Set up the distortion functions. */
lin->affine = 1;
if (lin->dispre) {
if ((status = disset(lin->dispre))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
lin->affine = 0;
}
if (lin->disseq) {
if ((status = disset(lin->disseq))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
lin->affine = 0;
}
lin->simple = lin->unity && lin->affine;
/* Create work arrays. */
if (lin->tmpcrd) free(lin->tmpcrd);
if ((lin->tmpcrd = calloc(naxis, sizeof(double))) == 0x0) {
linfree(lin);
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lin->flag = LINSET;
return 0;
}
int tabx2s(
struct tabprm *tab,
int ncoord,
int nelem,
const double x[],
double world[],
int stat[])
{
static const char *function = "tabx2s";
int i, iv, k, *Km, m, M, n, nv, offset, p1, status;
double *coord, *Psi, psi_m, upsilon, wgt;
register int *statp;
register const double *xp;
register double *wp;
struct wcserr **err;
if (tab == 0x0) return TABERR_NULL_POINTER;
err = &(tab->err);
/* Initialize if required. */
if (tab->flag != TABSET) {
if ((status = tabset(tab))) return status;
}
/* This is used a lot. */
M = tab->M;
status = 0;
xp = x;
wp = world;
statp = stat;
for (n = 0; n < ncoord; n++) {
/* Determine the indexes. */
Km = tab->K;
for (m = 0; m < M; m++, Km++) {
/* N.B. psi_m and Upsilon_m are 1-relative FITS indexes. */
i = tab->map[m];
psi_m = *(xp+i) + tab->crval[m];
Psi = tab->index[m];
if (Psi == 0x0) {
/* Default indexing is simple. */
upsilon = psi_m;
} else {
/* To ease confusion, decrement Psi so that we can use 1-relative
C array indexing to match the 1-relative FITS indexing. */
Psi--;
if (*Km == 1) {
/* Index vector is degenerate. */
if (Psi[1]-0.5 <= psi_m && psi_m <= Psi[1]+0.5) {
upsilon = psi_m;
} else {
*statp = 1;
status = wcserr_set(TAB_ERRMSG(TABERR_BAD_X));
goto next;
}
} else {
/* Interpolate in the indexing vector. */
if (tab->sense[m] == 1) {
/* Monotonic increasing index values. */
if (psi_m < Psi[1]) {
if (Psi[1] - 0.5*(Psi[2]-Psi[1]) <= psi_m) {
/* Allow minor extrapolation. */
k = 1;
} else {
/* Index is out of range. */
*statp = 1;
status = wcserr_set(TAB_ERRMSG(TABERR_BAD_X));
goto next;
}
} else if (Psi[*Km] < psi_m) {
if (psi_m <= Psi[*Km] + 0.5*(Psi[*Km]-Psi[*Km-1])) {
/* Allow minor extrapolation. */
k = *Km - 1;
} else {
/* Index is out of range. */
*statp = 1;
status = wcserr_set(TAB_ERRMSG(TABERR_BAD_X));
goto next;
}
} else {
for (k = 1; k < *Km; k++) {
if (psi_m < Psi[k]) {
continue;
}
if (Psi[k] == psi_m && psi_m < Psi[k+1]) {
break;
}
if (Psi[k] < psi_m && psi_m <= Psi[k+1]) {
break;
}
}
}
} else {
/* Monotonic decreasing index values. */
if (psi_m > Psi[1]) {
if (Psi[1] + 0.5*(Psi[1]-Psi[2]) >= psi_m) {
/* Allow minor extrapolation. */
k = 1;
} else {
/* Index is out of range. */
*statp = 1;
status = wcserr_set(TAB_ERRMSG(TABERR_BAD_X));
goto next;
}
} else if (psi_m < Psi[*Km]) {
if (Psi[*Km] - 0.5*(Psi[*Km-1]-Psi[*Km]) <= psi_m) {
/* Allow minor extrapolation. */
k = *Km - 1;
} else {
/* Index is out of range. */
*statp = 1;
status = wcserr_set(TAB_ERRMSG(TABERR_BAD_X));
goto next;
}
} else {
for (k = 1; k < *Km; k++) {
if (psi_m > Psi[k]) {
continue;
}
if (Psi[k] == psi_m && psi_m > Psi[k+1]) {
break;
}
if (Psi[k] > psi_m && psi_m >= Psi[k+1]) {
break;
}
}
}
}
upsilon = k + (psi_m - Psi[k]) / (Psi[k+1] - Psi[k]);
}
}
if (upsilon < 0.5 || upsilon > *Km + 0.5) {
/* Index out of range. */
*statp = 1;
status = wcserr_set(TAB_ERRMSG(TABERR_BAD_X));
goto next;
}
/* Fiducial array indices and fractional offset.
p1 is 1-relative while tab::p0 is 0-relative. */
p1 = (int)floor(upsilon);
tab->p0[m] = p1 - 1;
tab->delta[m] = upsilon - p1;
if (p1 == 0) {
tab->p0[m] += 1;
tab->delta[m] -= 1.0;
} else if (p1 == *Km && *Km > 1) {
tab->p0[m] -= 1;
tab->delta[m] += 1.0;
}
}
/* Now interpolate in the coordinate array; the M-dimensional linear */
/* interpolation algorithm is described in Sect. 3.4 of WCS Paper IV. */
for (m = 0; m < M; m++) {
i = tab->map[m];
*(wp+i) = 0.0;
}
/* Loop over the 2^M vertices surrounding P. */
nv = 1 << M;
for (iv = 0; iv < nv; iv++) {
/* Locate vertex in the coordinate array and compute its weight. */
offset = 0;
wgt = 1.0;
for (m = M-1; m >= 0; m--) {
offset *= tab->K[m];
offset += tab->p0[m];
if (iv & (1 << m)) {
if (tab->K[m] > 1) offset++;
wgt *= tab->delta[m];
} else {
wgt *= 1.0 - tab->delta[m];
}
}
if (wgt == 0.0) continue;
/* Add the contribution from this vertex to each element. */
coord = tab->coord + offset*M;
for (m = 0; m < M; m++) {
i = tab->map[m];
*(wp+i) += *(coord++) * wgt;
}
if (wgt == 1.0) break;
}
*statp = 0;
next:
xp += nelem;
wp += nelem;
statp++;
}
return status;
}
int lincpy(int alloc, const struct linprm *linsrc, struct linprm *lindst)
{
static const char *function = "lincpy";
int i, j, naxis, status;
const double *srcp;
double *dstp;
struct wcserr **err;
if (linsrc == 0x0) return LINERR_NULL_POINTER;
if (lindst == 0x0) return LINERR_NULL_POINTER;
err = &(lindst->err);
naxis = linsrc->naxis;
if (naxis < 1) {
return wcserr_set(WCSERR_SET(LINERR_MEMORY),
"naxis must be positive (got %d)", naxis);
}
if ((status = linini(alloc, naxis, lindst))) {
return status;
}
srcp = linsrc->crpix;
dstp = lindst->crpix;
for (j = 0; j < naxis; j++) {
*(dstp++) = *(srcp++);
}
srcp = linsrc->pc;
dstp = lindst->pc;
for (i = 0; i < naxis; i++) {
for (j = 0; j < naxis; j++) {
*(dstp++) = *(srcp++);
}
}
srcp = linsrc->cdelt;
dstp = lindst->cdelt;
for (i = 0; i < naxis; i++) {
*(dstp++) = *(srcp++);
}
if (linsrc->dispre) {
if (!lindst->dispre) {
if ((lindst->dispre = calloc(1, sizeof(struct disprm))) == 0x0) {
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lindst->m_dispre = lindst->dispre;
}
if ((status = discpy(alloc, linsrc->dispre, lindst->dispre))) {
status = wcserr_set(LIN_ERRMSG(lin_diserr[status]));
goto cleanup;
}
}
if (linsrc->disseq) {
if (!lindst->disseq) {
if ((lindst->disseq = calloc(1, sizeof(struct disprm))) == 0x0) {
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lindst->m_disseq = lindst->disseq;
}
if ((status = discpy(alloc, linsrc->disseq, lindst->disseq))) {
status = wcserr_set(LIN_ERRMSG(lin_diserr[status]));
goto cleanup;
}
}
cleanup:
if (status && (lindst->m_dispre || lindst->m_disseq)) {
if (lindst->dispre) free(lindst->dispre);
if (lindst->disseq) free(lindst->disseq);
lindst->dispre = 0x0;
lindst->disseq = 0x0;
}
return status;
}
int spcfix(struct wcsprm *wcs)
{
static const char *function = "spcfix";
char ctype[9], specsys[9];
int i, status;
struct wcserr **err;
if (wcs == 0x0) return FIXERR_NULL_POINTER;
err = &(wcs->err);
for (i = 0; i < wcs->naxis; i++) {
/* Translate an AIPS-convention spectral type if present. */
status = spcaips(wcs->ctype[i], wcs->velref, ctype, specsys);
if (status == 0) {
/* An AIPS type was found but it may match what we already have. */
status = FIXERR_NO_CHANGE;
/* Was specsys translated? */
if (wcs->specsys[0] == '\0' && *specsys) {
strncpy(wcs->specsys, specsys, 9);
wcserr_set(WCSERR_SET(FIXERR_SPC_UPDATE),
"Changed SPECSYS to '%s'", specsys);
status = FIXERR_SUCCESS;
}
/* Was ctype translated? Have to null-fill for comparing them. */
wcsutil_null_fill(9, wcs->ctype[i]);
if (strncmp(wcs->ctype[i], ctype, 9)) {
/* ctype was translated... */
if (status == FIXERR_SUCCESS) {
/* ...and specsys was also. */
wcserr_set(WCSERR_SET(FIXERR_SPC_UPDATE),
"Changed CTYPE%d from '%s' to '%s', and SPECSYS to '%s'",
i+1, wcs->ctype[i], ctype, wcs->specsys);
} else {
wcserr_set(WCSERR_SET(FIXERR_SPC_UPDATE),
"Changed CTYPE%d from '%s' to '%s'", i+1, wcs->ctype[i], ctype);
status = FIXERR_SUCCESS;
}
strncpy(wcs->ctype[i], ctype, 9);
}
/* Tidy up. */
if (status == FIXERR_SUCCESS) {
wcsutil_null_fill(72, wcs->ctype[i]);
wcsutil_null_fill(72, wcs->specsys);
}
/* No need to check for others, wcsset() will fail if so. */
return status;
} else if (status == SPCERR_BAD_SPEC_PARAMS) {
/* An AIPS spectral type was found but with invalid velref. */
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: velref = %d", wcs->velref);
}
}
return FIXERR_NO_CHANGE;
}
int cylfix(const int naxis[], struct wcsprm *wcs)
{
static const char *function = "cylfix";
unsigned short icnr, indx[NMAX], ncnr;
int j, k, stat[4], status;
double img[4][NMAX], lat, lng, phi[4], phi0, phimax, phimin, pix[4][NMAX],
*pixj, theta[4], theta0, world[4][NMAX], x, y;
struct wcserr **err;
if (naxis == 0x0) return FIXERR_NO_CHANGE;
if (wcs == 0x0) return FIXERR_NULL_POINTER;
err = &(wcs->err);
/* Initialize if required. */
if (wcs->flag != WCSSET) {
if ((status = wcsset(wcs))) return status;
}
/* Check that we have a cylindrical projection. */
if (wcs->cel.prj.category != CYLINDRICAL) return FIXERR_NO_CHANGE;
if (wcs->naxis < 2) return FIXERR_NO_CHANGE;
/* Compute the native longitude in each corner of the image. */
ncnr = 1 << wcs->naxis;
for (k = 0; k < NMAX; k++) {
indx[k] = 1 << k;
}
phimin = 1.0e99;
phimax = -1.0e99;
for (icnr = 0; icnr < ncnr;) {
/* Do four corners at a time. */
for (j = 0; j < 4; j++, icnr++) {
pixj = pix[j];
for (k = 0; k < wcs->naxis; k++) {
if (icnr & indx[k]) {
*(pixj++) = naxis[k] + 0.5;
} else {
*(pixj++) = 0.5;
}
}
}
if (!(status = wcsp2s(wcs, 4, NMAX, pix[0], img[0], phi, theta, world[0],
stat))) {
for (j = 0; j < 4; j++) {
if (phi[j] < phimin) phimin = phi[j];
if (phi[j] > phimax) phimax = phi[j];
}
}
}
if (phimin > phimax) return status;
/* Any changes needed? */
if (phimin >= -180.0 && phimax <= 180.0) return FIXERR_NO_CHANGE;
/* Compute the new reference pixel coordinates. */
phi0 = (phimin + phimax) / 2.0;
theta0 = 0.0;
if ((status = prjs2x(&(wcs->cel.prj), 1, 1, 1, 1, &phi0, &theta0, &x, &y,
stat))) {
if (status == PRJERR_BAD_PARAM) {
return wcserr_set(WCSFIX_ERRMSG(FIXERR_BAD_PARAM));
}
return wcserr_set(WCSFIX_ERRMSG(FIXERR_NO_REF_PIX_COORD));
}
for (k = 0; k < wcs->naxis; k++) {
img[0][k] = 0.0;
}
img[0][wcs->lng] = x;
img[0][wcs->lat] = y;
if ((status = linx2p(&(wcs->lin), 1, 0, img[0], pix[0]))) {
return wcserr_set(WCSFIX_ERRMSG(status));
}
/* Compute celestial coordinates at the new reference pixel. */
if ((status = wcsp2s(wcs, 1, 0, pix[0], img[0], phi, theta, world[0],
stat))) {
if (wcs->err->status == WCSERR_BAD_PIX) {
wcs->err->status = FIXERR_NO_REF_PIX_COORD;
}
return wcs->err->status;
}
/* Compute native coordinates of the celestial pole. */
lng = 0.0;
lat = 90.0;
(void)sphs2x(wcs->cel.euler, 1, 1, 1, 1, &lng, &lat, phi, theta);
wcs->crpix[wcs->lng] = pix[0][wcs->lng];
wcs->crpix[wcs->lat] = pix[0][wcs->lat];
wcs->crval[wcs->lng] = world[0][wcs->lng];
wcs->crval[wcs->lat] = world[0][wcs->lat];
wcs->lonpole = phi[0] - phi0;
return wcsset(wcs);
}
int linx2p(
struct linprm *lin,
int ncoord,
int nelem,
const double imgcrd[],
double pixcrd[])
{
static const char *function = "linx2p";
int i, j, k, n, ndbl, nelemn, status;
register const double *img;
register double *imgpix, *pix, *tmp;
struct wcserr **err;
/* Initialize. */
if (lin == 0x0) return LINERR_NULL_POINTER;
err = &(lin->err);
if (lin->flag != LINSET) {
if ((status = linset(lin))) return status;
}
n = lin->naxis;
/* Convert intermediate world coordinates to pixel coordinates. */
img = imgcrd;
pix = pixcrd;
if (lin->simple) {
/* Handle the simplest and most common case with maximum efficiency. */
nelemn = nelem - n;
for (k = 0; k < ncoord; k++) {
for (j = 0; j < n; j++) {
*(pix++) = (*(img++) / lin->cdelt[j]) + lin->crpix[j];
}
img += nelemn;
pix += nelemn;
}
} else if (lin->affine) {
/* No distortions. */
nelemn = nelem - n;
for (k = 0; k < ncoord; k++) {
/* cdelt will have been incorporated into imgpix. */
imgpix = lin->imgpix;
for (j = 0; j < n; j++) {
*pix = 0.0;
for (i = 0; i < n; i++) {
*pix += *imgpix * img[i];
imgpix++;
}
*(pix++) += lin->crpix[j];
}
img += nelem;
pix += nelemn;
}
} else {
/* Distortions are present. */
ndbl = n * sizeof(double);
tmp = lin->tmpcrd;
for (k = 0; k < ncoord; k++) {
if (lin->disseq) {
/* With sequent distortions, cdelt is not incorporated into imgpix. */
for (i = 0; i < n; i++) {
tmp[i] = img[i] / lin->cdelt[i];
}
if ((status = disx2p(lin->disseq, tmp, pix))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
memcpy(tmp, pix, ndbl);
} else if (lin->unity) {
/* ...nor if the matrix is unity. */
for (i = 0; i < n; i++) {
tmp[i] = img[i] / lin->cdelt[i];
}
} else {
/* cdelt will have been incorporated into imgpix. */
memcpy(tmp, img, ndbl);
}
if (lin->unity) {
for (j = 0; j < n; j++) {
pix[j] = tmp[j] + lin->crpix[j];
}
} else {
imgpix = lin->imgpix;
for (j = 0; j < n; j++) {
pix[j] = lin->crpix[j];
for (i = 0; i < n; i++) {
pix[j] += *(imgpix++) * tmp[i];
}
}
}
if (lin->dispre) {
memcpy(tmp, pix, ndbl);
if ((status = disx2p(lin->dispre, tmp, pix))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
}
img += nelem;
pix += nelem;
}
}
return 0;
}
int datfix(struct wcsprm *wcs)
{
static const char *function = "datfix";
char orig_dateobs[72];
char ctmp[72], ctmp2[72];
char *dateobs;
int day, dd, hour = 0, jd, minute = 0, month, msec, n4, year;
double mjdobs, sec = 0.0, t;
struct wcserr **err;
if (wcs == 0x0) return FIXERR_NULL_POINTER;
err = &(wcs->err);
dateobs = wcs->dateobs;
strncpy(orig_dateobs, dateobs, 72);
if (dateobs[0] == '\0') {
if (undefined(wcs->mjdobs)) {
/* No date information was provided. */
return FIXERR_NO_CHANGE;
} else {
/* Calendar date from MJD. */
jd = 2400001 + (int)wcs->mjdobs;
n4 = 4*(jd + ((2*((4*jd - 17918)/146097)*3)/4 + 1)/2 - 37);
dd = 10*(((n4-237)%1461)/4) + 5;
year = n4/1461 - 4712;
month = (2 + dd/306)%12 + 1;
day = (dd%306)/10 + 1;
sprintf(dateobs, "%.4d-%.2d-%.2d", year, month, day);
/* Write time part only if non-zero. */
if ((t = wcs->mjdobs - (int)wcs->mjdobs) > 0.0) {
t *= 24.0;
hour = (int)t;
t = 60.0 * (t - hour);
minute = (int)t;
sec = 60.0 * (t - minute);
/* Round to 1ms. */
dd = 60000*(60*hour + minute) + (int)(1000*(sec+0.0005));
hour = dd / 3600000;
dd -= 3600000 * hour;
minute = dd / 60000;
msec = dd - 60000 * minute;
sprintf(dateobs+10, "T%.2d:%.2d:%.2d", hour, minute, msec/1000);
/* Write fractions of a second only if non-zero. */
if (msec%1000) {
sprintf(dateobs+19, ".%.3d", msec%1000);
}
}
}
} else {
if (strlen(dateobs) < 8) {
/* Can't be a valid date. */
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: date string too short '%s'", dateobs);
}
/* Identify the date format. */
if (dateobs[4] == '-' && dateobs[7] == '-') {
/* Standard year-2000 form: CCYY-MM-DD[Thh:mm:ss[.sss...]] */
if (sscanf(dateobs, "%4d-%2d-%2d", &year, &month, &day) < 3) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid date '%s'", dateobs);
}
if (dateobs[10] == 'T') {
if (parse_date(dateobs+11, &hour, &minute, &sec)) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid time '%s'", dateobs+11);
}
} else if (dateobs[10] == ' ') {
hour = 0;
minute = 0;
sec = 0.0;
if (parse_date(dateobs+11, &hour, &minute, &sec)) {
write_date(dateobs+10, hour, minute, sec);
} else {
dateobs[10] = 'T';
}
}
} else if (dateobs[4] == '/' && dateobs[7] == '/') {
/* Also allow CCYY/MM/DD[Thh:mm:ss[.sss...]] */
if (sscanf(dateobs, "%4d/%2d/%2d", &year, &month, &day) < 3) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid date '%s'", dateobs);
}
if (dateobs[10] == 'T') {
if (parse_date(dateobs+11, &hour, &minute, &sec)) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid time '%s'", dateobs+11);
}
} else if (dateobs[10] == ' ') {
hour = 0;
minute = 0;
sec = 0.0;
if (parse_date(dateobs+11, &hour, &minute, &sec)) {
write_date(dateobs+10, hour, minute, sec);
} else {
dateobs[10] = 'T';
}
}
/* Looks ok, fix it up. */
dateobs[4] = '-';
dateobs[7] = '-';
} else {
if (dateobs[2] == '/' && dateobs[5] == '/') {
/* Old format date: DD/MM/YY, also allowing DD/MM/CCYY. */
if (sscanf(dateobs, "%2d/%2d/%4d", &day, &month, &year) < 3) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid date '%s'", dateobs);
}
} else if (dateobs[2] == '-' && dateobs[5] == '-') {
/* Also recognize DD-MM-YY and DD-MM-CCYY */
if (sscanf(dateobs, "%2d-%2d-%4d", &day, &month, &year) < 3) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid date '%s'", dateobs);
}
} else {
/* Not a valid date format. */
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: invalid date '%s'", dateobs);
}
if (year < 100) year += 1900;
/* Doesn't have a time. */
sprintf(dateobs, "%.4d-%.2d-%.2d", year, month, day);
}
/* Compute MJD. */
mjdobs = (double)((1461*(year - (12-month)/10 + 4712))/4
+ (306*((month+9)%12) + 5)/10
- (3*((year - (12-month)/10 + 4900)/100))/4
+ day - 2399904)
+ (hour + (minute + sec/60.0)/60.0)/24.0;
if (undefined(wcs->mjdobs)) {
wcs->mjdobs = mjdobs;
} else {
/* Check for consistency. */
if (fabs(mjdobs - wcs->mjdobs) > 0.5) {
return wcserr_set(WCSERR_SET(FIXERR_BAD_PARAM),
"Invalid parameter value: inconsistent date '%s'", dateobs);
}
}
}
if (strncmp(orig_dateobs, dateobs, 72)) {
wcserr_set(WCSERR_SET(FIXERR_DATE_FIX),
"Changed '%s' to '%s'", orig_dateobs, dateobs);
return FIXERR_SUCCESS;
}
return FIXERR_NO_CHANGE;
}
int spcx2s(
struct spcprm *spc,
int nx,
int sx,
int sspec,
const double x[],
double spec[],
int stat[])
{
static const char *function = "spcx2s";
int statP2S, status = 0, statX2P;
double beta;
register int ix;
register int *statp;
register const double *xp;
register double *specp;
struct wcserr **err;
/* Initialize. */
if (spc == 0x0) return SPCERR_NULL_POINTER;
err = &(spc->err);
if (spc->flag == 0) {
if ((status = spcset(spc))) return status;
}
/* Convert intermediate world coordinate x to X. */
xp = x;
specp = spec;
statp = stat;
for (ix = 0; ix < nx; ix++, xp += sx, specp += sspec) {
*specp = spc->w[1] + (*xp)*spc->w[2];
*(statp++) = 0;
}
/* If X is the grism parameter then convert it to wavelength. */
if (spc->isGrism) {
specp = spec;
for (ix = 0; ix < nx; ix++, specp += sspec) {
beta = atand(*specp) + spc->w[3];
*specp = (sind(beta) + spc->w[4]) * spc->w[5];
}
}
/* Apply the non-linear step of the algorithm chain to convert the */
/* X-type spectral variable to P-type intermediate spectral variable. */
if (spc->spxX2P) {
if ((statX2P = spc->spxX2P(spc->w[0], nx, sspec, sspec, spec, spec,
stat))) {
if (statX2P == SPXERR_BAD_INSPEC_COORD) {
status = SPCERR_BAD_X;
} else if (statX2P == SPXERR_BAD_SPEC_PARAMS) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral parameters: Frequency or wavelength is 0");
} else {
return wcserr_set(SPC_ERRMSG(spc_spxerr[statX2P]));
}
}
}
/* Apply the linear step of the algorithm chain to convert P-type */
/* intermediate spectral variable to the required S-type variable. */
if (spc->spxP2S) {
if ((statP2S = spc->spxP2S(spc->w[0], nx, sspec, sspec, spec, spec,
stat))) {
if (statP2S == SPXERR_BAD_INSPEC_COORD) {
status = SPCERR_BAD_X;
} else if (statP2S == SPXERR_BAD_SPEC_PARAMS) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral parameters: Frequency or wavelength is 0");
} else {
return wcserr_set(SPC_ERRMSG(spc_spxerr[statP2S]));
}
}
}
if (status) {
wcserr_set(SPC_ERRMSG(status));
}
return status;
}
int spcs2x(
struct spcprm *spc,
int nspec,
int sspec,
int sx,
const double spec[],
double x[],
int stat[])
{
static const char *function = "spcs2x";
int statP2X, status = 0, statS2P;
double beta, s;
register int ispec;
register int *statp;
register const double *specp;
register double *xp;
struct wcserr **err;
/* Initialize. */
if (spc == 0x0) return SPCERR_NULL_POINTER;
err = &(spc->err);
if (spc->flag == 0) {
if ((status = spcset(spc))) return status;
}
/* Apply the linear step of the algorithm chain to convert the S-type */
/* spectral variable to P-type intermediate spectral variable. */
if (spc->spxS2P) {
if ((statS2P = spc->spxS2P(spc->w[0], nspec, sspec, sx, spec, x, stat))) {
if (statS2P == SPXERR_BAD_INSPEC_COORD) {
status = SPCERR_BAD_SPEC;
} else if (statS2P == SPXERR_BAD_SPEC_PARAMS) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral parameters: Frequency or wavelength is 0");
} else {
return wcserr_set(SPC_ERRMSG(spc_spxerr[statS2P]));
}
}
} else {
/* Just a copy. */
xp = x;
specp = spec;
statp = stat;
for (ispec = 0; ispec < nspec; ispec++, specp += sspec, xp += sx) {
*xp = *specp;
*(statp++) = 0;
}
}
/* Apply the non-linear step of the algorithm chain to convert P-type */
/* intermediate spectral variable to X-type spectral variable. */
if (spc->spxP2X) {
if ((statP2X = spc->spxP2X(spc->w[0], nspec, sx, sx, x, x, stat))) {
if (statP2X == SPCERR_BAD_SPEC) {
status = SPCERR_BAD_SPEC;
} else if (statP2X == SPXERR_BAD_SPEC_PARAMS) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral parameters: Frequency or wavelength is 0");
} else {
return wcserr_set(SPC_ERRMSG(spc_spxerr[statP2X]));
}
}
}
if (spc->isGrism) {
/* Convert X-type spectral variable (wavelength) to grism parameter. */
xp = x;
statp = stat;
for (ispec = 0; ispec < nspec; ispec++, xp += sx, statp++) {
if (*statp) continue;
s = *xp/spc->w[5] - spc->w[4];
if (fabs(s) <= 1.0) {
beta = asind(s);
*xp = tand(beta - spc->w[3]);
} else {
*statp = 1;
}
}
}
/* Convert X-type spectral variable to intermediate world coordinate x. */
xp = x;
statp = stat;
for (ispec = 0; ispec < nspec; ispec++, xp += sx) {
if (*(statp++)) continue;
*xp -= spc->w[1];
*xp /= spc->w[2];
}
if (status) {
wcserr_set(SPC_ERRMSG(status));
}
return status;
}
int spctrne(
const char ctypeS1[9],
double crvalS1,
double cdeltS1,
double restfrq,
double restwav,
char ctypeS2[9],
double *crvalS2,
double *cdeltS2,
struct wcserr **err)
{
static const char *function = "spctrne";
char *cp, ptype1, ptype2, stype1[5], stype2[5], xtype1, xtype2;
int restreq, status;
double crvalX, dS2dX, dXdS1;
if (restfrq == 0.0 && restwav == 0.0) {
/* If translating between two velocity-characteristic types, or between
two wave-characteristic types, then we may need to set a dummy rest
frequency or wavelength to perform the calculations. */
strncpy(stype1, ctypeS1, 4);
strncpy(stype2, ctypeS2, 4);
stype1[4] = stype2[4] = '\0';
if ((strstr("VRAD VOPT ZOPT VELO BETA", stype1) != 0x0) ==
(strstr("VRAD VOPT ZOPT VELO BETA", stype2) != 0x0)) {
restwav = 1.0;
}
}
if ((status = spcspxe(ctypeS1, crvalS1, restfrq, restwav, &ptype1, &xtype1,
&restreq, &crvalX, &dXdS1, err))) {
return status;
}
/* Pad with blanks. */
ctypeS2[8] = '\0';
for (cp = ctypeS2; *cp; cp++);
while (cp < ctypeS2+8) *(cp++) = ' ';
if (strncmp(ctypeS2+5, "???", 3) == 0) {
/* Set the algorithm code if required. */
if (xtype1 == 'w') {
strcpy(ctypeS2+5, "GRI");
} else if (xtype1 == 'a') {
strcpy(ctypeS2+5, "GRA");
} else {
ctypeS2[5] = xtype1;
ctypeS2[6] = '2';
}
}
if ((status = spcxpse(ctypeS2, crvalX, restfrq, restwav, &ptype2, &xtype2,
&restreq, crvalS2, &dS2dX, err))) {
return status;
}
/* Are the X-types compatible? */
if (xtype2 != xtype1) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Incompatible X-types '%c' and '%c'", xtype1, xtype2);
}
if (ctypeS2[7] == '?') {
if (ptype2 == xtype2) {
strcpy(ctypeS2+4, " ");
} else {
ctypeS2[7] = ptype2;
}
}
*cdeltS2 = dS2dX * dXdS1 * cdeltS1;
return 0;
}
int spcset(struct spcprm *spc)
{
static const char *function = "spcset";
char ctype[9], ptype, xtype;
int restreq, status;
double alpha, beta_r, crvalX, dn_r, dXdS, epsilon, G, m, lambda_r, n_r,
t, restfrq, restwav, theta;
struct wcserr **err;
if (spc == 0x0) return SPCERR_NULL_POINTER;
err = &(spc->err);
if (undefined(spc->crval)) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Spectral crval is undefined");
}
memset((spc->type)+4, 0, 4);
spc->code[3] = '\0';
wcsutil_blank_fill(4, spc->type);
wcsutil_blank_fill(3, spc->code);
spc->w[0] = 0.0;
/* Analyse the spectral axis type. */
memset(ctype, 0, 9);
strncpy(ctype, spc->type, 4);
if (*(spc->code) != ' ') {
sprintf(ctype+4, "-%s", spc->code);
}
restfrq = spc->restfrq;
restwav = spc->restwav;
if ((status = spcspxe(ctype, spc->crval, restfrq, restwav, &ptype, &xtype,
&restreq, &crvalX, &dXdS, &(spc->err)))) {
return status;
}
/* Satisfy rest frequency/wavelength requirements. */
if (restreq) {
if (restreq == 3 && restfrq == 0.0 && restwav == 0.0) {
/* VRAD-V2F, VOPT-V2W, and ZOPT-V2W require the rest frequency or */
/* wavelength for the S-P and P-X transformations but not for S-X */
/* so supply a phoney value. */
restwav = 1.0;
}
if (restfrq == 0.0) {
restfrq = C/restwav;
} else {
restwav = C/restfrq;
}
if (ptype == 'F') {
spc->w[0] = restfrq;
} else if (ptype != 'V') {
spc->w[0] = restwav;
} else {
if (xtype == 'F') {
spc->w[0] = restfrq;
} else {
spc->w[0] = restwav;
}
}
}
spc->w[1] = crvalX;
spc->w[2] = dXdS;
/* Set pointers-to-functions for the linear part of the transformation. */
if (ptype == 'F') {
if (strcmp(spc->type, "FREQ") == 0) {
/* Frequency. */
spc->flag = FREQ;
spc->spxP2S = 0x0;
spc->spxS2P = 0x0;
} else if (strcmp(spc->type, "AFRQ") == 0) {
/* Angular frequency. */
spc->flag = AFRQ;
spc->spxP2S = freqafrq;
spc->spxS2P = afrqfreq;
} else if (strcmp(spc->type, "ENER") == 0) {
/* Photon energy. */
spc->flag = ENER;
spc->spxP2S = freqener;
spc->spxS2P = enerfreq;
} else if (strcmp(spc->type, "WAVN") == 0) {
/* Wave number. */
spc->flag = WAVN;
spc->spxP2S = freqwavn;
spc->spxS2P = wavnfreq;
} else if (strcmp(spc->type, "VRAD") == 0) {
/* Radio velocity. */
spc->flag = VRAD;
spc->spxP2S = freqvrad;
spc->spxS2P = vradfreq;
}
} else if (ptype == 'W') {
if (strcmp(spc->type, "WAVE") == 0) {
/* Vacuum wavelengths. */
spc->flag = WAVE;
spc->spxP2S = 0x0;
spc->spxS2P = 0x0;
} else if (strcmp(spc->type, "VOPT") == 0) {
/* Optical velocity. */
spc->flag = VOPT;
spc->spxP2S = wavevopt;
spc->spxS2P = voptwave;
} else if (strcmp(spc->type, "ZOPT") == 0) {
/* Redshift. */
spc->flag = ZOPT;
spc->spxP2S = wavezopt;
spc->spxS2P = zoptwave;
}
} else if (ptype == 'A') {
if (strcmp(spc->type, "AWAV") == 0) {
/* Air wavelengths. */
spc->flag = AWAV;
spc->spxP2S = 0x0;
spc->spxS2P = 0x0;
}
} else if (ptype == 'V') {
if (strcmp(spc->type, "VELO") == 0) {
/* Relativistic velocity. */
spc->flag = VELO;
spc->spxP2S = 0x0;
spc->spxS2P = 0x0;
} else if (strcmp(spc->type, "BETA") == 0) {
/* Velocity ratio (v/c). */
spc->flag = BETA;
spc->spxP2S = velobeta;
spc->spxS2P = betavelo;
}
}
/* Set pointers-to-functions for the non-linear part of the spectral */
/* transformation. */
spc->isGrism = 0;
if (xtype == 'F') {
/* Axis is linear in frequency. */
if (ptype == 'F') {
spc->spxX2P = 0x0;
spc->spxP2X = 0x0;
} else if (ptype == 'W') {
spc->spxX2P = freqwave;
spc->spxP2X = wavefreq;
} else if (ptype == 'A') {
spc->spxX2P = freqawav;
spc->spxP2X = awavfreq;
} else if (ptype == 'V') {
spc->spxX2P = freqvelo;
spc->spxP2X = velofreq;
}
spc->flag += F2S;
} else if (xtype == 'W' || xtype == 'w') {
/* Axis is linear in vacuum wavelengths. */
if (ptype == 'F') {
spc->spxX2P = wavefreq;
spc->spxP2X = freqwave;
} else if (ptype == 'W') {
spc->spxX2P = 0x0;
spc->spxP2X = 0x0;
} else if (ptype == 'A') {
spc->spxX2P = waveawav;
spc->spxP2X = awavwave;
} else if (ptype == 'V') {
spc->spxX2P = wavevelo;
spc->spxP2X = velowave;
}
if (xtype == 'W') {
spc->flag += W2S;
} else {
/* Grism in vacuum. */
spc->isGrism = 1;
spc->flag += GRI;
}
} else if (xtype == 'A' || xtype == 'a') {
/* Axis is linear in air wavelengths. */
if (ptype == 'F') {
spc->spxX2P = awavfreq;
spc->spxP2X = freqawav;
} else if (ptype == 'W') {
spc->spxX2P = awavwave;
spc->spxP2X = waveawav;
} else if (ptype == 'A') {
spc->spxX2P = 0x0;
spc->spxP2X = 0x0;
} else if (ptype == 'V') {
spc->spxX2P = awavvelo;
spc->spxP2X = veloawav;
}
if (xtype == 'A') {
spc->flag += A2S;
} else {
/* Grism in air. */
spc->isGrism = 2;
spc->flag += GRA;
}
} else if (xtype == 'V') {
/* Axis is linear in relativistic velocity. */
if (ptype == 'F') {
spc->spxX2P = velofreq;
spc->spxP2X = freqvelo;
} else if (ptype == 'W') {
spc->spxX2P = velowave;
spc->spxP2X = wavevelo;
} else if (ptype == 'A') {
spc->spxX2P = veloawav;
spc->spxP2X = awavvelo;
} else if (ptype == 'V') {
spc->spxX2P = 0x0;
spc->spxP2X = 0x0;
}
spc->flag += V2S;
}
/* Check for grism axes. */
if (spc->isGrism) {
/* Axis is linear in "grism parameter"; work in wavelength. */
lambda_r = crvalX;
/* Set defaults. */
if (undefined(spc->pv[0])) spc->pv[0] = 0.0;
if (undefined(spc->pv[1])) spc->pv[1] = 0.0;
if (undefined(spc->pv[2])) spc->pv[2] = 0.0;
if (undefined(spc->pv[3])) spc->pv[3] = 1.0;
if (undefined(spc->pv[4])) spc->pv[4] = 0.0;
if (undefined(spc->pv[5])) spc->pv[5] = 0.0;
if (undefined(spc->pv[6])) spc->pv[6] = 0.0;
/* Compute intermediaries. */
G = spc->pv[0];
m = spc->pv[1];
alpha = spc->pv[2];
n_r = spc->pv[3];
dn_r = spc->pv[4];
epsilon = spc->pv[5];
theta = spc->pv[6];
t = G*m/cosd(epsilon);
beta_r = asind(t*lambda_r - n_r*sind(alpha));
t -= dn_r*sind(alpha);
spc->w[1] = -tand(theta);
spc->w[2] *= t / (cosd(beta_r)*cosd(theta)*cosd(theta));
spc->w[3] = beta_r + theta;
spc->w[4] = (n_r - dn_r*lambda_r)*sind(alpha);
spc->w[5] = 1.0 / t;
}
return 0;
}
int
sip_init(
sip_t* sip,
const unsigned int a_order, const double* a,
const unsigned int b_order, const double* b,
const unsigned int ap_order, const double* ap,
const unsigned int bp_order, const double* bp,
const double* crpix /* [2] */) {
unsigned int a_size = 0;
unsigned int b_size = 0;
unsigned int ap_size = 0;
unsigned int bp_size = 0;
unsigned int scratch_size = 0;
int status = 0;
struct wcserr** err = NULL;
static const char *function = "sip_init";
assert(sip != NULL);
sip_clear(sip);
err = &(sip->err);
/* We we have one of A/B or AP/BP, we must have both. */
if ((a == NULL) ^ (b == NULL)) {
return wcserr_set(
SIP_ERRMSG(WCSERR_BAD_COORD_TRANS),
"Both A and B SIP transform must be defined");
}
if ((ap == NULL) ^ (bp == NULL)) {
return wcserr_set(
SIP_ERRMSG(WCSERR_BAD_COORD_TRANS),
"Both AP and BP SIP transform must be defined");
}
if (a != NULL) {
sip->a_order = a_order;
a_size = (a_order + 1) * (a_order + 1) * sizeof(double);
sip->a = malloc(a_size);
if (sip->a == NULL) {
sip_free(sip);
status = wcserr_set(
SIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
memcpy(sip->a, a, a_size);
if (a_order > scratch_size) {
scratch_size = a_order;
}
sip->b_order = b_order;
b_size = (b_order + 1) * (b_order + 1) * sizeof(double);
sip->b = malloc(b_size);
if (sip->b == NULL) {
sip_free(sip);
status = wcserr_set(
SIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
memcpy(sip->b, b, b_size);
if (b_order > scratch_size) {
scratch_size = b_order;
}
}
if (ap != NULL) {
sip->ap_order = ap_order;
ap_size = (ap_order + 1) * (ap_order + 1) * sizeof(double);
sip->ap = malloc(ap_size);
if (sip->ap == NULL) {
sip_free(sip);
status = wcserr_set(
SIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
memcpy(sip->ap, ap, ap_size);
if (ap_order > scratch_size) {
scratch_size = ap_order;
}
sip->bp_order = bp_order;
bp_size = (bp_order + 1) * (bp_order + 1) * sizeof(double);
sip->bp = malloc(bp_size);
if (sip->bp == NULL) {
sip_free(sip);
status = wcserr_set(
SIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
memcpy(sip->bp, bp, bp_size);
if (bp_order > scratch_size) {
scratch_size = bp_order;
}
}
scratch_size = (scratch_size + 1) * sizeof(double);
sip->scratch = malloc(scratch_size);
if (sip->scratch == NULL) {
sip_free(sip);
status = wcserr_set(
SIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
sip->crpix[0] = crpix[0];
sip->crpix[1] = crpix[1];
exit:
return status;
}
int
pipeline_all_pixel2world(
pipeline_t* pipeline,
const unsigned int ncoord,
const unsigned int nelem,
const double* const pixcrd /* [ncoord][nelem] */,
double* world /* [ncoord][nelem] */) {
static const char* function = "pipeline_all_pixel2world";
const double* wcs_input = NULL;
double* wcs_output = NULL;
int has_det2im;
int has_sip;
int has_p4;
int has_wcs;
int status = 1;
struct wcserr **err;
/* Temporary buffer for performing WCS calculations */
unsigned char* buffer = NULL;
unsigned char* mem = NULL;
/*@null@*/ double* tmp;
/*@null@*/ double* imgcrd;
/*@null@*/ double* phi;
/*@null@*/ double* theta;
/*@null@*/ int* stat;
if (pipeline == NULL || pixcrd == NULL || world == NULL) {
return WCSERR_NULL_POINTER;
}
err = &(pipeline->err);
has_det2im = pipeline->det2im[0] != NULL || pipeline->det2im[1] != NULL;
has_sip = pipeline->sip != NULL;
has_p4 = pipeline->cpdis[0] != NULL || pipeline->cpdis[1] != NULL;
has_wcs = pipeline->wcs != NULL;
if (has_det2im || has_sip || has_p4) {
if (nelem != 2) {
status = wcserr_set(
PIP_ERRMSG(WCSERR_BAD_COORD_TRANS),
"Data must be 2-dimensional when Paper IV lookup table or SIP transform is present.");
goto exit;
}
}
if (has_wcs) {
buffer = mem = malloc(
ncoord * nelem * sizeof(double) + /* imgcrd */
ncoord * sizeof(double) + /* phi */
ncoord * sizeof(double) + /* theta */
ncoord * nelem * sizeof(double) + /* tmp */
ncoord * nelem * sizeof(int) /* stat */
);
if (buffer == NULL) {
status = wcserr_set(
PIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
imgcrd = (double *)mem;
mem += ncoord * nelem * sizeof(double);
phi = (double *)mem;
mem += ncoord * sizeof(double);
theta = (double *)mem;
mem += ncoord * sizeof(double);
tmp = (double *)mem;
mem += ncoord * nelem * sizeof(double);
stat = (int *)mem;
/* mem += ncoord * nelem * sizeof(int); */
if (has_det2im || has_sip || has_p4) {
status = pipeline_pix2foc(pipeline, ncoord, nelem, pixcrd, tmp);
if (status != 0) {
goto exit;
}
wcs_input = tmp;
wcs_output = world;
} else {
wcs_input = pixcrd;
wcs_output = world;
}
if ((status = wcsp2s(pipeline->wcs, (int)ncoord, (int)nelem, wcs_input, imgcrd,
phi, theta, wcs_output, stat))) {
wcserr_copy(pipeline->wcs->err, pipeline->err);
}
if (status == 8) {
set_invalid_to_nan((int)ncoord, (int)nelem, wcs_output, stat);
}
} else {
if (has_det2im || has_sip || has_p4) {
status = pipeline_pix2foc(pipeline, ncoord, nelem, pixcrd, world);
}
}
exit:
free(buffer);
return status;
}
int pipeline_pix2foc(
pipeline_t* pipeline,
const unsigned int ncoord,
const unsigned int nelem,
const double* const pixcrd /* [ncoord][nelem] */,
double* foc /* [ncoord][nelem] */) {
static const char* function = "pipeline_pix2foc";
int has_det2im;
int has_sip;
int has_p4;
const double * input = NULL;
double * tmp = NULL;
int status = 1;
struct wcserr **err;
assert(nelem == 2);
assert(pixcrd != foc);
if (pipeline == NULL || pixcrd == NULL || foc == NULL) {
return WCSERR_NULL_POINTER;
}
err = &(pipeline->err);
has_det2im = pipeline->det2im[0] != NULL || pipeline->det2im[1] != NULL;
has_sip = pipeline->sip != NULL;
has_p4 = pipeline->cpdis[0] != NULL || pipeline->cpdis[1] != NULL;
if (has_det2im) {
if (has_sip || has_p4) {
tmp = malloc(ncoord * nelem * sizeof(double));
if (tmp == NULL) {
status = wcserr_set(
PIP_ERRMSG(WCSERR_MEMORY), "Memory allocation failed");
goto exit;
}
memcpy(tmp, pixcrd, sizeof(double) * ncoord * nelem);
status = p4_pix2deltas(2, (void*)pipeline->det2im, ncoord, pixcrd, tmp);
if (status) {
wcserr_set(PIP_ERRMSG(WCSERR_NULL_POINTER), "NULL pointer passed");
goto exit;
}
input = tmp;
memcpy(foc, input, sizeof(double) * ncoord * nelem);
} else {
memcpy(foc, pixcrd, sizeof(double) * ncoord * nelem);
status = p4_pix2deltas(2, (void*)pipeline->det2im, ncoord, pixcrd, foc);
if (status) {
wcserr_set(PIP_ERRMSG(WCSERR_NULL_POINTER), "NULL pointer passed");
goto exit;
}
}
} else {
/* Copy pixcrd to foc as a starting point. The "deltas" functions
below will undistort from there */
memcpy(foc, pixcrd, sizeof(double) * ncoord * nelem);
input = pixcrd;
}
if (has_sip) {
status = sip_pix2deltas(pipeline->sip, 2, ncoord, input, foc);
if (status) {
wcserr_copy(pipeline->sip->err, pipeline->err);
goto exit;
}
}
if (has_p4) {
status = p4_pix2deltas(2, (void*)pipeline->cpdis, ncoord, input, foc);
if (status) {
wcserr_set(PIP_ERRMSG(WCSERR_NULL_POINTER), "NULL pointer passed");
goto exit;
}
}
status = 0;
exit:
free(tmp);
return status;
}
int linini(int alloc, int naxis, struct linprm *lin)
{
static const char *function = "linini";
int i, j;
double *pc;
struct wcserr **err;
if (lin == 0x0) return LINERR_NULL_POINTER;
/* Initialize error message handling. */
err = &(lin->err);
if (lin->flag != -1) {
if (lin->err) free(lin->err);
}
lin->err = 0x0;
/* Initialize memory management. */
if (lin->flag == -1 || lin->m_flag != LINSET) {
if (lin->flag == -1) {
lin->dispre = 0x0;
lin->disseq = 0x0;
lin->tmpcrd = 0x0;
}
lin->m_flag = 0;
lin->m_naxis = 0;
lin->m_crpix = 0x0;
lin->m_pc = 0x0;
lin->m_cdelt = 0x0;
lin->m_dispre = 0x0;
lin->m_disseq = 0x0;
}
if (naxis < 0) {
return wcserr_set(WCSERR_SET(LINERR_MEMORY),
"naxis must not be negative (got %d)", naxis);
}
/* Allocate memory for arrays if required. */
if (alloc ||
lin->crpix == 0x0 ||
lin->pc == 0x0 ||
lin->cdelt == 0x0) {
/* Was sufficient allocated previously? */
if (lin->m_flag == LINSET && lin->m_naxis < naxis) {
/* No, free it. */
linfree(lin);
}
if (alloc || lin->crpix == 0x0) {
if (lin->m_crpix) {
/* In case the caller fiddled with it. */
lin->crpix = lin->m_crpix;
} else {
if ((lin->crpix = calloc(naxis, sizeof(double))) == 0x0) {
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lin->m_flag = LINSET;
lin->m_naxis = naxis;
lin->m_crpix = lin->crpix;
}
}
if (alloc || lin->pc == 0x0) {
if (lin->m_pc) {
/* In case the caller fiddled with it. */
lin->pc = lin->m_pc;
} else {
if ((lin->pc = calloc(naxis*naxis, sizeof(double))) == 0x0) {
linfree(lin);
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lin->m_flag = LINSET;
lin->m_naxis = naxis;
lin->m_pc = lin->pc;
}
}
if (alloc || lin->cdelt == 0x0) {
if (lin->m_cdelt) {
/* In case the caller fiddled with it. */
lin->cdelt = lin->m_cdelt;
} else {
if ((lin->cdelt = calloc(naxis, sizeof(double))) == 0x0) {
linfree(lin);
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
lin->m_flag = LINSET;
lin->m_naxis = naxis;
lin->m_cdelt = lin->cdelt;
}
}
}
/* Reinitialize disprm structs if we are managing them. */
if (lin->m_dispre) {
disini(1, naxis, lin->dispre);
}
if (lin->m_disseq) {
disini(1, naxis, lin->disseq);
}
/* Free memory allocated by linset(). */
if (lin->flag == LINSET) {
if (lin->piximg) free(lin->piximg);
if (lin->imgpix) free(lin->imgpix);
if (lin->tmpcrd) free(lin->tmpcrd);
}
lin->piximg = 0x0;
lin->imgpix = 0x0;
lin->i_naxis = 0;
lin->unity = 0;
lin->affine = 0;
lin->simple = 0;
lin->tmpcrd = 0x0;
lin->flag = 0;
lin->naxis = naxis;
/* CRPIXja defaults to 0.0. */
for (j = 0; j < naxis; j++) {
lin->crpix[j] = 0.0;
}
/* PCi_ja defaults to the unit matrix. */
pc = lin->pc;
for (i = 0; i < naxis; i++) {
for (j = 0; j < naxis; j++) {
if (j == i) {
*pc = 1.0;
} else {
*pc = 0.0;
}
pc++;
}
}
/* CDELTia defaults to 1.0. */
for (i = 0; i < naxis; i++) {
lin->cdelt[i] = 1.0;
}
return 0;
}
int spctype(
const char ctypei[9],
char stype[],
char scode[],
char sname[],
char units[],
char *ptype,
char *xtype,
int *restreq,
struct wcserr **err)
{
static const char *function = "spctype";
char ctype[9], ptype_t, sname_t[32], units_t[8], xtype_t;
int restreq_t = 0;
if (err) *err = 0x0;
/* Copy with blank padding. */
sprintf(ctype, "%-8.8s", ctypei);
ctype[8] = '\0';
/* Validate the S-type spectral variable. */
if (strncmp(ctype, "FREQ", 4) == 0) {
strcpy(sname_t, "Frequency");
strcpy(units_t, "Hz");
ptype_t = 'F';
} else if (strncmp(ctype, "AFRQ", 4) == 0) {
strcpy(sname_t, "Angular frequency");
strcpy(units_t, "rad/s");
ptype_t = 'F';
} else if (strncmp(ctype, "ENER", 4) == 0) {
strcpy(sname_t, "Photon energy");
strcpy(units_t, "J");
ptype_t = 'F';
} else if (strncmp(ctype, "WAVN", 4) == 0) {
strcpy(sname_t, "Wavenumber");
strcpy(units_t, "/m");
ptype_t = 'F';
} else if (strncmp(ctype, "VRAD", 4) == 0) {
strcpy(sname_t, "Radio velocity");
strcpy(units_t, "m/s");
ptype_t = 'F';
restreq_t = 1;
} else if (strncmp(ctype, "WAVE", 4) == 0) {
strcpy(sname_t, "Vacuum wavelength");
strcpy(units_t, "m");
ptype_t = 'W';
} else if (strncmp(ctype, "VOPT", 4) == 0) {
strcpy(sname_t, "Optical velocity");
strcpy(units_t, "m/s");
ptype_t = 'W';
restreq_t = 1;
} else if (strncmp(ctype, "ZOPT", 4) == 0) {
strcpy(sname_t, "Redshift");
strcpy(units_t, "");
ptype_t = 'W';
restreq_t = 1;
} else if (strncmp(ctype, "AWAV", 4) == 0) {
strcpy(sname_t, "Air wavelength");
strcpy(units_t, "m");
ptype_t = 'A';
} else if (strncmp(ctype, "VELO", 4) == 0) {
strcpy(sname_t, "Relativistic velocity");
strcpy(units_t, "m/s");
ptype_t = 'V';
} else if (strncmp(ctype, "BETA", 4) == 0) {
strcpy(sname_t, "Velocity ratio (v/c)");
strcpy(units_t, "");
ptype_t = 'V';
} else {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Unknown spectral type '%s'", ctype);
}
/* Determine X-type and validate the spectral algorithm code. */
if ((xtype_t = ctype[5]) == ' ') {
/* The algorithm code must be completely blank. */
if (strcmp(ctype+4, " ") != 0) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral algorithm '%s'", ctype+4);
}
xtype_t = ptype_t;
} else if (ctype[4] != '-') {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral type '%s'", ctype);
} else if (strcmp(ctype+5, "LOG") == 0 || strcmp(ctype+5, "TAB") == 0) {
/* Logarithmic or tabular axis, not linear in any spectral type. */
} else if (xtype_t == 'G') {
/* Validate the algorithm code. */
if (ctype[6] != 'R') {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral algorithm '%s'", xtype_t);
}
/* Grism coordinates... */
if (ctype[7] == 'I') {
/* ...in vacuum. */
xtype_t = 'w';
} else if (ctype[7] == 'A') {
/* ...in air. */
xtype_t = 'a';
} else {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral algorithm '%s'", xtype_t);
}
} else if (ctype[6] != '2') {
/* Algorithm code has invalid syntax. */
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Invalid spectral algorithm syntax '%s'", xtype_t);
} else if (ctype[7] != ptype_t && ctype[7] != '?') {
/* The P-, and S-type variables are inconsistent. */
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"In spectral type '%s', P- and S-type variables are inconsistent",
ctype);
} else if (ctype[7] == ctype[5]) {
/* Degenerate algorithm code. */
sprintf(ctype+4, " ");
}
/* Rest freq/wavelength required for transformation between P and X? */
if (strchr("FWAwa", (int)xtype_t)) {
if (ptype_t == 'V') {
restreq_t += 2;
}
} else if (xtype_t == 'V') {
if (strchr("FWAwa", (int)ptype_t)) {
restreq_t += 2;
}
} else if (strchr("LT", (int)xtype_t) == 0) {
/* Invalid X-type variable code. */
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"In spectral type '%s', invalid X-type variable code", ctype);
}
/* Copy results. */
if (stype) {
strncpy(stype, ctype, 4);
stype[4] = '\0';
}
if (scode) strcpy(scode, ctype+5);
if (sname) strcpy(sname, sname_t);
if (units) strcpy(units, units_t);
if (ptype) *ptype = ptype_t;
if (xtype) *xtype = xtype_t;
if (restreq) *restreq = restreq_t;
return 0;
}
int linp2x(
struct linprm *lin,
int ncoord,
int nelem,
const double pixcrd[],
double imgcrd[])
{
static const char *function = "linp2x";
int i, j, k, n, ndbl, nelemn, status;
double temp;
register const double *pix;
register double *img, *piximg, *tmp;
struct wcserr **err;
/* Initialize. */
if (lin == 0x0) return LINERR_NULL_POINTER;
err = &(lin->err);
if (lin->flag != LINSET) {
if ((status = linset(lin))) return status;
}
n = lin->naxis;
/* Convert pixel coordinates to intermediate world coordinates. */
pix = pixcrd;
img = imgcrd;
if (lin->simple) {
/* Handle the simplest and most common case with maximum efficiency. */
nelemn = nelem - n;
for (k = 0; k < ncoord; k++) {
for (i = 0; i < n; i++) {
*(img++) = lin->cdelt[i] * (*(pix++) - lin->crpix[i]);
}
pix += nelemn;
img += nelemn;
}
} else if (lin->affine) {
/* No distortions. */
ndbl = n * sizeof(double);
nelemn = nelem - n;
for (k = 0; k < ncoord; k++) {
memset(img, 0, ndbl);
for (j = 0; j < n; j++) {
/* cdelt will have been incorporated into piximg. */
piximg = lin->piximg + j;
/* Column-wise multiplication allows this to be cached. */
temp = *(pix++) - lin->crpix[j];
for (i = 0; i < n; i++, piximg += n) {
img[i] += *piximg * temp;
}
}
pix += nelemn;
img += nelem;
}
} else {
/* Distortions are present. */
ndbl = n * sizeof(double);
tmp = lin->tmpcrd;
for (k = 0; k < ncoord; k++) {
if (lin->dispre) {
if ((status = disp2x(lin->dispre, pix, tmp))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
} else {
memcpy(tmp, pix, ndbl);
}
if (lin->unity) {
for (i = 0; i < n; i++) {
img[i] = tmp[i] - lin->crpix[i];
}
} else {
for (j = 0; j < n; j++) {
tmp[j] -= lin->crpix[j];
}
piximg = lin->piximg;
for (i = 0; i < n; i++) {
img[i] = 0.0;
for (j = 0; j < n; j++) {
img[i] += *(piximg++) * tmp[j];
}
}
}
if (lin->disseq) {
if ((status = disp2x(lin->disseq, img, tmp))) {
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
/* With sequent distortions, cdelt is not incorporated into piximg. */
for (i = 0; i < n; i++) {
img[i] = lin->cdelt[i] * tmp[i];
}
} else if (lin->unity) {
/* ...nor if the matrix is unity. */
for (i = 0; i < n; i++) {
img[i] *= lin->cdelt[i];
}
}
pix += nelem;
img += nelem;
}
}
return 0;
}
int spcspxe(
const char ctypeS[9],
double crvalS,
double restfrq,
double restwav,
char *ptype,
char *xtype,
int *restreq,
double *crvalX,
double *dXdS,
struct wcserr **err)
{
static const char *function = "spcspxe";
char scode[4], stype[5], type[8];
int status;
double dPdS, dXdP;
struct spxprm spx;
/* Analyse the spectral axis code. */
if ((status = spctype(ctypeS, stype, scode, 0x0, 0x0, ptype, xtype, restreq,
err))) {
return status;
}
if (strchr("LT", (int)(*xtype))) {
/* Can't handle logarithmic or tabular coordinates. */
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Can't handle logarithmic or tabular coordinates");
}
/* Do we have rest frequency and/or wavelength as required? */
if ((*restreq)%3 && restfrq == 0.0 && restwav == 0.0) {
return wcserr_set(WCSERR_SET(SPCERR_BAD_SPEC_PARAMS),
"Missing required rest frequency or wavelength");
}
/* Compute all spectral parameters and their derivatives. */
strcpy(type, stype);
spx.err = (err ? *err : 0x0);
if ((status = specx(type, crvalS, restfrq, restwav, &spx))) {
status = spc_spxerr[status];
if (err) {
if ((*err = spx.err)) {
(*err)->status = status;
}
} else {
free(spx.err);
}
return status;
}
/* Transform S-P (linear) and P-X (non-linear). */
dPdS = 0.0;
dXdP = 0.0;
if (*ptype == 'F') {
if (strcmp(stype, "FREQ") == 0) {
dPdS = 1.0;
} else if (strcmp(stype, "AFRQ") == 0) {
dPdS = spx.dfreqafrq;
} else if (strcmp(stype, "ENER") == 0) {
dPdS = spx.dfreqener;
} else if (strcmp(stype, "WAVN") == 0) {
dPdS = spx.dfreqwavn;
} else if (strcmp(stype, "VRAD") == 0) {
dPdS = spx.dfreqvrad;
}
if (*xtype == 'F') {
*crvalX = spx.freq;
dXdP = 1.0;
} else if (*xtype == 'W' || *xtype == 'w') {
*crvalX = spx.wave;
dXdP = spx.dwavefreq;
} else if (*xtype == 'A' || *xtype == 'a') {
*crvalX = spx.awav;
dXdP = spx.dawavfreq;
} else if (*xtype == 'V') {
*crvalX = spx.velo;
dXdP = spx.dvelofreq;
}
} else if (*ptype == 'W' || *ptype == 'w') {
if (strcmp(stype, "WAVE") == 0) {
dPdS = 1.0;
} else if (strcmp(stype, "VOPT") == 0) {
dPdS = spx.dwavevopt;
} else if (strcmp(stype, "ZOPT") == 0) {
dPdS = spx.dwavezopt;
}
if (*xtype == 'F') {
*crvalX = spx.freq;
dXdP = spx.dfreqwave;
} else if (*xtype == 'W' || *xtype == 'w') {
*crvalX = spx.wave;
dXdP = 1.0;
} else if (*xtype == 'A' || *xtype == 'a') {
*crvalX = spx.awav;
dXdP = spx.dawavwave;
} else if (*xtype == 'V') {
*crvalX = spx.velo;
dXdP = spx.dvelowave;
}
} else if (*ptype == 'A' || *ptype == 'a') {
if (strcmp(stype, "AWAV") == 0) {
dPdS = 1.0;
}
if (*xtype == 'F') {
*crvalX = spx.freq;
dXdP = spx.dfreqawav;
} else if (*xtype == 'W' || *xtype == 'w') {
*crvalX = spx.wave;
dXdP = spx.dwaveawav;
} else if (*xtype == 'A' || *xtype == 'a') {
*crvalX = spx.awav;
dXdP = 1.0;
} else if (*xtype == 'V') {
*crvalX = spx.velo;
dXdP = spx.dveloawav;
}
} else if (*ptype == 'V') {
if (strcmp(stype, "VELO") == 0) {
dPdS = 1.0;
} else if (strcmp(stype, "BETA") == 0) {
dPdS = spx.dvelobeta;
}
if (*xtype == 'F') {
*crvalX = spx.freq;
dXdP = spx.dfreqvelo;
} else if (*xtype == 'W' || *xtype == 'w') {
*crvalX = spx.wave;
dXdP = spx.dwavevelo;
} else if (*xtype == 'A' || *xtype == 'a') {
*crvalX = spx.awav;
dXdP = spx.dawavvelo;
} else if (*xtype == 'V') {
*crvalX = spx.velo;
dXdP = 1.0;
}
}
*dXdS = dXdP * dPdS;
return 0;
}
int linwarp(
struct linprm *lin,
const double pixblc[],
const double pixtrc[],
const double pixsamp[],
int *nsamp,
double maxdis[],
double *maxtot,
double avgdis[],
double *avgtot,
double rmsdis[],
double *rmstot)
{
static const char *function = "linwarp";
int carry, i, j, naxis, ncoord, status = 0;
double dpix, dpx2, dssq, *img, *pix0, *pix0p, *pix1, *pix1p, *pixend,
*pixinc, pixspan, *ssqdis, ssqtot, *sumdis, sumtot, totdis;
struct linprm affine;
struct wcserr **err;
/* Initialize. */
if (lin == 0x0) return LINERR_NULL_POINTER;
err = &(lin->err);
naxis = lin->naxis;
if (nsamp) *nsamp = 0;
for (j = 0; j < naxis; j++) {
if (maxdis) maxdis[j] = 0.0;
if (avgdis) avgdis[j] = 0.0;
if (rmsdis) rmsdis[j] = 0.0;
}
if (maxtot) *maxtot = 0.0;
if (avgtot) *avgtot = 0.0;
if (rmstot) *rmstot = 0.0;
/* Quick return if no distortions. */
if (lin->affine) return 0;
/* It's easier if there are no sequent distortions! */
if (lin->disseq == 0x0) {
status = diswarp(lin->dispre, pixblc, pixtrc, pixsamp, nsamp,
maxdis, maxtot, avgdis, avgtot, rmsdis, rmstot);
return wcserr_set(LIN_ERRMSG(lin_diserr[status]));
}
/* Make a reference copy of lin without distortions. */
affine.flag = -1;
if ((status = (lincpy(1, lin, &affine) ||
lindis(1, &affine, 0x0) ||
lindis(2, &affine, 0x0) ||
linset(&affine)))) {
return wcserr_set(LIN_ERRMSG(status));
}
/* Work out increments on each axis. */
pixinc = lin->tmpcrd;
for (j = 0; j < naxis; j++) {
pixspan = pixtrc[j] - (pixblc ? pixblc[j] : 1.0);
if (pixsamp == 0x0) {
pixinc[j] = 1.0;
} else if (pixsamp[j] == 0.0) {
pixinc[j] = 1.0;
} else if (pixsamp[j] > 0.0) {
pixinc[j] = pixsamp[j];
} else if (pixsamp[j] > -1.5) {
pixinc[j] = 2.0*pixspan;
} else {
pixinc[j] = pixspan / ((int)(-pixsamp[j] - 0.5));
}
if (j == 0) {
/* Number of samples on axis 1. */
ncoord = 1 + (int)((pixspan/pixinc[0]) + 0.5);
}
}
/* Get memory for processing the image row by row. */
if ((pix0 = calloc((3*ncoord+4)*naxis, sizeof(double))) == 0x0) {
return wcserr_set(LIN_ERRMSG(LINERR_MEMORY));
}
img = pix0 + naxis*ncoord;
pix1 = img + naxis*ncoord;
pixinc = pix1 + naxis*ncoord;
pixend = pixinc + naxis;
sumdis = pixend + naxis;
ssqdis = sumdis + naxis;
/* Copy tmpcrd since linp2x() will overwrite it. */
memcpy(pixinc, lin->tmpcrd, naxis*sizeof(double));
/* Set up the array of pixel coordinates. */
for (j = 0; j < naxis; j++) {
pix0[j] = pixblc ? pixblc[j] : 1.0;
pixend[j] = pixtrc[j] + 0.5*pixinc[j];
}
pix0p = pix0 + naxis;
for (i = 1; i < ncoord; i++) {
*(pix0p++) = pix0[0] + i*pixinc[0];
for (j = 1; j < naxis; j++) {
*(pix0p++) = pix0[j];
}
}
/* Initialize accumulators. */
for (j = 0; j < naxis; j++) {
sumdis[j] = 0.0;
ssqdis[j] = 0.0;
}
sumtot = 0.0;
ssqtot = 0.0;
/* Loop over N dimensions. */
carry = 0;
while (carry == 0) {
if ((status = linp2x(lin, ncoord, naxis, pix0, img))) {
/* (Preserve the error message set by linp2x().) */
goto cleanup;
}
if ((status = linx2p(&affine, ncoord, naxis, img, pix1))) {
/* (Preserve the error message set by linx2p().) */
goto cleanup;
}
/* Accumulate statistics. */
pix0p = pix0;
pix1p = pix1;
for (i = 0; i < ncoord; i++) {
(*nsamp)++;
dssq = 0.0;
for (j = 0; j < naxis; j++) {
dpix = *(pix1p++) - *(pix0p++);
dpx2 = dpix*dpix;
sumdis[j] += dpix;
ssqdis[j] += dpx2;
if (maxdis && (dpix = fabs(dpix)) > maxdis[j]) maxdis[j] = dpix;
dssq += dpx2;
}
totdis = sqrt(dssq);
sumtot += totdis;
ssqtot += totdis*totdis;
if (maxtot && *maxtot < totdis) *maxtot = totdis;
}
/* Next array of pixel coordinates. */
for (j = 1; j < naxis; j++) {
pix0[j] += pixinc[j];
if ((carry = (pix0[j] > pixend[j]))) {
pix0[j] = pixblc ? pixblc[j] : 1.0;
}
pix0p = pix0 + naxis + j;
for (i = 1; i < ncoord; i++) {
*pix0p = pix0[j];
pix0p += naxis;
}
if (carry == 0) break;
}
}
/* Compute the means and RMSs. */
for (j = 0; j < naxis; j++) {
ssqdis[j] /= *nsamp;
sumdis[j] /= *nsamp;
if (avgdis) avgdis[j] = sumdis[j];
if (rmsdis) rmsdis[j] = sqrt(ssqdis[j] - sumdis[j]*sumdis[j]);
}
ssqtot /= *nsamp;
sumtot /= *nsamp;
if (avgtot) *avgtot = sumtot;
if (rmstot) *rmstot = sqrt(ssqtot - sumtot*sumtot);
cleanup:
free(pix0);
return status;
}
int tabmem(struct tabprm *tab)
{
static const char *function = "tabmem";
int m, M, N;
struct wcserr **err;
if (tab == 0x0) return TABERR_NULL_POINTER;
err = &(tab->err);
if (tab->M == 0 || tab->K == 0x0) {
/* Should have been set by this time. */
return wcserr_set(WCSERR_SET(TABERR_MEMORY),
"Null pointers in tabprm struct");
}
N = M = tab->M;
for (m = 0; m < M; m++) {
if (tab->K[m] < 0) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Each element of K must be "
"non-negative, got %d", M);
}
N *= tab->K[m];
}
if (tab->m_M == 0) {
tab->m_M = M;
} else if (tab->m_M < M) {
/* Only possible if the user changed M. */
return wcserr_set(WCSERR_SET(TABERR_MEMORY),
"tabprm struct inconsistent");
}
if (tab->m_N == 0) {
tab->m_N = N;
} else if (tab->m_N < N) {
/* Only possible if the user changed K[]. */
return wcserr_set(WCSERR_SET(TABERR_MEMORY),
"tabprm struct inconsistent");
}
if (tab->m_K == 0x0) {
if ((tab->m_K = tab->K)) {
tab->m_flag = TABSET;
}
}
if (tab->m_map == 0x0) {
if ((tab->m_map = tab->map)) {
tab->m_flag = TABSET;
}
}
if (tab->m_crval == 0x0) {
if ((tab->m_crval = tab->crval)) {
tab->m_flag = TABSET;
}
}
if (tab->m_index == 0x0) {
if ((tab->m_index = tab->index)) {
tab->m_flag = TABSET;
}
}
for (m = 0; m < tab->m_M; m++) {
if (tab->m_indxs[m] == 0x0 || tab->m_indxs[m] == (double *)0x1) {
if ((tab->m_indxs[m] = tab->index[m])) {
tab->m_flag = TABSET;
}
}
}
if (tab->m_coord == 0x0 || tab->m_coord == (double *)0x1) {
if ((tab->m_coord = tab->coord)) {
tab->m_flag = TABSET;
}
}
tab->flag = 0;
return 0;
}
int tabini(int alloc, int M, const int K[], struct tabprm *tab)
{
static const char *function = "tabini";
int k, m, N;
double *dp;
struct wcserr **err;
if (tab == 0x0) return TABERR_NULL_POINTER;
/* Initialize error message handling. */
err = &(tab->err);
if (tab->err && tab->flag != -1) {
free(tab->err);
}
tab->err = 0x0;
if (M <= 0) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"M must be positive, got %d", M);
}
/* Determine the total number of elements in the coordinate array. */
if (K) {
N = M;
for (m = 0; m < M; m++) {
if (K[m] < 0) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Each element of K must be "
"non-negative, got %d", K[m]);
}
N *= K[m];
}
} else {
/* Axis lengths as yet unknown. */
N = 0;
}
/* Initialize memory management. */
if (tab->flag == -1 || tab->m_flag != TABSET) {
tab->m_flag = 0;
tab->m_M = 0;
tab->m_N = 0;
tab->m_K = 0x0;
tab->m_map = 0x0;
tab->m_crval = 0x0;
tab->m_index = 0x0;
tab->m_indxs = 0x0;
tab->m_coord = 0x0;
} else {
/* Clear any outstanding signals set by wcstab(). */
for (m = 0; m < tab->m_M; m++) {
if (tab->m_indxs[m] == (double *)0x1) tab->m_indxs[m] = 0x0;
}
if (tab->m_coord == (double *)0x1) tab->m_coord = 0x0;
}
if (tab->flag == -1) {
tab->sense = 0x0;
tab->p0 = 0x0;
tab->delta = 0x0;
tab->extrema = 0x0;
tab->set_M = 0;
}
/* Allocate memory for arrays if required. */
if (alloc ||
tab->K == 0x0 ||
tab->map == 0x0 ||
tab->crval == 0x0 ||
tab->index == 0x0 ||
tab->coord == 0x0) {
/* Was sufficient allocated previously? */
if (tab->m_flag == TABSET && (tab->m_M < M || tab->m_N < N)) {
/* No, free it. */
tabfree(tab);
}
if (alloc || tab->K == 0x0) {
if (tab->m_K) {
/* In case the caller fiddled with it. */
tab->K = tab->m_K;
} else {
if (!(tab->K = calloc(M, sizeof(int)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->m_flag = TABSET;
tab->m_M = M;
tab->m_K = tab->K;
}
}
if (alloc || tab->map == 0x0) {
if (tab->m_map) {
/* In case the caller fiddled with it. */
tab->map = tab->m_map;
} else {
if (!(tab->map = calloc(M, sizeof(int)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->m_flag = TABSET;
tab->m_M = M;
tab->m_map = tab->map;
}
}
if (alloc || tab->crval == 0x0) {
if (tab->m_crval) {
/* In case the caller fiddled with it. */
tab->crval = tab->m_crval;
} else {
if (!(tab->crval = calloc(M, sizeof(double)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->m_flag = TABSET;
tab->m_M = M;
tab->m_crval = tab->crval;
}
}
if (alloc || tab->index == 0x0) {
if (tab->m_index) {
/* In case the caller fiddled with it. */
tab->index = tab->m_index;
} else {
if (!(tab->index = calloc(M, sizeof(double *)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->m_flag = TABSET;
tab->m_M = M;
tab->m_N = N;
tab->m_index = tab->index;
if (!(tab->m_indxs = calloc(M, sizeof(double *)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
/* Recall that calloc() initializes these pointers to zero. */
if (K) {
for (m = 0; m < M; m++) {
if (K[m]) {
if (!(tab->index[m] = calloc(K[m], sizeof(double)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->m_indxs[m] = tab->index[m];
}
}
}
}
}
if (alloc || tab->coord == 0x0) {
if (tab->m_coord) {
/* In case the caller fiddled with it. */
tab->coord = tab->m_coord;
} else if (N) {
if (!(tab->coord = calloc(N, sizeof(double)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->m_flag = TABSET;
tab->m_M = M;
tab->m_N = N;
tab->m_coord = tab->coord;
}
}
}
tab->flag = 0;
tab->M = M;
/* Set defaults. */
for (m = 0; m < M; m++) {
tab->map[m] = -1;
tab->crval[m] = 0.0;
if (K) {
tab->K[m] = K[m];
if ((dp = tab->index[m])) {
for (k = 0; k < K[m]; k++) {
*(dp++) = k;
}
}
} else {
tab->K[m] = 0;
}
}
/* Initialize the coordinate array. */
for (dp = tab->coord; dp < tab->coord + N; dp++) {
*dp = UNDEFINED;
}
return 0;
}
int wcshdo(int relax, struct wcsprm *wcs, int *nkeyrec, char **header)
/* ::: CUBEFACE and STOKES handling? */
{
static const char *function = "wcshdo";
char alt, comment[72], keyvalue[72], keyword[16], obsg[8] = "OBSG?",
obsgeo[8] = "OBSGEO-?", ptype, xtype, xyz[] = "XYZ";
int bintab, col0, *colax, colnum, i, j, k, naxis, pixlist, primage,
status = 0;
struct wcserr **err;
*nkeyrec = 0;
*header = 0x0;
if (wcs == 0x0) return WCSHDRERR_NULL_POINTER;
err = &(wcs->err);
if (wcs->flag != WCSSET) {
if ((status = wcsset(wcs))) return status;
}
if ((naxis = wcs->naxis) == 0) {
return 0;
}
/* These are mainly for convenience. */
alt = wcs->alt[0];
if (alt == ' ') alt = '\0';
colnum = wcs->colnum;
colax = wcs->colax;
primage = 0;
bintab = 0;
pixlist = 0;
if (colnum) {
bintab = 1;
col0 = colnum;
} else if (colax[0]) {
pixlist = 1;
col0 = colax[0];
} else {
primage = 1;
}
/* WCS dimension. */
if (!pixlist) {
sprintf(keyvalue, "%20d", naxis);
wcshdo_util(relax, "WCSAXES", "WCAX", 0, 0x0, 0, 0, 0, alt, colnum, colax,
keyvalue, "Number of coordinate axes", nkeyrec, header, &status);
}
/* Reference pixel coordinates. */
for (j = 0; j < naxis; j++) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->crpix[j]);
wcshdo_util(relax, "CRPIX", "CRP", WCSHDO_CRPXna, "CRPX", 0, j+1, 0, alt,
colnum, colax, keyvalue, "Pixel coordinate of reference point", nkeyrec,
header, &status);
}
/* Linear transformation matrix. */
k = 0;
for (i = 0; i < naxis; i++) {
for (j = 0; j < naxis; j++, k++) {
if (i == j) {
if (wcs->pc[k] == 1.0) continue;
} else {
if (wcs->pc[k] == 0.0) continue;
}
wcsutil_double2str(keyvalue, "%20.12G", wcs->pc[k]);
wcshdo_util(relax, "PC", bintab ? "PC" : "P", WCSHDO_TPCn_ka,
bintab ? 0x0 : "PC", i+1, j+1, 0, alt, colnum, colax,
keyvalue, "Coordinate transformation matrix element",
nkeyrec, header, &status);
}
}
/* Coordinate increment at reference point. */
for (i = 0; i < naxis; i++) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->cdelt[i]);
comment[0] = '\0';
if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
strcat(comment, "Coordinate increment at reference point");
wcshdo_util(relax, "CDELT", "CDE", WCSHDO_CRPXna, "CDLT", i+1, 0, 0, alt,
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
/* Units of coordinate increment and reference value. */
for (i = 0; i < naxis; i++) {
if (wcs->cunit[i][0] == '\0') continue;
sprintf(keyvalue, "'%s'", wcs->cunit[i]);
wcshdo_util(relax, "CUNIT", "CUN", WCSHDO_CRPXna, "CUNI", i+1, 0, 0, alt,
colnum, colax, keyvalue, "Units of coordinate increment and value",
nkeyrec, header, &status);
}
/* Coordinate type. */
for (i = 0; i < naxis; i++) {
if (wcs->ctype[i][0] == '\0') continue;
sprintf(keyvalue, "'%s'", wcs->ctype[i]);
strcpy(comment, "Coordinate type code");
if (i == wcs->lng || i == wcs->lat) {
if (strncmp(wcs->ctype[i], "RA--", 4) == 0) {
strcpy(comment, "Right ascension, ");
} else if (strncmp(wcs->ctype[i], "DEC-", 4) == 0) {
strcpy(comment, "Declination, ");
} else if (strncmp(wcs->ctype[i]+1, "LON", 3) == 0 ||
strncmp(wcs->ctype[i]+1, "LAT", 3) == 0) {
switch (wcs->ctype[i][0]) {
case 'G':
strcpy(comment, "galactic ");
break;
case 'E':
strcpy(comment, "ecliptic ");
case 'H':
strcpy(comment, "helioecliptic ");
case 'S':
strcpy(comment, "supergalactic ");
}
if (i == wcs->lng) {
strcat(comment, "longitude, ");
} else {
strcat(comment, "latitude, ");
}
wcs->ctype[i][0] = toupper(wcs->ctype[i][0]);
}
strcat(comment, wcs->cel.prj.name);
strcat(comment, " projection");
} else if (i == wcs->spec) {
spctyp(wcs->ctype[i], 0x0, 0x0, comment, 0x0, &ptype, &xtype, 0x0);
if (ptype == xtype) {
strcat(comment, " (linear)");
} else {
switch (xtype) {
case 'F':
strcat(comment, " (linear in frequency)");
break;
case 'V':
strcat(comment, " (linear in velocity)");
break;
case 'W':
strcat(comment, " (linear in wavelength)");
break;
}
}
}
wcshdo_util(relax, "CTYPE", "CTY", WCSHDO_CRPXna, "CTYP", i+1, 0, 0, alt,
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
/* Coordinate value at reference point. */
for (i = 0; i < naxis; i++) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->crval[i]);
comment[0] = '\0';
if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
strcat(comment, "Coordinate value at reference point");
wcshdo_util(relax, "CRVAL", "CRV", WCSHDO_CRPXna, "CRVL", i+1, 0, 0, alt,
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
/* Parameter values. */
for (k = 0; k < wcs->npv; k++) {
wcsutil_double2str(keyvalue, "%20.12G", (wcs->pv[k]).value);
if ((wcs->pv[k]).i == (wcs->lng + 1)) {
switch ((wcs->pv[k]).m) {
case 1:
strcpy(comment, "[deg] Native longitude of the reference point");
break;
case 2:
strcpy(comment, "[deg] Native latitude of the reference point");
break;
case 3:
if (primage) {
sprintf(keyword, "LONPOLE%c", alt);
} else if (bintab) {
sprintf(keyword, "LONP%d%c", colnum, alt);
} else {
sprintf(keyword, "LONP%d%c", colax[(wcs->pv[k]).i - 1], alt);
}
sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
break;
case 4:
if (primage) {
sprintf(keyword, "LATPOLE%c", alt);
} else if (bintab) {
sprintf(keyword, "LATP%d%c", colnum, alt);
} else {
sprintf(keyword, "LATP%d%c", colax[(wcs->pv[k]).i - 1], alt);
}
sprintf(comment, "[deg] alias for %s (has precedence)", keyword);
break;
}
} else if ((wcs->pv[k]).i == (wcs->lat + 1)) {
sprintf(comment, "%s projection parameter", wcs->cel.prj.code);
} else {
strcpy(comment, "Coordinate transformation parameter");
}
wcshdo_util(relax, "PV", "V", WCSHDO_PVn_ma, "PV", wcs->pv[k].i, -1,
wcs->pv[k].m, alt, colnum, colax, keyvalue, comment,
nkeyrec, header, &status);
}
for (k = 0; k < wcs->nps; k++) {
sprintf(keyvalue, "'%s'", (wcs->ps[k]).value);
wcshdo_util(relax, "PS", "S", WCSHDO_PVn_ma, "PS", wcs->ps[k].i, -1,
wcs->ps[k].m, alt, colnum, colax, keyvalue,
"Coordinate transformation parameter",
nkeyrec, header, &status);
}
/* Celestial and spectral transformation parameters. */
if (!undefined(wcs->lonpole)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->lonpole);
wcshdo_util(relax, "LONPOLE", "LONP", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "[deg] Native longitude of celestial pole",
nkeyrec, header, &status);
}
if (!undefined(wcs->latpole)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->latpole);
wcshdo_util(relax, "LATPOLE", "LATP", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "[deg] Native latitude of celestial pole",
nkeyrec, header, &status);
}
if (!undefined(wcs->restfrq)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->restfrq);
wcshdo_util(relax, "RESTFRQ", "RFRQ", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "[Hz] Line rest frequency",
nkeyrec, header, &status);
}
if (!undefined(wcs->restwav)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->restwav);
wcshdo_util(relax, "RESTWAV", "RWAV", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "[Hz] Line rest wavelength",
nkeyrec, header, &status);
}
/* Coordinate system title. */
if (wcs->wcsname[0]) {
sprintf(keyvalue, "'%s'", wcs->wcsname);
if (bintab) {
wcshdo_util(relax, "WCSNAME", "WCSN", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "Coordinate system title",
nkeyrec, header, &status);
} else {
/* TWCS was a mistake. */
wcshdo_util(relax, "WCSNAME", "TWCS", WCSHDO_WCSNna, "WCSN", 0, 0, 0,
alt, colnum, colax, keyvalue, "Coordinate system title",
nkeyrec, header, &status);
}
}
/* Coordinate axis title. */
if (wcs->cname) {
for (i = 0; i < naxis; i++) {
if (wcs->cname[i][0] == '\0') continue;
sprintf(keyvalue, "'%s'", wcs->cname[i]);
wcshdo_util(relax, "CNAME", "CNA", WCSHDO_CNAMna, "CNAM", i+1, 0, 0,
alt, colnum, colax, keyvalue, "Axis name for labelling purposes",
nkeyrec, header, &status);
}
}
/* Random error in coordinate. */
if (wcs->crder) {
for (i = 0; i < naxis; i++) {
if (undefined(wcs->crder[i])) continue;
wcsutil_double2str(keyvalue, "%20.12G", wcs->crder[i]);
comment[0] = '\0';
if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
strcat(comment, "Random error in coordinate");
wcshdo_util(relax, "CRDER", "CRD", WCSHDO_CNAMna, "CRDE", i+1, 0, 0,
alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
}
/* Systematic error in coordinate. */
if (wcs->csyer) {
for (i = 0; i < naxis; i++) {
if (undefined(wcs->csyer[i])) continue;
wcsutil_double2str(keyvalue, "%20.12G", wcs->csyer[i]);
comment[0] = '\0';
if (wcs->cunit[i][0]) sprintf(comment, "[%s] ", wcs->cunit[i]);
strcat(comment, "Systematic error in coordinate");
wcshdo_util(relax, "CSYER", "CSY", WCSHDO_CNAMna, "CSYE", i+1, 0, 0,
alt, colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
}
/* Equatorial coordinate system type. */
if (wcs->radesys[0]) {
sprintf(keyvalue, "'%s'", wcs->radesys);
wcshdo_util(relax, "RADESYS", "RADE", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "Equatorial coordinate system",
nkeyrec, header, &status);
}
/* Equinox of equatorial coordinate system. */
if (!undefined(wcs->equinox)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->equinox);
wcshdo_util(relax, "EQUINOX", "EQUI", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "[yr] Equinox of equatorial coordinates",
nkeyrec, header, &status);
}
/* Reference frame of spectral coordinates. */
if (wcs->specsys[0]) {
sprintf(keyvalue, "'%s'", wcs->specsys);
wcshdo_util(relax, "SPECSYS", "SPEC", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "Reference frame of spectral coordinates",
nkeyrec, header, &status);
}
/* Reference frame of spectral observation. */
if (wcs->ssysobs[0]) {
sprintf(keyvalue, "'%s'", wcs->ssysobs);
wcshdo_util(relax, "SSYSOBS", "SOBS", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "Reference frame of spectral observation",
nkeyrec, header, &status);
}
/* Observer's velocity towards source. */
if (!undefined(wcs->velosys)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->velosys);
wcshdo_util(relax, "VELOSYS", "VSYS", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "[m/s] Velocity towards source",
nkeyrec, header, &status);
}
/* Reference frame of source redshift. */
if (wcs->ssyssrc[0]) {
sprintf(keyvalue, "'%s'", wcs->ssyssrc);
wcshdo_util(relax, "SSYSSRC", "SSRC", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "Reference frame of source redshift",
nkeyrec, header, &status);
}
/* Redshift of the source. */
if (!undefined(wcs->zsource)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->zsource);
wcshdo_util(relax, "ZSOURCE", "ZSOU", 0, 0x0, 0, 0, 0, alt,
colnum, colax, keyvalue, "Redshift of the source",
nkeyrec, header, &status);
}
/* Observatory coordinates. */
for (k = 0; k < 3; k++) {
if (undefined(wcs->obsgeo[k])) continue;
wcsutil_double2str(keyvalue, "%20.12G", wcs->obsgeo[k]);
sprintf(comment, "[m] ITRF observatory %c-coordinate", xyz[k]);
obsgeo[7] = xyz[k];
obsg[4] = xyz[k];
wcshdo_util(relax, obsgeo, obsg, 0, 0x0, 0, 0, 0, ' ',
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
/* MJD of observation. */
if (!undefined(wcs->mjdobs)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->mjdobs);
strcpy(comment, "[d] MJD of observation");
if (wcs->dateobs[0]) {
if (primage || (relax & 1) == 0) {
sprintf(comment+22, " matching DATE-OBS");
} else {
sprintf(comment+22, " matching DOBS%d", col0);
}
}
wcshdo_util(relax, "MJD-OBS", "MJDOB", 0, 0x0, 0, 0, 0, ' ',
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
/* MJD mid-observation time. */
if (!undefined(wcs->mjdavg)) {
wcsutil_double2str(keyvalue, "%20.12G", wcs->mjdavg);
strcpy(comment, "[d] MJD mid-observation");
if (wcs->dateavg[0]) {
if (primage) {
sprintf(comment+23, " matching DATE-AVG");
} else {
sprintf(comment+23, " matching DAVG%d", col0);
}
}
wcshdo_util(relax, "MJD-AVG", "MJDA", 0, 0x0, 0, 0, 0, ' ',
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
/* ISO-8601 date corresponding to MJD-OBS. */
if (wcs->dateobs[0]) {
sprintf(keyvalue, "'%s'", wcs->dateobs);
strcpy(comment, "ISO-8601 observation date");
if (!undefined(wcs->mjdobs)) {
if (primage) {
sprintf(comment+25, " matching MJD-OBS");
} else {
sprintf(comment+25, " matching MJDOB%d", col0);
}
}
if (relax & 1) {
/* Allow DOBSn. */
wcshdo_util(relax, "DATE-OBS", "DOBS", WCSHDO_DOBSn, 0x0, 0, 0, 0,
' ', colnum, colax, keyvalue, comment, nkeyrec, header, &status);
} else {
/* Force DATE-OBS. */
wcshdo_util(relax, "DATE-OBS", 0x0, 0, 0x0, 0, 0, 0, ' ', 0,
0x0, keyvalue, comment, nkeyrec, header, &status);
}
}
/* ISO-8601 date corresponding to MJD-OBS. */
if (wcs->dateavg[0]) {
sprintf(keyvalue, "'%s'", wcs->dateavg);
strcpy(comment, "ISO-8601 mid-observation date");
if (!undefined(wcs->mjdavg)) {
if (primage) {
sprintf(comment+29, " matching MJD-AVG");
} else {
sprintf(comment+29, " matching MJDA%d", col0);
}
}
wcshdo_util(relax, "DATE-AVG", "DAVG", 0, 0x0, 0, 0, 0, ' ',
colnum, colax, keyvalue, comment, nkeyrec, header, &status);
}
if (status == WCSHDRERR_MEMORY) {
wcserr_set(WCSHDR_ERRMSG(status));
}
return status;
}
int celfix(struct wcsprm *wcs)
{
static const char *function = "celfix";
int k, status;
struct celprm *wcscel = &(wcs->cel);
struct prjprm *wcsprj = &(wcscel->prj);
struct wcserr **err;
if (wcs == 0x0) return FIXERR_NULL_POINTER;
err = &(wcs->err);
/* Initialize if required. */
if (wcs->flag != WCSSET) {
if ((status = wcsset(wcs))) return status;
}
/* Was an NCP or GLS projection code translated? */
if (wcs->lat >= 0) {
/* Check ctype. */
if (strcmp(wcs->ctype[wcs->lat]+5, "NCP") == 0) {
strcpy(wcs->ctype[wcs->lng]+5, "SIN");
strcpy(wcs->ctype[wcs->lat]+5, "SIN");
if (wcs->npvmax < wcs->npv + 2) {
/* Allocate space for two more PVi_ja keyvalues. */
if (wcs->m_flag == WCSSET && wcs->pv == wcs->m_pv) {
if (!(wcs->pv = calloc(wcs->npv+2, sizeof(struct pvcard)))) {
wcs->pv = wcs->m_pv;
return wcserr_set(WCSFIX_ERRMSG(FIXERR_MEMORY));
}
wcs->npvmax = wcs->npv + 2;
wcs->m_flag = WCSSET;
for (k = 0; k < wcs->npv; k++) {
wcs->pv[k] = wcs->m_pv[k];
}
if (wcs->m_pv) free(wcs->m_pv);
wcs->m_pv = wcs->pv;
} else {
return wcserr_set(WCSFIX_ERRMSG(FIXERR_MEMORY));
}
}
wcs->pv[wcs->npv].i = wcs->lat + 1;
wcs->pv[wcs->npv].m = 1;
wcs->pv[wcs->npv].value = wcsprj->pv[1];
(wcs->npv)++;
wcs->pv[wcs->npv].i = wcs->lat + 1;
wcs->pv[wcs->npv].m = 2;
wcs->pv[wcs->npv].value = wcsprj->pv[2];
(wcs->npv)++;
return FIXERR_SUCCESS;
} else if (strcmp(wcs->ctype[wcs->lat]+5, "GLS") == 0) {
strcpy(wcs->ctype[wcs->lng]+5, "SFL");
strcpy(wcs->ctype[wcs->lat]+5, "SFL");
if (wcs->crval[wcs->lng] != 0.0 || wcs->crval[wcs->lat] != 0.0) {
/* In the AIPS convention, setting the reference longitude and
* latitude for GLS does not create an oblique graticule. A non-zero
* reference longitude introduces an offset in longitude in the normal
* way, whereas a non-zero reference latitude simply translates the
* reference point (i.e. the map as a whole) to that latitude. This
* might be effected by adjusting CRPIXja but that is complicated by
* the linear transformation and instead is accomplished here by
* setting theta_0. */
if (wcs->npvmax < wcs->npv + 2) {
/* Allocate space for three more PVi_ja keyvalues. */
if (wcs->m_flag == WCSSET && wcs->pv == wcs->m_pv) {
if (!(wcs->pv = calloc(wcs->npv+3, sizeof(struct pvcard)))) {
wcs->pv = wcs->m_pv;
return wcserr_set(WCSFIX_ERRMSG(FIXERR_MEMORY));
}
wcs->npvmax = wcs->npv + 3;
wcs->m_flag = WCSSET;
for (k = 0; k < wcs->npv; k++) {
wcs->pv[k] = wcs->m_pv[k];
}
if (wcs->m_pv) free(wcs->m_pv);
wcs->m_pv = wcs->pv;
} else {
return wcserr_set(WCSFIX_ERRMSG(FIXERR_MEMORY));
}
}
wcs->pv[wcs->npv].i = wcs->lng + 1;
wcs->pv[wcs->npv].m = 0;
wcs->pv[wcs->npv].value = 1.0;
(wcs->npv)++;
/* Note that the reference longitude is still zero. */
wcs->pv[wcs->npv].i = wcs->lng + 1;
wcs->pv[wcs->npv].m = 1;
wcs->pv[wcs->npv].value = 0.0;
(wcs->npv)++;
wcs->pv[wcs->npv].i = wcs->lng + 1;
wcs->pv[wcs->npv].m = 2;
wcs->pv[wcs->npv].value = wcs->crval[wcs->lat];
(wcs->npv)++;
}
return FIXERR_SUCCESS;
}
}
return FIXERR_NO_CHANGE;
}
int wcstab(struct wcsprm *wcs)
{
static const char *function = "wcstab";
char (*PSi_0a)[72] = 0x0, (*PSi_1a)[72] = 0x0, (*PSi_2a)[72] = 0x0;
int *PVi_1a = 0x0, *PVi_2a = 0x0, *PVi_3a = 0x0, *tabax, *tabidx = 0x0;
int getcrd, i, ip, itab, itabax, j, jtabax, m, naxis, ntabax, status;
struct wtbarr *wtbp;
struct tabprm *tabp;
struct wcserr **err;
if (wcs == 0x0) return WCSHDRERR_NULL_POINTER;
err = &(wcs->err);
/* Free memory previously allocated by wcstab(). */
if (wcs->flag != -1 && wcs->m_flag == WCSSET) {
if (wcs->wtb == wcs->m_wtb) wcs->wtb = 0x0;
if (wcs->tab == wcs->m_tab) wcs->tab = 0x0;
if (wcs->m_wtb) free(wcs->m_wtb);
if (wcs->m_tab) {
for (j = 0; j < wcs->ntab; j++) {
tabfree(wcs->m_tab + j);
}
free(wcs->m_tab);
}
}
wcs->ntab = 0;
wcs->nwtb = 0;
wcs->wtb = 0x0;
wcs->tab = 0x0;
/* Determine the number of -TAB axes. */
naxis = wcs->naxis;
if (!(tabax = calloc(naxis, sizeof(int)))) {
return wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
}
ntabax = 0;
for (i = 0; i < naxis; i++) {
/* Null fill. */
wcsutil_null_fill(72, wcs->ctype[i]);
if (!strcmp(wcs->ctype[i]+4, "-TAB")) {
tabax[i] = ntabax++;
} else {
tabax[i] = -1;
}
}
if (ntabax == 0) {
/* No lookup tables. */
status = 0;
goto cleanup;
}
/* Collect information from the PSi_ma and PVi_ma keyvalues. */
if (!((PSi_0a = calloc(ntabax, sizeof(char[72]))) &&
(PVi_1a = calloc(ntabax, sizeof(int))) &&
(PVi_2a = calloc(ntabax, sizeof(int))) &&
(PSi_1a = calloc(ntabax, sizeof(char[72]))) &&
(PSi_2a = calloc(ntabax, sizeof(char[72]))) &&
(PVi_3a = calloc(ntabax, sizeof(int))) &&
(tabidx = calloc(ntabax, sizeof(int))))) {
status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
goto cleanup;
}
for (itabax = 0; itabax < ntabax; itabax++) {
/* Remember that calloc() zeroes allocated memory. */
PVi_1a[itabax] = 1;
PVi_2a[itabax] = 1;
PVi_3a[itabax] = 1;
}
for (ip = 0; ip < wcs->nps; ip++) {
itabax = tabax[wcs->ps[ip].i - 1];
if (itabax >= 0) {
switch (wcs->ps[ip].m) {
case 0:
/* EXTNAME. */
strcpy(PSi_0a[itabax], wcs->ps[ip].value);
wcsutil_null_fill(72, PSi_0a[itabax]);
break;
case 1:
/* TTYPEn for coordinate array. */
strcpy(PSi_1a[itabax], wcs->ps[ip].value);
wcsutil_null_fill(72, PSi_1a[itabax]);
break;
case 2:
/* TTYPEn for index vector. */
strcpy(PSi_2a[itabax], wcs->ps[ip].value);
wcsutil_null_fill(72, PSi_2a[itabax]);
break;
}
}
}
for (ip = 0; ip < wcs->npv; ip++) {
itabax = tabax[wcs->pv[ip].i - 1];
if (itabax >= 0) {
switch (wcs->pv[ip].m) {
case 1:
/* EXTVER. */
PVi_1a[itabax] = (int)(wcs->pv[ip].value + 0.5);
break;
case 2:
/* EXTLEVEL. */
PVi_2a[itabax] = (int)(wcs->pv[ip].value + 0.5);
break;
case 3:
/* Table axis number. */
PVi_3a[itabax] = (int)(wcs->pv[ip].value + 0.5);
break;
}
}
}
/* Determine the number of independent tables. */
for (itabax = 0; itabax < ntabax; itabax++) {
/* These have no defaults. */
if (!PSi_0a[itabax][0] || !PSi_1a[itabax][0]) {
status = wcserr_set(WCSERR_SET(WCSHDRERR_BAD_TABULAR_PARAMS),
"Invalid tabular parameters: PSi_0a and PSi_1a must be specified");
goto cleanup;
}
tabidx[itabax] = -1;
for (jtabax = 0; jtabax < i; jtabax++) {
/* EXTNAME, EXTVER, EXTLEVEL, and TTYPEn for the coordinate array */
/* must match for each axis of a multi-dimensional lookup table. */
if (strcmp(PSi_0a[itabax], PSi_0a[jtabax]) == 0 &&
strcmp(PSi_1a[itabax], PSi_1a[jtabax]) == 0 &&
PVi_1a[itabax] == PVi_1a[jtabax] &&
PVi_2a[itabax] == PVi_2a[jtabax]) {
tabidx[itabax] = tabidx[jtabax];
break;
}
}
if (jtabax == itabax) {
tabidx[itabax] = wcs->ntab;
wcs->ntab++;
}
}
if (!(wcs->tab = calloc(wcs->ntab, sizeof(struct tabprm)))) {
status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
goto cleanup;
}
wcs->m_tab = wcs->tab;
/* Table dimensionality; find the largest axis number. */
for (itabax = 0; itabax < ntabax; itabax++) {
tabp = wcs->tab + tabidx[itabax];
/* PVi_3a records the 1-relative table axis number. */
if (PVi_3a[itabax] > tabp->M) {
tabp->M = PVi_3a[itabax];
}
}
for (itab = 0; itab < wcs->ntab; itab++) {
if ((status = tabini(1, wcs->tab[itab].M, 0, wcs->tab + itab))) {
if (status == 3) status = 5;
wcserr_set(WCSHDR_ERRMSG(status));
goto cleanup;
}
}
/* Copy parameters into the tabprm structs. */
for (i = 0; i < naxis; i++) {
if ((itabax = tabax[i]) < 0) {
/* Not a -TAB axis. */
continue;
}
/* PVi_3a records the 1-relative table axis number. */
m = PVi_3a[itabax] - 1;
tabp = wcs->tab + tabidx[itabax];
tabp->map[m] = i;
tabp->crval[m] = wcs->crval[i];
}
/* Check for completeness. */
for (itab = 0; itab < wcs->ntab; itab++) {
for (m = 0; m < wcs->tab[itab].M; m++) {
if (wcs->tab[itab].map[m] < 0) {
status = wcserr_set(WCSERR_SET(WCSHDRERR_BAD_TABULAR_PARAMS),
"Invalid tabular parameters: the axis mapping is undefined");
goto cleanup;
}
}
}
/* Set up for reading the arrays; how many arrays are there? */
for (itabax = 0; itabax < ntabax; itabax++) {
/* Does this -TAB axis have a non-degenerate index array? */
if (PSi_2a[itabax][0]) {
wcs->nwtb++;
}
}
/* Add one coordinate array for each table. */
wcs->nwtb += wcs->ntab;
/* Allocate memory for structs to be returned. */
if (!(wcs->wtb = calloc(wcs->nwtb, sizeof(struct wtbarr)))) {
wcs->nwtb = 0;
status = wcserr_set(WCSHDR_ERRMSG(WCSHDRERR_MEMORY));
goto cleanup;
}
wcs->m_wtb = wcs->wtb;
/* Set pointers for the index and coordinate arrays. */
wtbp = wcs->wtb;
for (itab = 0; itab < wcs->ntab; itab++) {
getcrd = 1;
for (itabax = 0; itabax < ntabax; itabax++) {
if (tabidx[itabax] != itab) continue;
if (getcrd) {
/* Coordinate array. */
wtbp->i = itabax + 1;
wtbp->m = PVi_3a[itabax];
wtbp->kind = 'c';
strcpy(wtbp->extnam, PSi_0a[itabax]);
wtbp->extver = PVi_1a[itabax];
wtbp->extlev = PVi_2a[itabax];
strcpy(wtbp->ttype, PSi_1a[itabax]);
wtbp->row = 1L;
wtbp->ndim = wcs->tab[itab].M + 1;
wtbp->dimlen = wcs->tab[itab].K;
wtbp->arrayp = &(wcs->tab[itab].coord);
/* Signal for tabset() to take this memory. */
wcs->tab[itab].m_coord = (double *)0x1;
wtbp++;
getcrd = 0;
}
if (PSi_2a[itabax][0]) {
/* Index array. */
wtbp->i = itabax + 1;
wtbp->m = PVi_3a[itabax];
wtbp->kind = 'i';
m = wtbp->m - 1;
strcpy(wtbp->extnam, PSi_0a[itabax]);
wtbp->extver = PVi_1a[itabax];
wtbp->extlev = PVi_2a[itabax];
strcpy(wtbp->ttype, PSi_2a[itabax]);
wtbp->row = 1L;
wtbp->ndim = 1;
wtbp->dimlen = wcs->tab[itab].K + m;
wtbp->arrayp = wcs->tab[itab].index + m;
/* Signal for tabset() to take this memory. */
wcs->tab[itab].m_indxs[m] = (double *)0x1;
wtbp++;
}
}
}
status = 0;
cleanup:
if (tabax) free(tabax);
if (tabidx) free(tabidx);
if (PSi_0a) free(PSi_0a);
if (PVi_1a) free(PVi_1a);
if (PVi_2a) free(PVi_2a);
if (PSi_1a) free(PSi_1a);
if (PSi_2a) free(PSi_2a);
if (PVi_3a) free(PVi_3a);
if (status) {
if (wcs->tab) free(wcs->tab);
if (wcs->wtb) free(wcs->wtb);
}
return status;
}
int wcsunitse(
const char have[],
const char want[],
double *scale,
double *offset,
double *power,
struct wcserr **err)
{
static const char *function = "wcsunitse";
int func1, func2, i, status;
double scale1, scale2, units1[WCSUNITS_NTYPE], units2[WCSUNITS_NTYPE];
if ((status = wcsulexe(have, &func1, &scale1, units1, err))) {
return status;
}
if ((status = wcsulexe(want, &func2, &scale2, units2, err))) {
return status;
}
/* Check conformance. */
for (i = 0; i < WCSUNITS_NTYPE; i++) {
if (units1[i] != units2[i]) {
return wcserr_set(WCSERR_SET(UNITSERR_BAD_UNIT_SPEC),
"Mismatched units type '%s': have '%s', want '%s'",
wcsunits_types[i], have, want);
}
}
*scale = 0.0;
*offset = 0.0;
*power = 1.0;
switch (func1) {
case 0:
/* No function. */
if (func2) {
return wcserr_set(WCSERR_SET(UNITSERR_BAD_FUNCS),
"Mismatched unit functions: have '%s' (%s), want '%s' (%s)",
have, wcsunits_funcs[func1], want, wcsunits_funcs[func2]);
}
*scale = scale1 / scale2;
break;
case 1:
/* log(). */
if (func2 == 1) {
/* log(). */
*scale = 1.0;
*offset = log10(scale1 / scale2);
} else if (func2 == 2) {
/* ln(). */
*scale = log(10.0);
*offset = log(scale1 / scale2);
} else {
return wcserr_set(WCSERR_SET(UNITSERR_BAD_FUNCS),
"Mismatched unit functions: have '%s' (%s), want '%s' (%s)",
have, wcsunits_funcs[func1], want, wcsunits_funcs[func2]);
}
break;
case 2:
/* ln(). */
if (func2 == 1) {
/* log(). */
*scale = 1.0 / log(10.0);
*offset = log(scale1 / scale2);
} else if (func2 == 2) {
/* ln(). */
*scale = 1.0;
*offset = log(scale1 / scale2);
} else {
return wcserr_set(WCSERR_SET(UNITSERR_BAD_FUNCS),
"Mismatched unit functions: have '%s' (%s), want '%s' (%s)",
have, wcsunits_funcs[func1], want, wcsunits_funcs[func2]);
}
break;
case 3:
/* exp(). */
if (func2 != 3) {
return wcserr_set(WCSERR_SET(UNITSERR_BAD_FUNCS),
"Mismatched unit functions: have '%s' (%s), want '%s' (%s)",
have, wcsunits_funcs[func1], want, wcsunits_funcs[func2]);
}
*scale = 1.0;
*power = scale1 / scale2;
break;
default:
/* Internal parser error. */
return wcserr_set(WCSERR_SET(UNITSERR_PARSER_ERROR),
"Internal units parser error");
}
return 0;
}
int tabset(struct tabprm *tab)
{
static const char *function = "tabset";
int i, ic, k, *Km, m, M, ne;
double *dcrd, *dmax, *dmin, dPsi, dval, *Psi;
struct wcserr **err;
if (tab == 0x0) return TABERR_NULL_POINTER;
err = &(tab->err);
/* Check the number of tabular coordinate axes. */
if ((M = tab->M) < 1) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: M must be positive, got %d", M);
}
/* Check the axis lengths. */
if (!tab->K) {
return wcserr_set(WCSERR_SET(TABERR_MEMORY),
"Null pointers in tabprm struct");
}
tab->nc = 1;
for (m = 0; m < M; m++) {
if (tab->K[m] < 1) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Each element of K must be positive, "
"got %d", tab->K[m]);
}
/* Number of coordinate vectors in the coordinate array. */
tab->nc *= tab->K[m];
}
/* Check that the map vector is sensible. */
if (!tab->map) {
return wcserr_set(WCSERR_SET(TABERR_MEMORY),
"Null pointers in tabprm struct");
}
for (m = 0; m < M; m++) {
i = tab->map[m];
if (i < 0) {
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Each element of map must be "
"non-negative, got %d", i);
}
}
/* Check memory allocation for the remaining vectors. */
if (!tab->crval || !tab->index || !tab->coord) {
return wcserr_set(WCSERR_SET(TABERR_MEMORY),
"Null pointers in tabprm struct");
}
/* Take memory if signalled to by wcstab(). */
for (m = 0; m < tab->m_M; m++) {
if (tab->m_indxs[m] == (double *)0x1 &&
(tab->m_indxs[m] = tab->index[m])) {
tab->m_flag = TABSET;
}
}
if (tab->m_coord == (double *)0x1 &&
(tab->m_coord = tab->coord)) {
tab->m_flag = TABSET;
}
/* Allocate memory for work vectors. */
if (tab->flag != TABSET || tab->set_M < M) {
/* Free memory that may have been allocated previously. */
if (tab->sense) free(tab->sense);
if (tab->p0) free(tab->p0);
if (tab->delta) free(tab->delta);
if (tab->extrema) free(tab->extrema);
/* Allocate memory for internal arrays. */
if (!(tab->sense = calloc(M, sizeof(int)))) {
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
if (!(tab->p0 = calloc(M, sizeof(int)))) {
free(tab->sense);
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
if (!(tab->delta = calloc(M, sizeof(double)))) {
free(tab->sense);
free(tab->p0);
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
ne = M * tab->nc * 2 / tab->K[0];
if (!(tab->extrema = calloc(ne, sizeof(double)))) {
free(tab->sense);
free(tab->p0);
free(tab->delta);
return wcserr_set(TAB_ERRMSG(TABERR_MEMORY));
}
tab->set_M = M;
}
/* Check that the index vectors are monotonic. */
Km = tab->K;
for (m = 0; m < M; m++, Km++) {
tab->sense[m] = 0;
if (*Km > 1) {
if ((Psi = tab->index[m]) == 0x0) {
/* Default indexing. */
tab->sense[m] = 1;
} else {
for (k = 0; k < *Km-1; k++) {
switch (tab->sense[m]) {
case 0:
if (Psi[k] < Psi[k+1]) {
/* Monotonic increasing. */
tab->sense[m] = 1;
} else if (Psi[k] > Psi[k+1]) {
/* Monotonic decreasing. */
tab->sense[m] = -1;
}
break;
case 1:
if (Psi[k] > Psi[k+1]) {
/* Should be monotonic increasing. */
free(tab->sense);
free(tab->p0);
free(tab->delta);
free(tab->extrema);
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Index vectors are not "
"monotonically increasing");
}
break;
case -1:
if (Psi[k] < Psi[k+1]) {
/* Should be monotonic decreasing. */
free(tab->sense);
free(tab->p0);
free(tab->delta);
free(tab->extrema);
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Index vectors are not "
"monotonically decreasing");
}
break;
}
}
}
if (tab->sense[m] == 0) {
free(tab->sense);
free(tab->p0);
free(tab->delta);
free(tab->extrema);
return wcserr_set(WCSERR_SET(TABERR_BAD_PARAMS),
"Invalid tabular parameters: Index vectors are not monotonic");
}
}
}
/* Find the extremal values of the coordinate elements in each row. */
dcrd = tab->coord;
dmin = tab->extrema;
dmax = tab->extrema + M;
for (ic = 0; ic < tab->nc; ic += tab->K[0]) {
for (m = 0; m < M; m++, dcrd++) {
if (tab->K[0] > 1) {
/* Extrapolate a little before the start of the row. */
Psi = tab->index[0];
if (Psi == 0x0) {
dPsi = 1.0;
} else {
dPsi = Psi[1] - Psi[0];
}
dval = *dcrd;
if (dPsi != 0.0) {
dval -= 0.5 * (*(dcrd+M) - *dcrd)/dPsi;
}
*(dmax+m) = *(dmin+m) = dval;
} else {
*(dmax+m) = *(dmin+m) = *dcrd;
}
}
dcrd -= M;
for (i = 0; i < tab->K[0]; i++) {
for (m = 0; m < M; m++, dcrd++) {
if (*(dmax+m) < *dcrd) *(dmax+m) = *dcrd;
if (*(dmin+m) > *dcrd) *(dmin+m) = *dcrd;
if (tab->K[0] > 1 && i == tab->K[0]-1) {
/* Extrapolate a little beyond the end of the row. */
Psi = tab->index[0];
if (Psi == 0x0) {
dPsi = 1.0;
} else {
dPsi = Psi[i] - Psi[i-1];
}
dval = *dcrd;
if (dPsi != 0.0) {
dval += 0.5 * (*dcrd - *(dcrd-M))/dPsi;
}
if (*(dmax+m) < dval) *(dmax+m) = dval;
if (*(dmin+m) > dval) *(dmin+m) = dval;
}
}
}
dmin += 2*M;
dmax += 2*M;
}
tab->flag = TABSET;
return 0;
}