void he_write_healpix_map(float **tmap,int nfields,long nside,char *fname)
{
fitsfile *fptr;
int ii,status=0;
char *ttype[]={"T","Q","U"};
char *tform[]={"1E","1E","1E"};
char *tunit[]={"mK","mK","mK"};
if((nfields!=1)&&(nfields!=3)) {
fprintf(stderr,"CRIME: nfields must be 1 or 3\n");
exit(1);
}
fits_create_file(&fptr,fname,&status);
fits_create_tbl(fptr,BINARY_TBL,0,nfields,ttype,tform,
tunit,"BINTABLE",&status);
fits_write_key(fptr,TSTRING,"PIXTYPE","HEALPIX","HEALPIX Pixelisation",
&status);
fits_write_key(fptr,TSTRING,"ORDERING","RING",
"Pixel ordering scheme, either RING or NESTED",&status);
fits_write_key(fptr,TLONG,"NSIDE",&nside,
"Resolution parameter for HEALPIX",&status);
fits_write_key(fptr,TSTRING,"COORDSYS","G",
"Pixelisation coordinate system",&status);
fits_write_comment(fptr,
"G = Galactic, E = ecliptic, C = celestial = equatorial",
&status);
for(ii=0;ii<nfields;ii++) {
fits_write_col(fptr,TFLOAT,ii+1,1,1,nside2npix(nside),tmap[ii],&status);
}
fits_close_file(fptr, &status);
}
int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode)
{ int i, r, ib;
char buf[200];
long l;
if (NULL == ngph) return(NGP_NUL_PTR);
if (NULL == ffp) return(NGP_NUL_PTR);
r = NGP_OK;
for (i=0; i<ngph->tokcnt; i++)
{ if ((NGP_REALLY_ALL & mode) || (NGP_OK == ngp_keyword_is_write(&(ngph->tok[i]))))
{ switch (ngph->tok[i].type)
{ case NGP_TTYPE_BOOL:
ib = ngph->tok[i].value.b;
fits_write_key(ffp, TLOGICAL, ngph->tok[i].name, &ib, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_STRING:
fits_write_key_longstr(ffp, ngph->tok[i].name, ngph->tok[i].value.s, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_INT:
l = ngph->tok[i].value.i; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */
fits_write_key(ffp, TLONG, ngph->tok[i].name, &l, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_REAL:
fits_write_key(ffp, TDOUBLE, ngph->tok[i].name, &(ngph->tok[i].value.d), ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_COMPLEX:
fits_write_key(ffp, TDBLCOMPLEX, ngph->tok[i].name, &(ngph->tok[i].value.c), ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_NULL:
fits_write_key_null(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_RAW:
if (0 == strcmp("HISTORY", ngph->tok[i].name))
{ fits_write_history(ffp, ngph->tok[i].comment, &r);
break;
}
if (0 == strcmp("COMMENT", ngph->tok[i].name))
{ fits_write_comment(ffp, ngph->tok[i].comment, &r);
break;
}
sprintf(buf, "%-8.8s%s", ngph->tok[i].name, ngph->tok[i].comment);
fits_write_record(ffp, buf, &r);
break;
}
if (r) return(r);
}
}
fits_set_hdustruc(ffp, &r); /* resync cfitsio */
return(r);
}
void write_fits(fitsfile* fptr, int datatype, size_t width, size_t height,
size_t num, void** images, const char* names[], int* status)
{
// total number of pixels
long npix = width*height;
// dimensions
int naxis = 2;
long naxes[2] = { width, height };
// writing offset
long fpixel[2] = { 1, 1 };
// write primary HDU
fits_create_img(fptr, SHORT_IMG, 0, NULL, status);
// record file origin
fits_write_key(fptr, TSTRING, "ORIGIN", "Lensed " LENSED_VERSION, "FITS file originator", status);
fits_write_comment(fptr, "for more information, see http://glenco.github.io/lensed/", status);
// record the date of FITS creation
fits_write_date(fptr, status);
// write images
for(size_t n = 0; n < num; ++n)
{
// create image extension
fits_create_img(fptr, FLOAT_IMG, naxis, naxes, status);
// write pixels
fits_write_pix(fptr, datatype, fpixel, npix, images[n], status);
// give extension name
if(names && names[n])
fits_write_key(fptr, TSTRING, "EXTNAME", (void*)names[n], "extension name", status);
}
}
int addkey(char *outfile, char *keyword, char *keyvalue)
{
fitsfile *fptr; /* FITS file pointer, defined in fitsio.h */
char card[FLEN_CARD], newcard[FLEN_CARD], temp[FLEN_CARD];
char oldvalue[FLEN_VALUE], comment[FLEN_COMMENT];
int status = 0; /* CFITSIO status value MUST be initialized to zero! */
int keytype, i;
if (!fits_open_file(&fptr, outfile, READWRITE, &status))
{
#ifdef DEBUG
if (fits_read_card(fptr, keyword, card, &status))
{
printf("Keyword does not exist\n");
card[0] = '\0';
comment[0] = '\0';
status = 0; /* reset status after error */
}
else
{
strcpy (temp, keyword);
for (i=0; i<FLEN_CARD; i++)
temp[i]=toupper(temp[i]);
if ( strcmp("COMMENT", temp) && strcmp("HISTORY", temp) )
printf("%s\n",card);
}
#endif
/* check if this is a protected keyword that must not be changed */
if (*card && fits_get_keyclass(card) == TYP_STRUC_KEY)
{
#ifdef DEBUG
printf("Protected keyword cannot be modified.\n");
#endif
}
else
{
strcpy (temp, keyword);
for (i=0; i<FLEN_CARD; i++)
temp[i]=toupper(temp[i]);
if ( !strcmp ("COMMENT", temp) )
{ fits_write_comment ( fptr, keyvalue, &status );
#ifdef DEBUG
printf ("New comment added.\n");
#endif
}
else if ( !strcmp ("HISTORY", temp) )
{ fits_write_history ( fptr, keyvalue, &status );
#ifdef DEBUG
printf ("New history added.\n");
#endif
}
else
{
/* get the comment string */
if (*card)fits_parse_value(card, oldvalue, comment, &status);
/* construct template for new keyword */
strcpy(newcard, keyword); /* copy keyword name */
strcat(newcard, " = "); /* '=' value delimiter */
strcat(newcard, keyvalue); /* new value */
if (*comment) {
strcat(newcard, " / "); /* comment delimiter */
strcat(newcard, comment); /* append the comment */
}
/* reformat the keyword string to conform to FITS rules */
fits_parse_template(newcard, card, &keytype, &status);
/* overwrite the keyword with the new value */
fits_update_card(fptr, keyword, card, &status);
#ifdef DEBUG
printf("Keyword has been changed to:\n");
printf("%s\n",card);
#endif
}
}
fits_close_file(fptr, &status);
} /* open_file */
/* if error occured, print out error message */
if (status) fits_report_error(stderr, status);
return(status);
}
int HPXhdr(fitsfile *fptr, struct healpix *hpxdat)
{
char comment[64], cval[16], *ctype1, *ctype2, *descr1, *descr2, *pcode;
int status;
float cos45, crpix1, crpix2, crval1, crval2, lonpole;
double cdelt1, cdelt2;
status = 0;
fits_update_key_log(fptr, "EXTEND", 0,
"No FITS extensions are present", &status);
fits_write_date(fptr, &status);
/* Set pixel transformation parameters. */
if (hpxdat->layout == 0) {
crpix1 = (5 * hpxdat->nside + 1) / 2.0f;
} else {
crpix1 = (4 * hpxdat->nside + 1) / 2.0f;
}
crpix2 = crpix1;
fits_write_key(fptr, TFLOAT, "CRPIX1", &crpix1,
"Coordinate reference pixel", &status);
fits_write_key(fptr, TFLOAT, "CRPIX2", &crpix2,
"Coordinate reference pixel", &status);
cos45 = (float)sqrt(2.0) / 2.0f;
if (hpxdat->layout == 0) {
fits_write_key_flt(fptr, "PC1_1", cos45, -8,
"Transformation matrix element", &status);
fits_write_key_flt(fptr, "PC1_2", cos45, -8,
"Transformation matrix element", &status);
fits_write_key_flt(fptr, "PC2_1", -cos45, -8,
"Transformation matrix element", &status);
fits_write_key_flt(fptr, "PC2_2", cos45, -8,
"Transformation matrix element", &status);
}
cdelt1 = -90.0 / hpxdat->nside / sqrt(2.0);
cdelt2 = -cdelt1;
fits_write_key_dbl(fptr, "CDELT1", cdelt1, -8,
"[deg] Coordinate increment", &status);
fits_write_key_dbl(fptr, "CDELT2", cdelt2, -8,
"[deg] Coordinate increment", &status);
/* Celestial transformation parameters. */
if (hpxdat->layout == 0) {
pcode = "HPX";
} else {
pcode = "XPH";
}
if (hpxdat->crdsys == 'G') {
/* Galactic. */
ctype1 = "GLON";
ctype2 = "GLAT";
descr1 = "Galactic longitude";
descr2 = "Galactic latitude";
} else if (hpxdat->crdsys == 'E') {
/* Ecliptic, who-knows-what. */
ctype1 = "ELON";
ctype2 = "ELAT";
descr1 = "Ecliptic longitude";
descr2 = "Ecliptic latitude";
} else if (hpxdat->crdsys == 'Q') {
/* Equatorial, who-knows-what. */
ctype1 = "RA--";
ctype2 = "DEC-";
descr1 = "Right ascension";
descr2 = "Declination";
} else {
/* Unknown. */
ctype1 = "XLON";
ctype2 = "XLAT";
descr1 = "Longitude";
descr2 = " Latitude";
}
sprintf(cval, "%s-%s", ctype1, pcode);
sprintf(comment, "%s in an %s projection", descr1, pcode);
fits_write_key_str(fptr, "CTYPE1", cval, comment, &status);
sprintf(cval, "%s-%s", ctype2, pcode);
sprintf(comment, "%s in an %s projection", descr2, pcode);
fits_write_key_str(fptr, "CTYPE2", cval, comment, &status);
crval1 = 0.0f + 90.0f * hpxdat->quad;
if (hpxdat->layout == 0) {
crval2 = 0.0f;
} else if (hpxdat->layout == 1) {
crval1 += 180.0f;
crval2 = 90.0f;
} else {
crval1 += 180.0f;
crval2 = -90.0f;
}
if (360.0f < crval1) crval1 -= 360.0f;
sprintf(comment, "[deg] %s at the reference point", descr1);
fits_write_key(fptr, TFLOAT, "CRVAL1", &crval1, comment, &status);
sprintf(comment, "[deg] %s at the reference point", descr2);
fits_write_key(fptr, TFLOAT, "CRVAL2", &crval2, comment, &status);
if (hpxdat->layout) {
lonpole = 180.0f;
sprintf(comment, "[deg] Native longitude of the celestial pole");
fits_write_key(fptr, TFLOAT, "LONPOLE", &lonpole, comment, &status);
}
if (hpxdat->layout == 0) {
fits_write_key_lng(fptr, "PV2_1", (LONGLONG)4,
"HPX H parameter (longitude)", &status);
fits_write_key_lng(fptr, "PV2_2", (LONGLONG)3,
"HPX K parameter (latitude)", &status);
}
/* Commentary. */
fits_write_record(fptr, " ", &status);
if (hpxdat->layout == 0) {
fits_write_comment(fptr,
"Celestial map with FITS-standard HPX coordinate system generated by",
&status);
} else {
fits_write_comment(fptr,
"Celestial map with XPH coordinate system (polar HPX) generated by",
&status);
}
fits_write_comment(fptr,
"'HPXcvt' which reorganises HEALPix data without interpolation as",
&status);
fits_write_comment(fptr,
"described in \"Mapping on the HEALPix grid\" by Mark Calabretta and",
&status);
fits_write_comment(fptr,
"Boud Roukema. See http://www.atnf.csiro.au/people/Mark.Calabretta",
&status);
return status;
}
void objects_head (struct fitpars *fpar, fitsfile *fptr, int offx, int offy)
{
char par[FLEN_CARD], skyc[FLEN_CARD], comp[FLEN_KEYWORD],
key[FLEN_KEYWORD];
float parval;
extern float xskycent, yskycent;
int status = 0, i, j;
j = 1;
while (fpar != NULL) {
sprintf (comp, "COMP_%i", j);
fits_update_key(fptr, TSTRING, comp, fpar->objtype,
"Object type", &status);
for (i=1; i<= 10; i++) {
if (i==1 && strncmp(fpar->objtype, "sky", 3) != 0)
parval = fpar->a[i] + offx;
else if (i==2 && strncmp(fpar->objtype, "sky", 3) != 0)
parval = fpar->a[2] + offy;
else
parval = fpar->a[i];
sprintf (par, "%-.4f +/- %-.4f", parval, fpar->sig[i]);
if (strncmp(fpar->objtype, "sky", 3) != 0) {
if (i==1) {
sprintf (key, "%i_XCENT", j);
fits_update_key(fptr, TSTRING, key, par, "X center [pixel]",
&status);
};
if (i==2) {
sprintf (key, "%i_YCENT", j);
fits_update_key(fptr, TSTRING, key, par, "Y center [pixel]",
&status);
};
/*******\
* Nuker *
\*******/
if (strncmp(fpar->objtype, "nuker", 5) == 0) {
if (i==3) {
sprintf (key, "%i_MU", j);
fits_update_key(fptr, TSTRING, key, par,
"Surface brightness at Rb", &status);
};
if (i==4) {
sprintf (key, "%i_Rb", j);
fits_update_key(fptr, TSTRING, key, par,
"Break radius Rb [pixels]", &status);
};
if (i==5) {
sprintf (key, "%i_alpha", j);
fits_update_key(fptr, TSTRING, key, par,
"alpha", &status);
};
if (i==6) {
sprintf (key, "%i_beta", j);
fits_update_key(fptr, TSTRING, key, par,
"beta", &status);
};
if (i==7) {
sprintf (key, "%i_gamma", j);
fits_update_key(fptr, TSTRING, key, par,
"gamma", &status);
};
};
/**************************\
* Sersic and deVaucouleurs *
\**************************/
if (strncmp(fpar->objtype, "sersic", 6) == 0 ||
strncmp(fpar->objtype, "devauc", 6) == 0) {
if (i==3) {
sprintf (key, "%i_MAG", j);
fits_update_key(fptr, TSTRING, key, par,
"Total magnitude", &status);
};
if (i==4) {
sprintf (key, "%i_Re", j);
fits_update_key(fptr, TSTRING, key, par,
"Effective radius Re [pixels]", &status);
};
if (i==5 && strncmp(fpar->objtype, "sersic", 6) == 0) {
sprintf (key, "%i_n", j);
fits_update_key(fptr, TSTRING, key, par,
"Sersic index", &status);
};
};
/******************\
* Exponential Disk *
\******************/
if (strncmp(fpar->objtype, "expdisk", 7) == 0) {
if (i==3) {
sprintf (key, "%i_MAG", j);
fits_update_key(fptr, TSTRING, key, par,
"Total magnitude", &status);
};
if (i==4) {
sprintf (key, "%i_Rs", j);
fits_update_key(fptr, TSTRING, key, par,
"Scalelength [pixels]", &status);
};
};
/*********************\
* Gaussian and Moffat *
\*********************/
if (strncmp(fpar->objtype, "gauss", 5) == 0 ||
strncmp(fpar->objtype, "moffat", 6) == 0 ||
strncmp(fpar->objtype, "psf", 3) == 0 ) {
if (i==3) {
sprintf (key, "%i_MAG", j);
fits_update_key(fptr, TSTRING, key, par,
"Total magnitude", &status);
};
if (i==4 && strncmp(fpar->objtype, "psf", 3) != 0) {
sprintf (key, "%i_FWHM", j);
fits_update_key(fptr, TSTRING, key, par,
"FWHM [pixels]", &status);
};
if (i==5 && strncmp(fpar->objtype, "moffat", 6) == 0) {
sprintf (key, "%i_C", j);
fits_update_key(fptr, TSTRING, key, par,
"Powerlaw", &status);
};
};
/*******************\
* Common parameters *
\*******************/
if (i==8 && strncmp(fpar->objtype, "psf", 3) != 0) {
sprintf (key, "%i_AR", j);
fits_update_key(fptr, TSTRING, key, par,
"Axis ratio (b/a)", &status);
};
if (i==9 && strncmp(fpar->objtype, "psf", 3) != 0) {
sprintf (key, "%i_PA", j);
fits_update_key(fptr, TSTRING, key, par,
"Position Angle (PA) [Degrees: Up=0, Left=90]", &status);
};
if (i==10 && strncmp(fpar->objtype, "psf", 3) != 0) {
sprintf (key, "%i_C", j);
fits_update_key(fptr, TSTRING, key, par,
"Diskiness (<0) or Boxiness (>0)", &status);
};
};
/*****\
* Sky *
\*****/
if (strncmp(fpar->objtype, "sky", 3) == 0) {
if (i==1) {
sprintf (skyc, "%-.4f", xskycent + offx);
sprintf (key, "%i_XCENT", j);
fits_update_key(fptr, TSTRING, key, skyc, "X center [pixel]",
&status);
sprintf (skyc, "%-.4f", yskycent + offy);
sprintf (key, "%i_YCENT", j);
fits_update_key(fptr, TSTRING, key, skyc, "Y center [pixel]",
&status);
sprintf (key, "%i_SKY", j);
fits_update_key(fptr, TSTRING, key, par, "Sky background [ADUs]",
&status);
};
if (i==2) {
sprintf (key, "%i_DSKYDX", j);
fits_update_key(fptr, TSTRING, key, par, "x sky gradient [ADUs]",
&status);
};
if (i==3) {
sprintf (key, "%i_DSKYDY", j);
fits_update_key(fptr, TSTRING, key, par, "y sky gradient [ADUs]",
&status);
};
};
};
fits_write_comment (fptr, "------------------------", &status);
fpar = fpar->next;
j++;
};
}
void writeheader (struct image *img, struct fitpars *fpar, double chisq,
int ndof, int hdu, int offx, int offy)
{
void objects_head (struct fitpars *fpar, fitsfile *fptr,
int offx, int offy);
extern struct inpars input;
char param[FLEN_CARD];
fitsfile *fptr;
int status = 0;
float chi2nu;
if (fits_open_file (&fptr, img->name, READWRITE, &status)) {
pfunc ("\n Can't append to image header %s!\n", img->name);
printerror( status );
};
if (fits_movabs_hdu (fptr, hdu, IMAGE_HDU, &status)) {
pfunc ("\n Can't append to image header %s!\n", img->name);
printerror( status );
};
fits_write_comment (fptr, " ", &status);
fits_write_comment (fptr, "========== GALFIT Input Parameters ==========", &status);
fits_write_comment (fptr, "", &status);
fits_update_key(fptr, TSTRING, "INITFILE", input.initparfile,
"GALFIT input file", &status);
fits_update_key(fptr, TSTRING, "DATAIN", input.data,
"Input data image", &status);
fits_update_key(fptr, TSTRING, "SIGMA", input.sigma,
"Input sigma image", &status);
fits_update_key(fptr, TSTRING, "PSF", input.psf,
"Convolution PSF", &status);
fits_update_key(fptr, TSTRING, "CONSTRNT", input.constraints,
"Parameter constraint file", &status);
fits_update_key(fptr, TSTRING, "MASK", input.badpix,
"Input mask image", &status);
fits_update_key(fptr, TSTRING, "FITSECT", input.imgsect,
"Image section fitted", &status);
sprintf (param, "%-.2f, %-.2f", input.cboxcent[1], input.cboxcent[2]);
fits_update_key(fptr, TSTRING, "CBOXCENT", param,
"Convolution box center", &status);
sprintf (param, "%i, %i", input.convbox[1], input.convbox[2]);
fits_update_key(fptr, TSTRING, "CONVBOX", param,
"Convolution box size", &status);
fits_update_key(fptr, TFLOAT, "MAGZPT", &input.magzpt,
"Magnitude zeropoint", &status);
fits_write_comment (fptr, "========== GALFIT Final Parameters ==========", &status);
objects_head (fpar, fptr, offx, offy);
fits_update_key(fptr, TDOUBLE, "Chisq", &chisq,
"Chi^2 of fit", &status);
fits_update_key(fptr, TINT, "NDOF", &ndof,
"Degrees of Freedom", &status);
chi2nu = chisq/ndof;
fits_update_key(fptr, TFLOAT, "Chi2nu", &chi2nu,
"Reduced Chi^2", &status);
fits_write_comment (fptr, "=============================================", &status);
fits_write_comment (fptr, " ", &status);
fits_close_file(fptr, &status); /* close the file */
return;
}
int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode)
{ int i, r, ib;
char buf[200];
long l;
if (NULL == ngph) return(NGP_NUL_PTR);
if (NULL == ffp) return(NGP_NUL_PTR);
r = NGP_OK;
for (i=0; i<ngph->tokcnt; i++)
{ r = ngp_keyword_is_write(&(ngph->tok[i]));
if ((NGP_REALLY_ALL & mode) || (NGP_OK == r))
{ switch (ngph->tok[i].type)
{ case NGP_TTYPE_BOOL:
ib = ngph->tok[i].value.b;
fits_write_key(ffp, TLOGICAL, ngph->tok[i].name, &ib, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_STRING:
fits_write_key_longstr(ffp, ngph->tok[i].name, ngph->tok[i].value.s, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_INT:
l = ngph->tok[i].value.i; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */
fits_write_key(ffp, TLONG, ngph->tok[i].name, &l, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_REAL:
fits_write_key(ffp, TDOUBLE, ngph->tok[i].name, &(ngph->tok[i].value.d), ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_COMPLEX:
fits_write_key(ffp, TDBLCOMPLEX, ngph->tok[i].name, &(ngph->tok[i].value.c), ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_NULL:
fits_write_key_null(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r);
break;
case NGP_TTYPE_RAW:
if (0 == strcmp("HISTORY", ngph->tok[i].name))
{ fits_write_history(ffp, ngph->tok[i].comment, &r);
break;
}
if (0 == strcmp("COMMENT", ngph->tok[i].name))
{ fits_write_comment(ffp, ngph->tok[i].comment, &r);
break;
}
sprintf(buf, "%-8.8s%s", ngph->tok[i].name, ngph->tok[i].comment);
fits_write_record(ffp, buf, &r);
break;
}
}
else if (NGP_BAD_ARG == r) /* enhancement 10 dec 2003, James Peachey: template comments replace defaults */
{ r = NGP_OK; /* update comments of special keywords like TFORM */
if (ngph->tok[i].comment && *ngph->tok[i].comment) /* do not update with a blank comment */
{ fits_modify_comment(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r);
}
}
else /* other problem, typically a blank token */
{ r = NGP_OK; /* skip this token, but continue */
}
if (r) return(r);
}
fits_set_hdustruc(ffp, &r); /* resync cfitsio */
return(r);
}
int hpic_fits_vecindx_write(char *filename, char *creator, char *extname,
char *comment, hpic_vec_int * indx,
hpic_vec_fltarr * vecs, char **vecnames,
char **vecunits, hpic_keys * keys)
{
size_t i, j, k, m;
fitsfile *fp;
int ret = 0;
int bitpix = SHORT_IMG;
int nax = 0;
long axes[] = { 0, 0 };
int total;
int type;
long rows;
long frow = 1;
long fsamp = 1;
size_t veclen;
char **vectypes;
char **names;
char **units;
size_t nvecs = hpic_vec_fltarr_n_get(vecs);
hpic_vec_float *tempvec;
if (nvecs == 0) {
HPIC_ERROR(HPIC_ERR_FITS, "must specify more than zero vectors!");
}
if (!indx) {
HPIC_ERROR(HPIC_ERR_ACCESS, "index vector is not allocated");
}
for (i = 0; i < nvecs; i++) {
tempvec = hpic_vec_fltarr_get(vecs, i);
if (!tempvec) {
HPIC_ERROR(HPIC_ERR_ACCESS, "input vector is not allocated");
}
}
vectypes = hpic_strarr_alloc(nvecs + 1);
names = hpic_strarr_alloc(nvecs + 1);
units = hpic_strarr_alloc(nvecs + 1);
veclen = hpic_vec_int_n_get(indx);
for (i = 0; i < nvecs; i++) {
tempvec = hpic_vec_fltarr_get(vecs, i);
if (veclen != hpic_vec_float_n_get(tempvec)) {
HPIC_ERROR(HPIC_ERR_FITS, "all vectors must have the same length");
}
}
/* setup column parameters */
strncpy(vectypes[0], "1J", HPIC_STRNL);
strncpy(names[0], "INDEX", HPIC_STRNL);
strncpy(units[0], "", HPIC_STRNL);
for (i = 1; i < nvecs + 1; i++) {
strncpy(vectypes[i], "1E", HPIC_STRNL);
strncpy(names[i], vecnames[i - 1], HPIC_STRNL);
strncpy(units[i], vecunits[i - 1], HPIC_STRNL);
}
/* create file */
if (fits_create_file(&fp, filename, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: creating file");
}
/* create empty primary image */
if (fits_create_img(fp, bitpix, nax, axes, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: creating primary image");
}
/* write header */
if (fits_write_comment(fp, " ", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing header comment 1");
}
if (fits_write_comment(fp, comment, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing header comment 2");
}
if (fits_write_comment(fp, " ", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing header comment 3");
}
if (fits_write_date(fp, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing date");
}
if (fits_write_key
(fp, TSTRING, "CREATOR", creator, "Software creating the map", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing creator");
}
/* write extension */
if (fits_create_tbl
(fp, BINARY_TBL, (long)veclen, (int)(nvecs + 1), names, vectypes, units,
extname, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: creating binary table");
}
if (fits_movabs_hdu(fp, 2, &type, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: moving to extension");
}
/* write mandatory keywords */
if (fits_write_comment(fp, " ", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing ext comment 1");
}
if (fits_write_comment
(fp, "-----------------------------------------------", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing ext comment 2");
}
if (fits_write_comment(fp, " Data Specific Keywords ", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing ext comment 3");
}
if (fits_write_comment
(fp, "-----------------------------------------------", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing ext comment 4");
}
if (fits_write_comment(fp, " ", &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing comment 5");
}
/* write optional keywords */
hpic_keys_write(keys, fp, &ret);
/* write the data and clean up */
if (fits_write_col
(fp, TINT, 1, frow, fsamp, (long)veclen, indx->data, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing index column");
}
for (i = 0; i < nvecs; i++) {
tempvec = hpic_vec_fltarr_get(vecs, i);
if (fits_write_col
(fp, TFLOAT, (int)(i + 2), frow, fsamp, (long)veclen, tempvec->data,
&ret)) {
fitserr(ret, "hpic_fits_vecindx_write: writing data column");
}
}
hpic_strarr_free(vectypes, nvecs + 1);
hpic_strarr_free(names, nvecs + 1);
hpic_strarr_free(units, nvecs + 1);
if (fits_close_file(fp, &ret)) {
fitserr(ret, "hpic_fits_vecindx_write: closing file");
}
return ret;
}