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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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;
}
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 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;
}
