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