int wcssptr_(struct wcsprm *wcs, int *i, char ctype[9]) { int status = wcssptr(wcs, i, ctype); wcsutil_blank_fill(9, ctype); return status; }
int wcserr_get_(const int *err, const int *what, void *value) { char *cvalp; int *ivalp; const struct wcserr *errp; /* Cast pointers. */ errp = (const struct wcserr *)err; cvalp = (char *)value; ivalp = (int *)value; switch (*what) { case WCSERR_STATUS: *ivalp = errp->status; break; case WCSERR_LINE_NO: *ivalp = errp->line_no; break; case WCSERR_FUNCTION: strncpy(cvalp, errp->function, 72); wcsutil_blank_fill(72, cvalp); break; case WCSERR_FILE: strncpy(cvalp, errp->file, 72); wcsutil_blank_fill(72, cvalp); break; case WCSERR_MSG: strncpy(cvalp, errp->msg, WCSERR_MSG_LENGTH); wcsutil_blank_fill(WCSERR_MSG_LENGTH, cvalp); break; default: return 1; } 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 wcsget_(const int *wcs, const int *what, void *value) { int i, j, k, naxis; char *cvalp; int *ivalp; double *dvalp; const int *iwcsp; const double *dwcsp; const struct wcsprm *wcsp; /* Cast pointers. */ wcsp = (const struct wcsprm *)wcs; cvalp = (char *)value; ivalp = (int *)value; dvalp = (double *)value; naxis = wcsp->naxis; switch (*what) { case WCS_FLAG: *ivalp = wcsp->flag; break; case WCS_NAXIS: *ivalp = naxis; break; case WCS_CRPIX: for (i = 0; i < naxis; i++) { *(dvalp++) = wcsp->crpix[i]; } break; case WCS_PC: /* C row-major to FORTRAN column-major. */ for (j = 0; j < naxis; j++) { dwcsp = wcsp->pc + j; for (i = 0; i < naxis; i++) { *(dvalp++) = *dwcsp; dwcsp += naxis; } } break; case WCS_CDELT: for (i = 0; i < naxis; i++) { *(dvalp++) = wcsp->cdelt[i]; } break; case WCS_CRVAL: for (i = 0; i < naxis; i++) { *(dvalp++) = wcsp->crval[i]; } break; case WCS_CUNIT: for (i = 0; i < naxis; i++) { strncpy(cvalp, wcsp->cunit[i], 72); wcsutil_blank_fill(72, cvalp); cvalp += 72; } break; case WCS_CTYPE: for (i = 0; i < naxis; i++) { strncpy(cvalp, wcsp->ctype[i], 72); wcsutil_blank_fill(72, cvalp); cvalp += 72; } break; case WCS_LONPOLE: *dvalp = wcsp->lonpole; break; case WCS_LATPOLE: *dvalp = wcsp->latpole; break; case WCS_RESTFRQ: *dvalp = wcsp->restfrq; break; case WCS_RESTWAV: *dvalp = wcsp->restwav; break; case WCS_NPV: *ivalp = wcsp->npv; break; case WCS_NPVMAX: *ivalp = wcsp->npvmax; break; case WCS_PV: for (k = 0; k < wcsp->npv; k++) { *(dvalp++) = (wcsp->pv + k)->i; *(dvalp++) = (wcsp->pv + k)->m; *(dvalp++) = (wcsp->pv + k)->value; } break; case WCS_NPS: *ivalp = wcsp->nps; break; case WCS_NPSMAX: *ivalp = wcsp->npsmax; break; case WCS_PS: for (k = 0; k < wcsp->nps; k++) { *(dvalp++) = (wcsp->ps + k)->i; *(dvalp++) = (wcsp->ps + k)->m; cvalp += 2*sizeof(double); strncpy(cvalp, (wcsp->ps + k)->value, 72); wcsutil_blank_fill(72, cvalp); cvalp += 72; } break; case WCS_CD: /* C row-major to FORTRAN column-major. */ for (j = 0; j < naxis; j++) { dwcsp = wcsp->cd + j; for (i = 0; i < naxis; i++) { *(dvalp++) = *dwcsp; dwcsp += naxis; } } break; case WCS_CROTA: for (i = 0; i < naxis; i++) { *(dvalp++) = wcsp->crota[i]; } break; case WCS_ALTLIN: *ivalp = wcsp->altlin; break; case WCS_VELREF: *ivalp = wcsp->velref; break; case WCS_ALT: strncpy(cvalp, wcsp->alt, 4); wcsutil_blank_fill(4, cvalp); break; case WCS_COLNUM: *ivalp = wcsp->colnum; break; case WCS_COLAX: for (i = 0; i < naxis; i++) { *(ivalp++) = wcsp->colax[i]; } break; case WCS_CNAME: for (i = 0; i < naxis; i++) { strncpy(cvalp, wcsp->cname[i], 72); wcsutil_blank_fill(72, cvalp); cvalp += 72; } break; case WCS_CRDER: for (i = 0; i < naxis; i++) { *(dvalp++) = wcsp->crder[i]; } break; case WCS_CSYER: for (i = 0; i < naxis; i++) { *(dvalp++) = wcsp->csyer[i]; } break; case WCS_DATEAVG: strncpy(cvalp, wcsp->dateavg, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_DATEOBS: strncpy(cvalp, wcsp->dateobs, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_EQUINOX: *dvalp = wcsp->equinox; break; case WCS_MJDAVG: *dvalp = wcsp->mjdavg; break; case WCS_MJDOBS: *dvalp = wcsp->mjdobs; break; case WCS_OBSGEO: for (i = 0; i < 3; i++) { *(dvalp++) = wcsp->obsgeo[i]; } break; case WCS_RADESYS: strncpy(cvalp, wcsp->radesys, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_SPECSYS: strncpy(cvalp, wcsp->specsys, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_SSYSOBS: strncpy(cvalp, wcsp->ssysobs, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_VELOSYS: *dvalp = wcsp->velosys; break; case WCS_ZSOURCE: *dvalp = wcsp->zsource; break; case WCS_SSYSSRC: strncpy(cvalp, wcsp->ssyssrc, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_VELANGL: *dvalp = wcsp->velangl; break; case WCS_WCSNAME: strncpy(cvalp, wcsp->wcsname, 72); wcsutil_blank_fill(72, cvalp); break; case WCS_NTAB: *ivalp = wcsp->ntab; break; case WCS_NWTB: *ivalp = wcsp->nwtb; break; case WCS_TAB: *(void **)value = wcsp->tab; break; case WCS_WTB: *(void **)value = wcsp->wtb; break; case WCS_LNGTYP: strncpy(cvalp, wcsp->lngtyp, 4); wcsutil_blank_fill(4, cvalp); break; case WCS_LATTYP: strncpy(cvalp, wcsp->lattyp, 4); wcsutil_blank_fill(4, cvalp); break; case WCS_LNG: *ivalp = wcsp->lng + 1; break; case WCS_LAT: *ivalp = wcsp->lat + 1; break; case WCS_SPEC: *ivalp = wcsp->spec + 1; break; case WCS_CUBEFACE: *ivalp = wcsp->cubeface; break; case WCS_TYPES: for (i = 0; i < naxis; i++) { *(ivalp++) = wcsp->types[i]; } break; case WCS_LIN: /* Copy the contents of the linprm struct. */ iwcsp = (int *)(&(wcsp->lin)); for (k = 0; k < LINLEN; k++) { *(ivalp++) = *(iwcsp++); } break; case WCS_CEL: /* Copy the contents of the celprm struct. */ iwcsp = (int *)(&(wcsp->cel)); for (k = 0; k < CELLEN; k++) { *(ivalp++) = *(iwcsp++); } break; case WCS_SPC: /* Copy the contents of the spcprm struct. */ iwcsp = (int *)(&(wcsp->spc)); for (k = 0; k < SPCLEN; k++) { *(ivalp++) = *(iwcsp++); } break; case WCS_ERR: /* Copy the contents of the wcserr struct. */ if (wcsp->err) { iwcsp = (int *)(wcsp->err); for (k = 0; k < ERRLEN; k++) { *(ivalp++) = *(iwcsp++); } } else { for (k = 0; k < ERRLEN; k++) { *(ivalp++) = 0; } } break; default: return 1; } return 0; }
void wcslib_version_(char *wcsver, int nchr) { strncpy(wcsver, wcslib_version(0x0), nchr); wcsutil_blank_fill(nchr, wcsver); }