int spcfix(struct wcsprm *wcs)
{
char ctype[9], specsys[9];
int i, status;
/* Initialize if required. */
if (wcs == 0x0) return FIXERR_NULL_POINTER;
if (wcs->flag != WCSSET) {
if ((status = wcsset(wcs))) return status;
}
if ((i = wcs->spec) < 0) {
/* Look for a linear spectral axis. */
for (i = 0; i < wcs->naxis; i++) {
if (wcs->types[i]/100 == 30) {
break;
}
}
if (i >= wcs->naxis) {
/* No spectral axis. */
return FIXERR_NO_CHANGE;
}
}
/* Translate an AIPS-convention spectral type if present. */
if ((status = spcaips(wcs->ctype[i], wcs->velref, ctype, specsys))) {
return status;
}
strcpy(wcs->ctype[i], ctype);
if (wcs->specsys[1] == '\0') strcpy(wcs->specsys, specsys);
wcsutil_null_fill(72, wcs->ctype[i]);
wcsutil_null_fill(72, wcs->specsys);
return 0;
}
int prjperr_(int *prj, const char prefix[72])
{
char prefix_[72];
strncpy(prefix_, prefix, 72);
wcsutil_null_fill(72, prefix_);
/* This may or may not force the Fortran I/O buffers to be flushed. */
/* If not, try CALL FLUSH(6) before calling PRJPERR in the Fortran code. */
fflush(NULL);
return wcserr_prt(((struct prjprm *)prj)->err, prefix_);
}
int wcsperr_(int *wcs, const char prefix[72])
{
char prefix_[72];
strncpy(prefix_, prefix, 72);
wcsutil_null_fill(72, prefix_);
/* This may or may not force the Fortran I/O buffers to be flushed. */
/* If not, try CALL FLUSH(6) before calling WCSPERR in the Fortran code. */
fflush(NULL);
return wcsperr((struct wcsprm *)wcs, prefix_);
}
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 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 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 spcaips(
const char ctypeA[9],
int velref,
char ctype[9],
char specsys[9])
{
const char *frames[] = {"LSRK", "BARYCENT", "TOPOCENT",
"LSRD", "GEOCENTR", "SOURCE", "GALACTOC"};
char *fcode;
int ivf, status;
/* Make a null-filled copy of ctypeA. */
if (ctype != ctypeA) strncpy(ctype, ctypeA, 8);
ctype[8] = '\0';
wcsutil_null_fill(9, ctype);
*specsys = '\0';
/* Is it a recognized AIPS-convention type? */
status = SPCERR_NO_CHANGE;
if (strncmp(ctype, "FREQ", 4) == 0 ||
strncmp(ctype, "VELO", 4) == 0 ||
strncmp(ctype, "FELO", 4) == 0) {
/* Look for the Doppler frame. */
if (*(fcode = ctype+4)) {
if (strcmp(fcode, "-LSR") == 0) {
strcpy(specsys, "LSRK");
} else if (strcmp(fcode, "-HEL") == 0) {
strcpy(specsys, "BARYCENT");
} else if (strcmp(fcode, "-OBS") == 0) {
strcpy(specsys, "TOPOCENT");
} else {
/* Not a recognized AIPS spectral type. */
return SPCERR_NO_CHANGE;
}
*fcode = '\0';
status = 0;
}
/* VELREF takes precedence if present. */
ivf = velref%256;
if (0 < ivf && ivf <= 7) {
strcpy(specsys, frames[ivf-1]);
status = 0;
} else if (ivf) {
status = SPCERR_BAD_SPEC_PARAMS;
}
if (strcmp(ctype, "VELO") == 0) {
/* Check that we found an AIPS-convention Doppler frame. */
if (*specsys) {
/* 'VELO' in AIPS means radio or optical depending on VELREF. */
ivf = velref/256;
if (ivf == 0) {
strcpy(ctype, "VOPT");
} else if (ivf == 1) {
strcpy(ctype, "VRAD");
} else {
status = SPCERR_BAD_SPEC_PARAMS;
}
}
} else if (strcmp(ctype, "FELO") == 0) {
/* Uniform in frequency but expressed as an optical velocity (strictly
we should also have found an AIPS-convention Doppler frame). */
strcpy(ctype, "VOPT-F2W");
if (status < 0) status = 0;
}
}
return status;
}
int wcsput_(
int *wcs,
const int *what,
const void *value,
const int *i,
const int *j)
{
int i0, j0, k;
const char *cvalp;
const int *ivalp;
const double *dvalp;
struct wcsprm *wcsp;
/* Cast pointers. */
wcsp = (struct wcsprm *)wcs;
cvalp = (const char *)value;
ivalp = (const int *)value;
dvalp = (const double *)value;
/* Convert 1-relative FITS axis numbers to 0-relative C array indices. */
i0 = *i - 1;
j0 = *j - 1;
wcsp->flag = 0;
switch (*what) {
case WCS_FLAG:
wcsp->flag = *ivalp;
break;
case WCS_NAXIS:
wcsp->naxis = *ivalp;
break;
case WCS_CRPIX:
wcsp->crpix[i0] = *dvalp;
break;
case WCS_PC:
k = (i0)*(wcsp->naxis) + (j0);
*(wcsp->pc+k) = *dvalp;
break;
case WCS_CDELT:
wcsp->cdelt[i0] = *dvalp;
break;
case WCS_CRVAL:
wcsp->crval[i0] = *dvalp;
break;
case WCS_CUNIT:
strncpy(wcsp->cunit[i0], cvalp, 72);
wcsutil_null_fill(72, wcsp->cunit[i0]);
break;
case WCS_CTYPE:
strncpy(wcsp->ctype[i0], cvalp, 72);
wcsutil_null_fill(72, wcsp->ctype[i0]);
break;
case WCS_LONPOLE:
wcsp->lonpole = *dvalp;
break;
case WCS_LATPOLE:
wcsp->latpole = *dvalp;
break;
case WCS_RESTFRQ:
wcsp->restfrq = *dvalp;
break;
case WCS_RESTWAV:
wcsp->restwav = *dvalp;
break;
case WCS_NPV:
case WCS_NPVMAX:
return 1;
break;
case WCS_PV:
(wcsp->pv + wcsp->npv)->i = *i;
(wcsp->pv + wcsp->npv)->m = *j;
(wcsp->pv + wcsp->npv)->value = *dvalp;
(wcsp->npv)++;
break;
case WCS_NPS:
case WCS_NPSMAX:
return 1;
break;
case WCS_PS:
(wcsp->ps + wcsp->nps)->i = *i;
(wcsp->ps + wcsp->nps)->m = *j;
strncpy((wcsp->ps + wcsp->nps)->value, cvalp, 72);
wcsutil_null_fill(72, (wcsp->ps + wcsp->nps)->value);
(wcsp->nps)++;
break;
case WCS_CD:
k = (i0)*(wcsp->naxis) + (j0);
*(wcsp->cd+k) = *dvalp;
break;
case WCS_CROTA:
wcsp->crota[i0] = *dvalp;
break;
case WCS_ALTLIN:
wcsp->altlin = *ivalp;
break;
case WCS_VELREF:
wcsp->velref = *ivalp;
break;
case WCS_ALT:
wcsp->alt[0] = cvalp[0];
wcsutil_null_fill(4, wcsp->alt);
break;
case WCS_COLNUM:
wcsp->colnum = *ivalp;
break;
case WCS_COLAX:
wcsp->colax[i0] = *ivalp;
break;
case WCS_CNAME:
strncpy(wcsp->cname[i0], cvalp, 72);
wcsutil_null_fill(72, wcsp->cname[i0]);
break;
case WCS_CRDER:
wcsp->crder[i0] = *dvalp;
break;
case WCS_CSYER:
wcsp->csyer[i0] = *dvalp;
break;
case WCS_DATEAVG:
strncpy(wcsp->dateavg, cvalp, 72);
wcsutil_null_fill(72, wcsp->dateavg);
break;
case WCS_DATEOBS:
strncpy(wcsp->dateobs, cvalp, 72);
wcsutil_null_fill(72, wcsp->dateobs);
break;
case WCS_EQUINOX:
wcsp->equinox = *dvalp;
break;
case WCS_MJDAVG:
wcsp->mjdavg = *dvalp;
break;
case WCS_MJDOBS:
wcsp->mjdobs = *dvalp;
break;
case WCS_OBSGEO:
wcsp->obsgeo[i0] = *dvalp;
break;
case WCS_RADESYS:
strncpy(wcsp->radesys, cvalp, 72);
wcsutil_null_fill(72, wcsp->radesys);
break;
case WCS_SPECSYS:
strncpy(wcsp->specsys, cvalp, 72);
wcsutil_null_fill(72, wcsp->specsys);
break;
case WCS_SSYSOBS:
strncpy(wcsp->ssysobs, cvalp, 72);
wcsutil_null_fill(72, wcsp->ssysobs);
break;
case WCS_VELOSYS:
wcsp->velosys = *dvalp;
break;
case WCS_ZSOURCE:
wcsp->zsource = *dvalp;
break;
case WCS_SSYSSRC:
strncpy(wcsp->ssyssrc, cvalp, 72);
wcsutil_null_fill(72, wcsp->ssyssrc);
break;
case WCS_VELANGL:
wcsp->velangl = *dvalp;
break;
case WCS_WCSNAME:
strncpy(wcsp->wcsname, cvalp, 72);
wcsutil_null_fill(72, wcsp->wcsname);
break;
default:
return 1;
}
return 0;
}
