1 /* This file, putkey.c, contains routines that write keywords to */
2 /* a FITS header. */
3
4 /* The FITSIO software was written by William Pence at the High Energy */
5 /* Astrophysic Science Archive Research Center (HEASARC) at the NASA */
6 /* Goddard Space Flight Center. */
7
8 #include <string.h>
9 #include <stdlib.h>
10 #include <ctype.h>
11 #include <time.h>
12 /* stddef.h is apparently needed to define size_t */
13 #include <stddef.h>
14 #include "fitsio2.h"
15
16 /*--------------------------------------------------------------------------*/
ffcrim(fitsfile * fptr,int bitpix,int naxis,long * naxes,int * status)17 int ffcrim(fitsfile *fptr, /* I - FITS file pointer */
18 int bitpix, /* I - bits per pixel */
19 int naxis, /* I - number of axes in the array */
20 long *naxes, /* I - size of each axis */
21 int *status) /* IO - error status */
22 /*
23 create an IMAGE extension following the current HDU. If the
24 current HDU is empty (contains no header keywords), then simply
25 write the required image (or primary array) keywords to the current
26 HDU.
27 */
28 {
29 if (*status > 0)
30 return(*status);
31
32 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
33 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
34
35 /* create new extension if current header is not empty */
36 if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
37 ffcrhd(fptr, status);
38
39 /* write the required header keywords */
40 ffphpr(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
41
42 return(*status);
43 }
44 /*--------------------------------------------------------------------------*/
ffcrimll(fitsfile * fptr,int bitpix,int naxis,LONGLONG * naxes,int * status)45 int ffcrimll(fitsfile *fptr, /* I - FITS file pointer */
46 int bitpix, /* I - bits per pixel */
47 int naxis, /* I - number of axes in the array */
48 LONGLONG *naxes, /* I - size of each axis */
49 int *status) /* IO - error status */
50 /*
51 create an IMAGE extension following the current HDU. If the
52 current HDU is empty (contains no header keywords), then simply
53 write the required image (or primary array) keywords to the current
54 HDU.
55 */
56 {
57 if (*status > 0)
58 return(*status);
59
60 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
61 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
62
63 /* create new extension if current header is not empty */
64 if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
65 ffcrhd(fptr, status);
66
67 /* write the required header keywords */
68 ffphprll(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
69
70 return(*status);
71 }
72 /*--------------------------------------------------------------------------*/
ffcrtb(fitsfile * fptr,int tbltype,LONGLONG naxis2,int tfields,char ** ttype,char ** tform,char ** tunit,const char * extnm,int * status)73 int ffcrtb(fitsfile *fptr, /* I - FITS file pointer */
74 int tbltype, /* I - type of table to create */
75 LONGLONG naxis2, /* I - number of rows in the table */
76 int tfields, /* I - number of columns in the table */
77 char **ttype, /* I - name of each column */
78 char **tform, /* I - value of TFORMn keyword for each column */
79 char **tunit, /* I - value of TUNITn keyword for each column */
80 const char *extnm, /* I - value of EXTNAME keyword, if any */
81 int *status) /* IO - error status */
82 /*
83 Create a table extension in a FITS file.
84 */
85 {
86 LONGLONG naxis1 = 0;
87 long *tbcol = 0;
88
89 if (*status > 0)
90 return(*status);
91
92 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
93 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
94
95 /* create new extension if current header is not empty */
96 if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
97 ffcrhd(fptr, status);
98
99 if ((fptr->Fptr)->curhdu == 0) /* have to create dummy primary array */
100 {
101 ffcrim(fptr, 16, 0, tbcol, status);
102 ffcrhd(fptr, status);
103 }
104
105 if (tbltype == BINARY_TBL)
106 {
107 /* write the required header keywords. This will write PCOUNT = 0 */
108 ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, 0, status);
109 }
110 else if (tbltype == ASCII_TBL)
111 {
112 /* write the required header keywords */
113 /* default values for naxis1 and tbcol will be calculated */
114 ffphtb(fptr, naxis1, naxis2, tfields, ttype, tbcol, tform, tunit,
115 extnm, status);
116 }
117 else
118 *status = NOT_TABLE;
119
120 return(*status);
121 }
122 /*-------------------------------------------------------------------------*/
ffpktp(fitsfile * fptr,const char * filename,int * status)123 int ffpktp(fitsfile *fptr, /* I - FITS file pointer */
124 const char *filename, /* I - name of template file */
125 int *status) /* IO - error status */
126 /*
127 read keywords from template file and append to the FITS file
128 */
129 {
130 FILE *diskfile;
131 char card[FLEN_CARD], template[161];
132 char keyname[FLEN_KEYWORD], newname[FLEN_KEYWORD];
133 int keytype;
134 size_t slen;
135
136 if (*status > 0) /* inherit input status value if > 0 */
137 return(*status);
138
139 diskfile = fopen(filename,"r");
140 if (!diskfile) /* couldn't open file */
141 {
142 ffpmsg("ffpktp could not open the following template file:");
143 ffpmsg(filename);
144 return(*status = FILE_NOT_OPENED);
145 }
146
147 while (fgets(template, 160, diskfile) ) /* get next template line */
148 {
149 template[160] = '\0'; /* make sure string is terminated */
150 slen = strlen(template); /* get string length */
151 template[slen - 1] = '\0'; /* over write the 'newline' char */
152
153 if (ffgthd(template, card, &keytype, status) > 0) /* parse template */
154 break;
155
156 strncpy(keyname, card, 8);
157 keyname[8] = '\0';
158
159 if (keytype == -2) /* rename the card */
160 {
161 strncpy(newname, &card[40], 8);
162 newname[8] = '\0';
163
164 ffmnam(fptr, keyname, newname, status);
165 }
166 else if (keytype == -1) /* delete the card */
167 {
168 ffdkey(fptr, keyname, status);
169 }
170 else if (keytype == 0) /* update the card */
171 {
172 ffucrd(fptr, keyname, card, status);
173 }
174 else if (keytype == 1) /* append the card */
175 {
176 ffprec(fptr, card, status);
177 }
178 else /* END card; stop here */
179 {
180 break;
181 }
182 }
183
184 fclose(diskfile); /* close the template file */
185 return(*status);
186 }
187 /*--------------------------------------------------------------------------*/
ffpky(fitsfile * fptr,int datatype,const char * keyname,void * value,const char * comm,int * status)188 int ffpky( fitsfile *fptr, /* I - FITS file pointer */
189 int datatype, /* I - datatype of the value */
190 const char *keyname,/* I - name of keyword to write */
191 void *value, /* I - keyword value */
192 const char *comm, /* I - keyword comment */
193 int *status) /* IO - error status */
194 /*
195 Write (put) the keyword, value and comment into the FITS header.
196 Writes a keyword value with the datatype specified by the 2nd argument.
197 */
198 {
199 char errmsg[81];
200
201 if (*status > 0) /* inherit input status value if > 0 */
202 return(*status);
203
204 if (datatype == TSTRING)
205 {
206 ffpkys(fptr, keyname, (char *) value, comm, status);
207 }
208 else if (datatype == TBYTE)
209 {
210 ffpkyj(fptr, keyname, (LONGLONG) *(unsigned char *) value, comm, status);
211 }
212 else if (datatype == TSBYTE)
213 {
214 ffpkyj(fptr, keyname, (LONGLONG) *(signed char *) value, comm, status);
215 }
216 else if (datatype == TUSHORT)
217 {
218 ffpkyj(fptr, keyname, (LONGLONG) *(unsigned short *) value, comm, status);
219 }
220 else if (datatype == TSHORT)
221 {
222 ffpkyj(fptr, keyname, (LONGLONG) *(short *) value, comm, status);
223 }
224 else if (datatype == TUINT)
225 {
226 ffpkyg(fptr, keyname, (double) *(unsigned int *) value, 0,
227 comm, status);
228 }
229 else if (datatype == TINT)
230 {
231 ffpkyj(fptr, keyname, (LONGLONG) *(int *) value, comm, status);
232 }
233 else if (datatype == TLOGICAL)
234 {
235 ffpkyl(fptr, keyname, *(int *) value, comm, status);
236 }
237 else if (datatype == TULONG)
238 {
239 ffpkyg(fptr, keyname, (double) *(unsigned long *) value, 0,
240 comm, status);
241 }
242 else if (datatype == TLONG)
243 {
244 ffpkyj(fptr, keyname, (LONGLONG) *(long *) value, comm, status);
245 }
246 else if (datatype == TLONGLONG)
247 {
248 ffpkyj(fptr, keyname, *(LONGLONG *) value, comm, status);
249 }
250 else if (datatype == TFLOAT)
251 {
252 ffpkye(fptr, keyname, *(float *) value, -7, comm, status);
253 }
254 else if (datatype == TDOUBLE)
255 {
256 ffpkyd(fptr, keyname, *(double *) value, -15, comm, status);
257 }
258 else if (datatype == TCOMPLEX)
259 {
260 ffpkyc(fptr, keyname, (float *) value, -7, comm, status);
261 }
262 else if (datatype == TDBLCOMPLEX)
263 {
264 ffpkym(fptr, keyname, (double *) value, -15, comm, status);
265 }
266 else
267 {
268 sprintf(errmsg, "Bad keyword datatype code: %d (ffpky)", datatype);
269 ffpmsg(errmsg);
270 *status = BAD_DATATYPE;
271 }
272
273 return(*status);
274 }
275 /*-------------------------------------------------------------------------*/
ffprec(fitsfile * fptr,const char * card,int * status)276 int ffprec(fitsfile *fptr, /* I - FITS file pointer */
277 const char *card, /* I - string to be written */
278 int *status) /* IO - error status */
279 /*
280 write a keyword record (80 bytes long) to the end of the header
281 */
282 {
283 char tcard[FLEN_CARD];
284 size_t len, ii;
285 long nblocks;
286
287 if (*status > 0) /* inherit input status value if > 0 */
288 return(*status);
289
290 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
291 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
292
293 if ( ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) == 80) /* no room */
294 {
295 nblocks = 1;
296 if (ffiblk(fptr, nblocks, 0, status) > 0) /* insert 2880-byte block */
297 return(*status);
298 }
299
300 strncpy(tcard,card,80);
301 tcard[80] = '\0';
302
303 len = strlen(tcard);
304
305 /* silently replace any illegal characters with a space */
306 for (ii=0; ii < len; ii++)
307 if (tcard[ii] < ' ' || tcard[ii] > 126) tcard[ii] = ' ';
308
309 for (ii=len; ii < 80; ii++) /* fill card with spaces if necessary */
310 tcard[ii] = ' ';
311
312 for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */
313 tcard[ii] = toupper(tcard[ii]);
314
315 fftkey(tcard, status); /* test keyword name contains legal chars */
316
317 /* no need to do this any more, since any illegal characters have been removed
318 fftrec(tcard, status); */ /* test rest of keyword for legal chars */
319
320 ffmbyt(fptr, (fptr->Fptr)->headend, IGNORE_EOF, status); /* move to end */
321
322 ffpbyt(fptr, 80, tcard, status); /* write the 80 byte card */
323
324 if (*status <= 0)
325 (fptr->Fptr)->headend += 80; /* update end-of-header position */
326
327 return(*status);
328 }
329 /*--------------------------------------------------------------------------*/
ffpkyu(fitsfile * fptr,const char * keyname,const char * comm,int * status)330 int ffpkyu( fitsfile *fptr, /* I - FITS file pointer */
331 const char *keyname,/* I - name of keyword to write */
332 const char *comm, /* I - keyword comment */
333 int *status) /* IO - error status */
334 /*
335 Write (put) a null-valued keyword and comment into the FITS header.
336 */
337 {
338 char valstring[FLEN_VALUE];
339 char card[FLEN_CARD];
340
341 if (*status > 0) /* inherit input status value if > 0 */
342 return(*status);
343
344 strcpy(valstring," "); /* create a dummy value string */
345 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword */
346 ffprec(fptr, card, status);
347
348 return(*status);
349 }
350 /*--------------------------------------------------------------------------*/
ffpkys(fitsfile * fptr,const char * keyname,const char * value,const char * comm,int * status)351 int ffpkys( fitsfile *fptr, /* I - FITS file pointer */
352 const char *keyname,/* I - name of keyword to write */
353 const char *value, /* I - keyword value */
354 const char *comm, /* I - keyword comment */
355 int *status) /* IO - error status */
356 /*
357 Write (put) the keyword, value and comment into the FITS header.
358 The value string will be truncated at 68 characters which is the
359 maximum length that will fit on a single FITS keyword.
360 */
361 {
362 char valstring[FLEN_VALUE];
363 char card[FLEN_CARD];
364
365 if (*status > 0) /* inherit input status value if > 0 */
366 return(*status);
367
368 ffs2c(value, valstring, status); /* put quotes around the string */
369 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword */
370 ffprec(fptr, card, status);
371
372 return(*status);
373 }
374 /*--------------------------------------------------------------------------*/
ffpkls(fitsfile * fptr,const char * keyname,const char * value,const char * comm,int * status)375 int ffpkls( fitsfile *fptr, /* I - FITS file pointer */
376 const char *keyname,/* I - name of keyword to write */
377 const char *value, /* I - keyword value */
378 const char *comm, /* I - keyword comment */
379 int *status) /* IO - error status */
380 /*
381 Write (put) the keyword, value and comment into the FITS header.
382 This routine is a modified version of ffpkys which supports the
383 HEASARC long string convention and can write arbitrarily long string
384 keyword values. The value is continued over multiple keywords that
385 have the name COMTINUE without an equal sign in column 9 of the card.
386 This routine also supports simple string keywords which are less than
387 69 characters in length.
388 */
389 {
390 char valstring[FLEN_CARD];
391 char card[FLEN_CARD], tmpkeyname[FLEN_CARD];
392 char tstring[FLEN_CARD], *cptr;
393 int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1;
394
395 if (*status > 0) /* inherit input status value if > 0 */
396 return(*status);
397
398 remain = maxvalue(strlen(value), 1); /* no. of chars to write (at least 1) */
399 /* count the number of single quote characters are in the string */
400 tstring[0] = '\0';
401 strncat(tstring, value, 68); /* copy 1st part of string to temp buff */
402 nquote = 0;
403 cptr = strchr(tstring, '\''); /* search for quote character */
404 while (cptr) /* search for quote character */
405 {
406 nquote++; /* increment no. of quote characters */
407 cptr++; /* increment pointer to next character */
408 cptr = strchr(cptr, '\''); /* search for another quote char */
409 }
410
411 strncpy(tmpkeyname, keyname, 80);
412 tmpkeyname[80] = '\0';
413
414 cptr = tmpkeyname;
415 while(*cptr == ' ') /* skip over leading spaces in name */
416 cptr++;
417
418 /* determine the number of characters that will fit on the line */
419 /* Note: each quote character is expanded to 2 quotes */
420
421 namelen = strlen(cptr);
422 if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) )
423 {
424 /* This a normal 8-character FITS keyword */
425 nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */
426 }
427 else
428 {
429 /* This a HIERARCH keyword */
430 if (FSTRNCMP(cptr, "HIERARCH ", 9) &&
431 FSTRNCMP(cptr, "hierarch ", 9))
432 nchar = 66 - nquote - namelen;
433 else
434 nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */
435
436 }
437
438 contin = 0;
439 next = 0; /* pointer to next character to write */
440
441 while (remain > 0)
442 {
443 tstring[0] = '\0';
444 strncat(tstring, &value[next], nchar); /* copy string to temp buff */
445 ffs2c(tstring, valstring, status); /* put quotes around the string */
446
447 if (remain > nchar) /* if string is continued, put & as last char */
448 {
449 vlen = strlen(valstring);
450 nchar -= 1; /* outputting one less character now */
451
452 if (valstring[vlen-2] != '\'')
453 valstring[vlen-2] = '&'; /* over write last char with & */
454 else
455 { /* last char was a pair of single quotes, so over write both */
456 valstring[vlen-3] = '&';
457 valstring[vlen-1] = '\0';
458 }
459 }
460
461 if (contin) /* This is a CONTINUEd keyword */
462 {
463 ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */
464 strncpy(&card[8], " ", 2); /* overwrite the '=' */
465 }
466 else
467 {
468 ffmkky(keyname, valstring, comm, card, status); /* make keyword */
469 }
470
471 ffprec(fptr, card, status); /* write the keyword */
472
473 contin = 1;
474 remain -= nchar;
475 next += nchar;
476
477 if (remain > 0)
478 {
479 /* count the number of single quote characters in next section */
480 tstring[0] = '\0';
481 strncat(tstring, &value[next], 68); /* copy next part of string */
482 nquote = 0;
483 cptr = strchr(tstring, '\''); /* search for quote character */
484 while (cptr) /* search for quote character */
485 {
486 nquote++; /* increment no. of quote characters */
487 cptr++; /* increment pointer to next character */
488 cptr = strchr(cptr, '\''); /* search for another quote char */
489 }
490 nchar = 68 - nquote; /* max number of chars to write this time */
491 }
492 }
493 return(*status);
494 }
495 /*--------------------------------------------------------------------------*/
ffplsw(fitsfile * fptr,int * status)496 int ffplsw( fitsfile *fptr, /* I - FITS file pointer */
497 int *status) /* IO - error status */
498 /*
499 Write the LONGSTRN keyword and a series of related COMMENT keywords
500 which document that this FITS header may contain long string keyword
501 values which are continued over multiple keywords using the HEASARC
502 long string keyword convention. If the LONGSTRN keyword already exists
503 then this routine simple returns without doing anything.
504 */
505 {
506 char valstring[FLEN_VALUE], comm[FLEN_COMMENT];
507 int tstatus;
508
509 if (*status > 0) /* inherit input status value if > 0 */
510 return(*status);
511
512 tstatus = 0;
513 if (ffgkys(fptr, "LONGSTRN", valstring, comm, &tstatus) == 0)
514 return(*status); /* keyword already exists, so just return */
515
516 ffpkys(fptr, "LONGSTRN", "OGIP 1.0",
517 "The HEASARC Long String Convention may be used.", status);
518
519 ffpcom(fptr,
520 " This FITS file may contain long string keyword values that are", status);
521
522 ffpcom(fptr,
523 " continued over multiple keywords. The HEASARC convention uses the &",
524 status);
525
526 ffpcom(fptr,
527 " character at the end of each substring which is then continued", status);
528
529 ffpcom(fptr,
530 " on the next keyword which has the name CONTINUE.", status);
531
532 return(*status);
533 }
534 /*--------------------------------------------------------------------------*/
ffpkyl(fitsfile * fptr,const char * keyname,int value,const char * comm,int * status)535 int ffpkyl( fitsfile *fptr, /* I - FITS file pointer */
536 const char *keyname,/* I - name of keyword to write */
537 int value, /* I - keyword value */
538 const char *comm, /* I - keyword comment */
539 int *status) /* IO - error status */
540 /*
541 Write (put) the keyword, value and comment into the FITS header.
542 Values equal to 0 will result in a False FITS keyword; any other
543 non-zero value will result in a True FITS keyword.
544 */
545 {
546 char valstring[FLEN_VALUE];
547 char card[FLEN_CARD];
548
549 if (*status > 0) /* inherit input status value if > 0 */
550 return(*status);
551
552 ffl2c(value, valstring, status); /* convert to formatted string */
553 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
554 ffprec(fptr, card, status); /* write the keyword*/
555
556 return(*status);
557 }
558 /*--------------------------------------------------------------------------*/
ffpkyj(fitsfile * fptr,const char * keyname,LONGLONG value,const char * comm,int * status)559 int ffpkyj( fitsfile *fptr, /* I - FITS file pointer */
560 const char *keyname,/* I - name of keyword to write */
561 LONGLONG value, /* I - keyword value */
562 const char *comm, /* I - keyword comment */
563 int *status) /* IO - error status */
564 /*
565 Write (put) the keyword, value and comment into the FITS header.
566 Writes an integer keyword value.
567 */
568 {
569 char valstring[FLEN_VALUE];
570 char card[FLEN_CARD];
571
572 if (*status > 0) /* inherit input status value if > 0 */
573 return(*status);
574
575 ffi2c(value, valstring, status); /* convert to formatted string */
576 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
577 ffprec(fptr, card, status); /* write the keyword*/
578
579 return(*status);
580 }
581 /*--------------------------------------------------------------------------*/
ffpkyf(fitsfile * fptr,const char * keyname,float value,int decim,const char * comm,int * status)582 int ffpkyf( fitsfile *fptr, /* I - FITS file pointer */
583 const char *keyname,/* I - name of keyword to write */
584 float value, /* I - keyword value */
585 int decim, /* I - number of decimal places to display */
586 const char *comm, /* I - keyword comment */
587 int *status) /* IO - error status */
588 /*
589 Write (put) the keyword, value and comment into the FITS header.
590 Writes a fixed float keyword value.
591 */
592 {
593 char valstring[FLEN_VALUE];
594 char card[FLEN_CARD];
595
596 if (*status > 0) /* inherit input status value if > 0 */
597 return(*status);
598
599 ffr2f(value, decim, valstring, status); /* convert to formatted string */
600 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
601 ffprec(fptr, card, status); /* write the keyword*/
602
603 return(*status);
604 }
605 /*--------------------------------------------------------------------------*/
ffpkye(fitsfile * fptr,const char * keyname,float value,int decim,const char * comm,int * status)606 int ffpkye( fitsfile *fptr, /* I - FITS file pointer */
607 const char *keyname,/* I - name of keyword to write */
608 float value, /* I - keyword value */
609 int decim, /* I - number of decimal places to display */
610 const char *comm, /* I - keyword comment */
611 int *status) /* IO - error status */
612 /*
613 Write (put) the keyword, value and comment into the FITS header.
614 Writes an exponential float keyword value.
615 */
616 {
617 char valstring[FLEN_VALUE];
618 char card[FLEN_CARD];
619
620 if (*status > 0) /* inherit input status value if > 0 */
621 return(*status);
622
623 ffr2e(value, decim, valstring, status); /* convert to formatted string */
624 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
625 ffprec(fptr, card, status); /* write the keyword*/
626
627 return(*status);
628 }
629 /*--------------------------------------------------------------------------*/
ffpkyg(fitsfile * fptr,const char * keyname,double value,int decim,const char * comm,int * status)630 int ffpkyg( fitsfile *fptr, /* I - FITS file pointer */
631 const char *keyname,/* I - name of keyword to write */
632 double value, /* I - keyword value */
633 int decim, /* I - number of decimal places to display */
634 const char *comm, /* I - keyword comment */
635 int *status) /* IO - error status */
636 /*
637 Write (put) the keyword, value and comment into the FITS header.
638 Writes a fixed double keyword value.*/
639 {
640 char valstring[FLEN_VALUE];
641 char card[FLEN_CARD];
642
643 if (*status > 0) /* inherit input status value if > 0 */
644 return(*status);
645
646 ffd2f(value, decim, valstring, status); /* convert to formatted string */
647 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
648 ffprec(fptr, card, status); /* write the keyword*/
649
650 return(*status);
651 }
652 /*--------------------------------------------------------------------------*/
ffpkyd(fitsfile * fptr,const char * keyname,double value,int decim,const char * comm,int * status)653 int ffpkyd( fitsfile *fptr, /* I - FITS file pointer */
654 const char *keyname,/* I - name of keyword to write */
655 double value, /* I - keyword value */
656 int decim, /* I - number of decimal places to display */
657 const char *comm, /* I - keyword comment */
658 int *status) /* IO - error status */
659 /*
660 Write (put) the keyword, value and comment into the FITS header.
661 Writes an exponential double keyword value.*/
662 {
663 char valstring[FLEN_VALUE];
664 char card[FLEN_CARD];
665
666 if (*status > 0) /* inherit input status value if > 0 */
667 return(*status);
668
669 ffd2e(value, decim, valstring, status); /* convert to formatted string */
670 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
671 ffprec(fptr, card, status); /* write the keyword*/
672
673 return(*status);
674 }
675 /*--------------------------------------------------------------------------*/
ffpkyc(fitsfile * fptr,const char * keyname,float * value,int decim,const char * comm,int * status)676 int ffpkyc( fitsfile *fptr, /* I - FITS file pointer */
677 const char *keyname,/* I - name of keyword to write */
678 float *value, /* I - keyword value (real, imaginary) */
679 int decim, /* I - number of decimal places to display */
680 const char *comm, /* I - keyword comment */
681 int *status) /* IO - error status */
682 /*
683 Write (put) the keyword, value and comment into the FITS header.
684 Writes an complex float keyword value. Format = (realvalue, imagvalue)
685 */
686 {
687 char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
688 char card[FLEN_CARD];
689
690 if (*status > 0) /* inherit input status value if > 0 */
691 return(*status);
692
693 strcpy(valstring, "(" );
694 ffr2e(value[0], decim, tmpstring, status); /* convert to string */
695 strcat(valstring, tmpstring);
696 strcat(valstring, ", ");
697 ffr2e(value[1], decim, tmpstring, status); /* convert to string */
698 strcat(valstring, tmpstring);
699 strcat(valstring, ")");
700
701 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
702 ffprec(fptr, card, status); /* write the keyword*/
703
704 return(*status);
705 }
706 /*--------------------------------------------------------------------------*/
ffpkym(fitsfile * fptr,const char * keyname,double * value,int decim,const char * comm,int * status)707 int ffpkym( fitsfile *fptr, /* I - FITS file pointer */
708 const char *keyname,/* I - name of keyword to write */
709 double *value, /* I - keyword value (real, imaginary) */
710 int decim, /* I - number of decimal places to display */
711 const char *comm, /* I - keyword comment */
712 int *status) /* IO - error status */
713 /*
714 Write (put) the keyword, value and comment into the FITS header.
715 Writes an complex double keyword value. Format = (realvalue, imagvalue)
716 */
717 {
718 char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
719 char card[FLEN_CARD];
720
721 if (*status > 0) /* inherit input status value if > 0 */
722 return(*status);
723
724 strcpy(valstring, "(" );
725 ffd2e(value[0], decim, tmpstring, status); /* convert to string */
726 strcat(valstring, tmpstring);
727 strcat(valstring, ", ");
728 ffd2e(value[1], decim, tmpstring, status); /* convert to string */
729 strcat(valstring, tmpstring);
730 strcat(valstring, ")");
731
732 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
733 ffprec(fptr, card, status); /* write the keyword*/
734
735 return(*status);
736 }
737 /*--------------------------------------------------------------------------*/
ffpkfc(fitsfile * fptr,const char * keyname,float * value,int decim,const char * comm,int * status)738 int ffpkfc( fitsfile *fptr, /* I - FITS file pointer */
739 const char *keyname,/* I - name of keyword to write */
740 float *value, /* I - keyword value (real, imaginary) */
741 int decim, /* I - number of decimal places to display */
742 const char *comm, /* I - keyword comment */
743 int *status) /* IO - error status */
744 /*
745 Write (put) the keyword, value and comment into the FITS header.
746 Writes an complex float keyword value. Format = (realvalue, imagvalue)
747 */
748 {
749 char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
750 char card[FLEN_CARD];
751
752 if (*status > 0) /* inherit input status value if > 0 */
753 return(*status);
754
755 strcpy(valstring, "(" );
756 ffr2f(value[0], decim, tmpstring, status); /* convert to string */
757 strcat(valstring, tmpstring);
758 strcat(valstring, ", ");
759 ffr2f(value[1], decim, tmpstring, status); /* convert to string */
760 strcat(valstring, tmpstring);
761 strcat(valstring, ")");
762
763 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
764 ffprec(fptr, card, status); /* write the keyword*/
765
766 return(*status);
767 }
768 /*--------------------------------------------------------------------------*/
ffpkfm(fitsfile * fptr,const char * keyname,double * value,int decim,const char * comm,int * status)769 int ffpkfm( fitsfile *fptr, /* I - FITS file pointer */
770 const char *keyname,/* I - name of keyword to write */
771 double *value, /* I - keyword value (real, imaginary) */
772 int decim, /* I - number of decimal places to display */
773 const char *comm, /* I - keyword comment */
774 int *status) /* IO - error status */
775 /*
776 Write (put) the keyword, value and comment into the FITS header.
777 Writes an complex double keyword value. Format = (realvalue, imagvalue)
778 */
779 {
780 char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
781 char card[FLEN_CARD];
782
783 if (*status > 0) /* inherit input status value if > 0 */
784 return(*status);
785
786 strcpy(valstring, "(" );
787 ffd2f(value[0], decim, tmpstring, status); /* convert to string */
788 strcat(valstring, tmpstring);
789 strcat(valstring, ", ");
790 ffd2f(value[1], decim, tmpstring, status); /* convert to string */
791 strcat(valstring, tmpstring);
792 strcat(valstring, ")");
793
794 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
795 ffprec(fptr, card, status); /* write the keyword*/
796
797 return(*status);
798 }
799 /*--------------------------------------------------------------------------*/
ffpkyt(fitsfile * fptr,const char * keyname,long intval,double fraction,const char * comm,int * status)800 int ffpkyt( fitsfile *fptr, /* I - FITS file pointer */
801 const char *keyname,/* I - name of keyword to write */
802 long intval, /* I - integer part of value */
803 double fraction, /* I - fractional part of value */
804 const char *comm, /* I - keyword comment */
805 int *status) /* IO - error status */
806 /*
807 Write (put) a 'triple' precision keyword where the integer and
808 fractional parts of the value are passed in separate parameters to
809 increase the total amount of numerical precision.
810 */
811 {
812 char valstring[FLEN_VALUE];
813 char card[FLEN_CARD];
814 char fstring[20], *cptr;
815
816 if (*status > 0) /* inherit input status value if > 0 */
817 return(*status);
818
819 if (fraction > 1. || fraction < 0.)
820 {
821 ffpmsg("fraction must be between 0. and 1. (ffpkyt)");
822 return(*status = BAD_F2C);
823 }
824
825 ffi2c(intval, valstring, status); /* convert integer to string */
826 ffd2f(fraction, 16, fstring, status); /* convert to 16 decimal string */
827
828 cptr = strchr(fstring, '.'); /* find the decimal point */
829 strcat(valstring, cptr); /* append the fraction to the integer */
830
831 ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
832 ffprec(fptr, card, status); /* write the keyword*/
833
834 return(*status);
835 }
836 /*-----------------------------------------------------------------*/
ffpcom(fitsfile * fptr,const char * comm,int * status)837 int ffpcom( fitsfile *fptr, /* I - FITS file pointer */
838 const char *comm, /* I - comment string */
839 int *status) /* IO - error status */
840 /*
841 Write 1 or more COMMENT keywords. If the comment string is too
842 long to fit on a single keyword (72 chars) then it will automatically
843 be continued on multiple CONTINUE keywords.
844 */
845 {
846 char card[FLEN_CARD];
847 int len, ii;
848
849 if (*status > 0) /* inherit input status value if > 0 */
850 return(*status);
851
852 len = strlen(comm);
853 ii = 0;
854
855 for (; len > 0; len -= 72)
856 {
857 strcpy(card, "COMMENT ");
858 strncat(card, &comm[ii], 72);
859 ffprec(fptr, card, status);
860 ii += 72;
861 }
862
863 return(*status);
864 }
865 /*-----------------------------------------------------------------*/
ffphis(fitsfile * fptr,const char * history,int * status)866 int ffphis( fitsfile *fptr, /* I - FITS file pointer */
867 const char *history, /* I - history string */
868 int *status) /* IO - error status */
869 /*
870 Write 1 or more HISTORY keywords. If the history string is too
871 long to fit on a single keyword (72 chars) then it will automatically
872 be continued on multiple HISTORY keywords.
873 */
874 {
875 char card[FLEN_CARD];
876 int len, ii;
877
878 if (*status > 0) /* inherit input status value if > 0 */
879 return(*status);
880
881 len = strlen(history);
882 ii = 0;
883
884 for (; len > 0; len -= 72)
885 {
886 strcpy(card, "HISTORY ");
887 strncat(card, &history[ii], 72);
888 ffprec(fptr, card, status);
889 ii += 72;
890 }
891
892 return(*status);
893 }
894 /*-----------------------------------------------------------------*/
ffpdat(fitsfile * fptr,int * status)895 int ffpdat( fitsfile *fptr, /* I - FITS file pointer */
896 int *status) /* IO - error status */
897 /*
898 Write the DATE keyword into the FITS header. If the keyword already
899 exists then the date will simply be updated in the existing keyword.
900 */
901 {
902 int timeref;
903 char date[30], tmzone[10], card[FLEN_CARD];
904
905 if (*status > 0) /* inherit input status value if > 0 */
906 return(*status);
907
908 ffgstm(date, &timeref, status);
909
910 if (timeref) /* GMT not available on this machine */
911 strcpy(tmzone, " Local");
912 else
913 strcpy(tmzone, " UT");
914
915 strcpy(card, "DATE = '");
916 strcat(card, date);
917 strcat(card, "' / file creation date (YYYY-MM-DDThh:mm:ss");
918 strcat(card, tmzone);
919 strcat(card, ")");
920
921 ffucrd(fptr, "DATE", card, status);
922
923 return(*status);
924 }
925 /*-------------------------------------------------------------------*/
ffverifydate(int year,int month,int day,int * status)926 int ffverifydate(int year, /* I - year (0 - 9999) */
927 int month, /* I - month (1 - 12) */
928 int day, /* I - day (1 - 31) */
929 int *status) /* IO - error status */
930 /*
931 Verify that the date is valid
932 */
933 {
934 int ndays[] = {0,31,28,31,30,31,30,31,31,30,31,30,31};
935 char errmsg[81];
936
937
938 if (year < 0 || year > 9999)
939 {
940 sprintf(errmsg,
941 "input year value = %d is out of range 0 - 9999", year);
942 ffpmsg(errmsg);
943 return(*status = BAD_DATE);
944 }
945 else if (month < 1 || month > 12)
946 {
947 sprintf(errmsg,
948 "input month value = %d is out of range 1 - 12", month);
949 ffpmsg(errmsg);
950 return(*status = BAD_DATE);
951 }
952
953 if (ndays[month] == 31) {
954 if (day < 1 || day > 31)
955 {
956 sprintf(errmsg,
957 "input day value = %d is out of range 1 - 31 for month %d", day, month);
958 ffpmsg(errmsg);
959 return(*status = BAD_DATE);
960 }
961 } else if (ndays[month] == 30) {
962 if (day < 1 || day > 30)
963 {
964 sprintf(errmsg,
965 "input day value = %d is out of range 1 - 30 for month %d", day, month);
966 ffpmsg(errmsg);
967 return(*status = BAD_DATE);
968 }
969 } else {
970 if (day < 1 || day > 28)
971 {
972 if (day == 29)
973 {
974 /* year is a leap year if it is divisible by 4 but not by 100,
975 except years divisible by 400 are leap years
976 */
977 if ((year % 4 == 0 && year % 100 != 0 ) || year % 400 == 0)
978 return (*status);
979
980 sprintf(errmsg,
981 "input day value = %d is out of range 1 - 28 for February %d (not leap year)", day, year);
982 ffpmsg(errmsg);
983 } else {
984 sprintf(errmsg,
985 "input day value = %d is out of range 1 - 28 (or 29) for February", day);
986 ffpmsg(errmsg);
987 }
988
989 return(*status = BAD_DATE);
990 }
991 }
992 return(*status);
993 }
994 /*-----------------------------------------------------------------*/
ffgstm(char * timestr,int * timeref,int * status)995 int ffgstm( char *timestr, /* O - returned system date and time string */
996 int *timeref, /* O - GMT = 0, Local time = 1 */
997 int *status) /* IO - error status */
998 /*
999 Returns the current date and time in format 'yyyy-mm-ddThh:mm:ss'.
1000 */
1001 {
1002 time_t tp;
1003 struct tm *ptr;
1004
1005 if (*status > 0) /* inherit input status value if > 0 */
1006 return(*status);
1007
1008 time(&tp);
1009 ptr = gmtime(&tp); /* get GMT (= UTC) time */
1010
1011 if (timeref)
1012 {
1013 if (ptr)
1014 *timeref = 0; /* returning GMT */
1015 else
1016 *timeref = 1; /* returning local time */
1017 }
1018
1019 if (!ptr) /* GMT not available on this machine */
1020 ptr = localtime(&tp);
1021
1022 strftime(timestr, 25, "%Y-%m-%dT%H:%M:%S", ptr);
1023
1024 return(*status);
1025 }
1026 /*-----------------------------------------------------------------*/
ffdt2s(int year,int month,int day,char * datestr,int * status)1027 int ffdt2s(int year, /* I - year (0 - 9999) */
1028 int month, /* I - month (1 - 12) */
1029 int day, /* I - day (1 - 31) */
1030 char *datestr, /* O - date string: "YYYY-MM-DD" */
1031 int *status) /* IO - error status */
1032 /*
1033 Construct a date character string
1034 */
1035 {
1036 if (*status > 0) /* inherit input status value if > 0 */
1037 return(*status);
1038
1039 *datestr = '\0';
1040
1041 if (ffverifydate(year, month, day, status) > 0)
1042 {
1043 ffpmsg("invalid date (ffdt2s)");
1044 return(*status);
1045 }
1046
1047 if (year >= 1900 && year <= 1998) /* use old 'dd/mm/yy' format */
1048 sprintf(datestr, "%.2d/%.2d/%.2d", day, month, year - 1900);
1049
1050 else /* use the new 'YYYY-MM-DD' format */
1051 sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day);
1052
1053 return(*status);
1054 }
1055 /*-----------------------------------------------------------------*/
ffs2dt(char * datestr,int * year,int * month,int * day,int * status)1056 int ffs2dt(char *datestr, /* I - date string: "YYYY-MM-DD" or "dd/mm/yy" */
1057 int *year, /* O - year (0 - 9999) */
1058 int *month, /* O - month (1 - 12) */
1059 int *day, /* O - day (1 - 31) */
1060 int *status) /* IO - error status */
1061 /*
1062 Parse a date character string into year, month, and day values
1063 */
1064 {
1065 int slen, lyear, lmonth, lday;
1066
1067 if (*status > 0) /* inherit input status value if > 0 */
1068 return(*status);
1069
1070 if (year)
1071 *year = 0;
1072 if (month)
1073 *month = 0;
1074 if (day)
1075 *day = 0;
1076
1077 if (!datestr)
1078 {
1079 ffpmsg("error: null input date string (ffs2dt)");
1080 return(*status = BAD_DATE); /* Null datestr pointer ??? */
1081 }
1082
1083 slen = strlen(datestr);
1084
1085 if (slen == 8 && datestr[2] == '/' && datestr[5] == '/')
1086 {
1087 if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
1088 && isdigit((int) datestr[3]) && isdigit((int) datestr[4])
1089 && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) )
1090 {
1091 /* this is an old format string: "dd/mm/yy" */
1092 lyear = atoi(&datestr[6]) + 1900;
1093 lmonth = atoi(&datestr[3]);
1094 lday = atoi(datestr);
1095
1096 if (year)
1097 *year = lyear;
1098 if (month)
1099 *month = lmonth;
1100 if (day)
1101 *day = lday;
1102 }
1103 else
1104 {
1105 ffpmsg("input date string has illegal format (ffs2dt):");
1106 ffpmsg(datestr);
1107 return(*status = BAD_DATE);
1108 }
1109 }
1110 else if (slen >= 10 && datestr[4] == '-' && datestr[7] == '-')
1111 {
1112 if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
1113 && isdigit((int) datestr[2]) && isdigit((int) datestr[3])
1114 && isdigit((int) datestr[5]) && isdigit((int) datestr[6])
1115 && isdigit((int) datestr[8]) && isdigit((int) datestr[9]) )
1116 {
1117 if (slen > 10 && datestr[10] != 'T')
1118 {
1119 ffpmsg("input date string has illegal format (ffs2dt):");
1120 ffpmsg(datestr);
1121 return(*status = BAD_DATE);
1122 }
1123
1124 /* this is a new format string: "yyyy-mm-dd" */
1125 lyear = atoi(datestr);
1126 lmonth = atoi(&datestr[5]);
1127 lday = atoi(&datestr[8]);
1128
1129 if (year)
1130 *year = lyear;
1131 if (month)
1132 *month = lmonth;
1133 if (day)
1134 *day = lday;
1135 }
1136 else
1137 {
1138 ffpmsg("input date string has illegal format (ffs2dt):");
1139 ffpmsg(datestr);
1140 return(*status = BAD_DATE);
1141 }
1142 }
1143 else
1144 {
1145 ffpmsg("input date string has illegal format (ffs2dt):");
1146 ffpmsg(datestr);
1147 return(*status = BAD_DATE);
1148 }
1149
1150
1151 if (ffverifydate(lyear, lmonth, lday, status) > 0)
1152 {
1153 ffpmsg("invalid date (ffs2dt)");
1154 }
1155
1156 return(*status);
1157 }
1158 /*-----------------------------------------------------------------*/
fftm2s(int year,int month,int day,int hour,int minute,double second,int decimals,char * datestr,int * status)1159 int fftm2s(int year, /* I - year (0 - 9999) */
1160 int month, /* I - month (1 - 12) */
1161 int day, /* I - day (1 - 31) */
1162 int hour, /* I - hour (0 - 23) */
1163 int minute, /* I - minute (0 - 59) */
1164 double second, /* I - second (0. - 60.9999999) */
1165 int decimals, /* I - number of decimal points to write */
1166 char *datestr, /* O - date string: "YYYY-MM-DDThh:mm:ss.ddd" */
1167 /* or "hh:mm:ss.ddd" if year, month day = 0 */
1168 int *status) /* IO - error status */
1169 /*
1170 Construct a date and time character string
1171 */
1172 {
1173 int width;
1174 char errmsg[81];
1175
1176 if (*status > 0) /* inherit input status value if > 0 */
1177 return(*status);
1178
1179 *datestr='\0';
1180
1181 if (year != 0 || month != 0 || day !=0)
1182 {
1183 if (ffverifydate(year, month, day, status) > 0)
1184 {
1185 ffpmsg("invalid date (fftm2s)");
1186 return(*status);
1187 }
1188 }
1189
1190 if (hour < 0 || hour > 23)
1191 {
1192 sprintf(errmsg,
1193 "input hour value is out of range 0 - 23: %d (fftm2s)", hour);
1194 ffpmsg(errmsg);
1195 return(*status = BAD_DATE);
1196 }
1197 else if (minute < 0 || minute > 59)
1198 {
1199 sprintf(errmsg,
1200 "input minute value is out of range 0 - 59: %d (fftm2s)", minute);
1201 ffpmsg(errmsg);
1202 return(*status = BAD_DATE);
1203 }
1204 else if (second < 0. || second >= 61)
1205 {
1206 sprintf(errmsg,
1207 "input second value is out of range 0 - 60.999: %f (fftm2s)", second);
1208 ffpmsg(errmsg);
1209 return(*status = BAD_DATE);
1210 }
1211 else if (decimals > 25)
1212 {
1213 sprintf(errmsg,
1214 "input decimals value is out of range 0 - 25: %d (fftm2s)", decimals);
1215 ffpmsg(errmsg);
1216 return(*status = BAD_DATE);
1217 }
1218
1219 if (decimals == 0)
1220 width = 2;
1221 else
1222 width = decimals + 3;
1223
1224 if (decimals < 0)
1225 {
1226 /* a negative decimals value means return only the date, not time */
1227 sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day);
1228 }
1229 else if (year == 0 && month == 0 && day == 0)
1230 {
1231 /* return only the time, not the date */
1232 sprintf(datestr, "%.2d:%.2d:%0*.*f",
1233 hour, minute, width, decimals, second);
1234 }
1235 else
1236 {
1237 /* return both the time and date */
1238 sprintf(datestr, "%.4d-%.2d-%.2dT%.2d:%.2d:%0*.*f",
1239 year, month, day, hour, minute, width, decimals, second);
1240 }
1241 return(*status);
1242 }
1243 /*-----------------------------------------------------------------*/
ffs2tm(char * datestr,int * year,int * month,int * day,int * hour,int * minute,double * second,int * status)1244 int ffs2tm(char *datestr, /* I - date string: "YYYY-MM-DD" */
1245 /* or "YYYY-MM-DDThh:mm:ss.ddd" */
1246 /* or "dd/mm/yy" */
1247 int *year, /* O - year (0 - 9999) */
1248 int *month, /* O - month (1 - 12) */
1249 int *day, /* O - day (1 - 31) */
1250 int *hour, /* I - hour (0 - 23) */
1251 int *minute, /* I - minute (0 - 59) */
1252 double *second, /* I - second (0. - 60.9999999) */
1253 int *status) /* IO - error status */
1254 /*
1255 Parse a date character string into date and time values
1256 */
1257 {
1258 int slen;
1259 char errmsg[81];
1260
1261 if (*status > 0) /* inherit input status value if > 0 */
1262 return(*status);
1263
1264 if (year)
1265 *year = 0;
1266 if (month)
1267 *month = 0;
1268 if (day)
1269 *day = 0;
1270 if (hour)
1271 *hour = 0;
1272 if (minute)
1273 *minute = 0;
1274 if (second)
1275 *second = 0.;
1276
1277 if (!datestr)
1278 {
1279 ffpmsg("error: null input date string (ffs2tm)");
1280 return(*status = BAD_DATE); /* Null datestr pointer ??? */
1281 }
1282
1283 if (datestr[2] == '/' || datestr[4] == '-')
1284 {
1285 /* Parse the year, month, and date */
1286 if (ffs2dt(datestr, year, month, day, status) > 0)
1287 return(*status);
1288
1289 slen = strlen(datestr);
1290 if (slen == 8 || slen == 10)
1291 return(*status); /* OK, no time fields */
1292 else if (slen < 19)
1293 {
1294 ffpmsg("input date string has illegal format:");
1295 ffpmsg(datestr);
1296 return(*status = BAD_DATE);
1297 }
1298
1299 else if (datestr[10] == 'T' && datestr[13] == ':' && datestr[16] == ':')
1300 {
1301 if (isdigit((int) datestr[11]) && isdigit((int) datestr[12])
1302 && isdigit((int) datestr[14]) && isdigit((int) datestr[15])
1303 && isdigit((int) datestr[17]) && isdigit((int) datestr[18]) )
1304 {
1305 if (slen > 19 && datestr[19] != '.')
1306 {
1307 ffpmsg("input date string has illegal format:");
1308 ffpmsg(datestr);
1309 return(*status = BAD_DATE);
1310 }
1311
1312 /* this is a new format string: "yyyy-mm-ddThh:mm:ss.dddd" */
1313 if (hour)
1314 *hour = atoi(&datestr[11]);
1315
1316 if (minute)
1317 *minute = atoi(&datestr[14]);
1318
1319 if (second)
1320 *second = atof(&datestr[17]);
1321 }
1322 else
1323 {
1324 ffpmsg("input date string has illegal format:");
1325 ffpmsg(datestr);
1326 return(*status = BAD_DATE);
1327 }
1328
1329 }
1330 }
1331 else /* no date fields */
1332 {
1333 if (datestr[2] == ':' && datestr[5] == ':') /* time string */
1334 {
1335 if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
1336 && isdigit((int) datestr[3]) && isdigit((int) datestr[4])
1337 && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) )
1338 {
1339 /* this is a time string: "hh:mm:ss.dddd" */
1340 if (hour)
1341 *hour = atoi(&datestr[0]);
1342
1343 if (minute)
1344 *minute = atoi(&datestr[3]);
1345
1346 if (second)
1347 *second = atof(&datestr[6]);
1348 }
1349 else
1350 {
1351 ffpmsg("input date string has illegal format:");
1352 ffpmsg(datestr);
1353 return(*status = BAD_DATE);
1354 }
1355
1356 }
1357 else
1358 {
1359 ffpmsg("input date string has illegal format:");
1360 ffpmsg(datestr);
1361 return(*status = BAD_DATE);
1362 }
1363
1364 }
1365
1366 if (hour)
1367 if (*hour < 0 || *hour > 23)
1368 {
1369 sprintf(errmsg,
1370 "hour value is out of range 0 - 23: %d (ffs2tm)", *hour);
1371 ffpmsg(errmsg);
1372 return(*status = BAD_DATE);
1373 }
1374
1375 if (minute)
1376 if (*minute < 0 || *minute > 59)
1377 {
1378 sprintf(errmsg,
1379 "minute value is out of range 0 - 59: %d (ffs2tm)", *minute);
1380 ffpmsg(errmsg);
1381 return(*status = BAD_DATE);
1382 }
1383
1384 if (second)
1385 if (*second < 0 || *second >= 61.)
1386 {
1387 sprintf(errmsg,
1388 "second value is out of range 0 - 60.9999: %f (ffs2tm)", *second);
1389 ffpmsg(errmsg);
1390 return(*status = BAD_DATE);
1391 }
1392
1393 return(*status);
1394 }
1395 /*--------------------------------------------------------------------------*/
ffgsdt(int * day,int * month,int * year,int * status)1396 int ffgsdt( int *day, int *month, int *year, int *status )
1397 {
1398 /*
1399 This routine is included for backward compatibility
1400 with the Fortran FITSIO library.
1401
1402 ffgsdt : Get current System DaTe (GMT if available)
1403
1404 Return integer values of the day, month, and year
1405
1406 Function parameters:
1407 day Day of the month
1408 month Numerical month (1=Jan, etc.)
1409 year Year (1999, 2000, etc.)
1410 status output error status
1411
1412 */
1413 time_t now;
1414 struct tm *date;
1415
1416 now = time( NULL );
1417 date = gmtime(&now); /* get GMT (= UTC) time */
1418
1419 if (!date) /* GMT not available on this machine */
1420 {
1421 date = localtime(&now);
1422 }
1423
1424 *day = date->tm_mday;
1425 *month = date->tm_mon + 1;
1426 *year = date->tm_year + 1900; /* tm_year is defined as years since 1900 */
1427 return( *status );
1428 }
1429 /*--------------------------------------------------------------------------*/
ffpkns(fitsfile * fptr,const char * keyroot,int nstart,int nkey,char * value[],char * comm[],int * status)1430 int ffpkns( fitsfile *fptr, /* I - FITS file pointer */
1431 const char *keyroot, /* I - root name of keywords to write */
1432 int nstart, /* I - starting index number */
1433 int nkey, /* I - number of keywords to write */
1434 char *value[], /* I - array of pointers to keyword values */
1435 char *comm[], /* I - array of pointers to keyword comment */
1436 int *status) /* IO - error status */
1437 /*
1438 Write (put) an indexed array of keywords with index numbers between
1439 NSTART and (NSTART + NKEY -1) inclusive. Writes string keywords.
1440 The value strings will be truncated at 68 characters, and the HEASARC
1441 long string keyword convention is not supported by this routine.
1442 */
1443 {
1444 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1445 int ii, jj, repeat, len;
1446
1447 if (*status > 0) /* inherit input status value if > 0 */
1448 return(*status);
1449
1450 /* check if first comment string is to be repeated for all the keywords */
1451 /* by looking to see if the last non-blank character is a '&' char */
1452
1453 repeat = 0;
1454
1455 if (comm)
1456 {
1457 len = strlen(comm[0]);
1458
1459 while (len > 0 && comm[0][len - 1] == ' ')
1460 len--; /* ignore trailing blanks */
1461
1462 if (comm[0][len - 1] == '&')
1463 {
1464 len = minvalue(len, FLEN_COMMENT);
1465 tcomment[0] = '\0';
1466 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1467 repeat = 1;
1468 }
1469 }
1470 else
1471 {
1472 repeat = 1;
1473 tcomment[0] = '\0';
1474 }
1475
1476 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1477 {
1478 ffkeyn(keyroot, jj, keyname, status);
1479 if (repeat)
1480 ffpkys(fptr, keyname, value[ii], tcomment, status);
1481 else
1482 ffpkys(fptr, keyname, value[ii], comm[ii], status);
1483
1484 if (*status > 0)
1485 return(*status);
1486 }
1487 return(*status);
1488 }
1489 /*--------------------------------------------------------------------------*/
ffpknl(fitsfile * fptr,const char * keyroot,int nstart,int nkey,int * value,char * comm[],int * status)1490 int ffpknl( fitsfile *fptr, /* I - FITS file pointer */
1491 const char *keyroot, /* I - root name of keywords to write */
1492 int nstart, /* I - starting index number */
1493 int nkey, /* I - number of keywords to write */
1494 int *value, /* I - array of keyword values */
1495 char *comm[], /* I - array of pointers to keyword comment */
1496 int *status) /* IO - error status */
1497 /*
1498 Write (put) an indexed array of keywords with index numbers between
1499 NSTART and (NSTART + NKEY -1) inclusive. Writes logical keywords
1500 Values equal to zero will be written as a False FITS keyword value; any
1501 other non-zero value will result in a True FITS keyword.
1502 */
1503 {
1504 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1505 int ii, jj, repeat, len;
1506
1507 if (*status > 0) /* inherit input status value if > 0 */
1508 return(*status);
1509
1510 /* check if first comment string is to be repeated for all the keywords */
1511 /* by looking to see if the last non-blank character is a '&' char */
1512
1513 repeat = 0;
1514 if (comm)
1515 {
1516 len = strlen(comm[0]);
1517
1518 while (len > 0 && comm[0][len - 1] == ' ')
1519 len--; /* ignore trailing blanks */
1520
1521 if (comm[0][len - 1] == '&')
1522 {
1523 len = minvalue(len, FLEN_COMMENT);
1524 tcomment[0] = '\0';
1525 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1526 repeat = 1;
1527 }
1528 }
1529 else
1530 {
1531 repeat = 1;
1532 tcomment[0] = '\0';
1533 }
1534
1535
1536 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1537 {
1538 ffkeyn(keyroot, jj, keyname, status);
1539
1540 if (repeat)
1541 ffpkyl(fptr, keyname, value[ii], tcomment, status);
1542 else
1543 ffpkyl(fptr, keyname, value[ii], comm[ii], status);
1544
1545 if (*status > 0)
1546 return(*status);
1547 }
1548 return(*status);
1549 }
1550 /*--------------------------------------------------------------------------*/
ffpknj(fitsfile * fptr,const char * keyroot,int nstart,int nkey,long * value,char * comm[],int * status)1551 int ffpknj( fitsfile *fptr, /* I - FITS file pointer */
1552 const char *keyroot, /* I - root name of keywords to write */
1553 int nstart, /* I - starting index number */
1554 int nkey, /* I - number of keywords to write */
1555 long *value, /* I - array of keyword values */
1556 char *comm[], /* I - array of pointers to keyword comment */
1557 int *status) /* IO - error status */
1558 /*
1559 Write (put) an indexed array of keywords with index numbers between
1560 NSTART and (NSTART + NKEY -1) inclusive. Write integer keywords
1561 */
1562 {
1563 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1564 int ii, jj, repeat, len;
1565
1566 if (*status > 0) /* inherit input status value if > 0 */
1567 return(*status);
1568
1569 /* check if first comment string is to be repeated for all the keywords */
1570 /* by looking to see if the last non-blank character is a '&' char */
1571
1572 repeat = 0;
1573
1574 if (comm)
1575 {
1576 len = strlen(comm[0]);
1577
1578 while (len > 0 && comm[0][len - 1] == ' ')
1579 len--; /* ignore trailing blanks */
1580
1581 if (comm[0][len - 1] == '&')
1582 {
1583 len = minvalue(len, FLEN_COMMENT);
1584 tcomment[0] = '\0';
1585 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1586 repeat = 1;
1587 }
1588 }
1589 else
1590 {
1591 repeat = 1;
1592 tcomment[0] = '\0';
1593 }
1594
1595 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1596 {
1597 ffkeyn(keyroot, jj, keyname, status);
1598 if (repeat)
1599 ffpkyj(fptr, keyname, value[ii], tcomment, status);
1600 else
1601 ffpkyj(fptr, keyname, value[ii], comm[ii], status);
1602
1603 if (*status > 0)
1604 return(*status);
1605 }
1606 return(*status);
1607 }
1608 /*--------------------------------------------------------------------------*/
ffpknjj(fitsfile * fptr,const char * keyroot,int nstart,int nkey,LONGLONG * value,char * comm[],int * status)1609 int ffpknjj( fitsfile *fptr, /* I - FITS file pointer */
1610 const char *keyroot, /* I - root name of keywords to write */
1611 int nstart, /* I - starting index number */
1612 int nkey, /* I - number of keywords to write */
1613 LONGLONG *value, /* I - array of keyword values */
1614 char *comm[], /* I - array of pointers to keyword comment */
1615 int *status) /* IO - error status */
1616 /*
1617 Write (put) an indexed array of keywords with index numbers between
1618 NSTART and (NSTART + NKEY -1) inclusive. Write integer keywords
1619 */
1620 {
1621 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1622 int ii, jj, repeat, len;
1623
1624 if (*status > 0) /* inherit input status value if > 0 */
1625 return(*status);
1626
1627 /* check if first comment string is to be repeated for all the keywords */
1628 /* by looking to see if the last non-blank character is a '&' char */
1629
1630 repeat = 0;
1631
1632 if (comm)
1633 {
1634 len = strlen(comm[0]);
1635
1636 while (len > 0 && comm[0][len - 1] == ' ')
1637 len--; /* ignore trailing blanks */
1638
1639 if (comm[0][len - 1] == '&')
1640 {
1641 len = minvalue(len, FLEN_COMMENT);
1642 tcomment[0] = '\0';
1643 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1644 repeat = 1;
1645 }
1646 }
1647 else
1648 {
1649 repeat = 1;
1650 tcomment[0] = '\0';
1651 }
1652
1653 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1654 {
1655 ffkeyn(keyroot, jj, keyname, status);
1656 if (repeat)
1657 ffpkyj(fptr, keyname, value[ii], tcomment, status);
1658 else
1659 ffpkyj(fptr, keyname, value[ii], comm[ii], status);
1660
1661 if (*status > 0)
1662 return(*status);
1663 }
1664 return(*status);
1665 }
1666 /*--------------------------------------------------------------------------*/
ffpknf(fitsfile * fptr,const char * keyroot,int nstart,int nkey,float * value,int decim,char * comm[],int * status)1667 int ffpknf( fitsfile *fptr, /* I - FITS file pointer */
1668 const char *keyroot, /* I - root name of keywords to write */
1669 int nstart, /* I - starting index number */
1670 int nkey, /* I - number of keywords to write */
1671 float *value, /* I - array of keyword values */
1672 int decim, /* I - number of decimals to display */
1673 char *comm[], /* I - array of pointers to keyword comment */
1674 int *status) /* IO - error status */
1675 /*
1676 Write (put) an indexed array of keywords with index numbers between
1677 NSTART and (NSTART + NKEY -1) inclusive. Writes fixed float values.
1678 */
1679 {
1680 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1681 int ii, jj, repeat, len;
1682
1683 if (*status > 0) /* inherit input status value if > 0 */
1684 return(*status);
1685
1686 /* check if first comment string is to be repeated for all the keywords */
1687 /* by looking to see if the last non-blank character is a '&' char */
1688
1689 repeat = 0;
1690
1691 if (comm)
1692 {
1693 len = strlen(comm[0]);
1694
1695 while (len > 0 && comm[0][len - 1] == ' ')
1696 len--; /* ignore trailing blanks */
1697
1698 if (comm[0][len - 1] == '&')
1699 {
1700 len = minvalue(len, FLEN_COMMENT);
1701 tcomment[0] = '\0';
1702 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1703 repeat = 1;
1704 }
1705 }
1706 else
1707 {
1708 repeat = 1;
1709 tcomment[0] = '\0';
1710 }
1711
1712 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1713 {
1714 ffkeyn(keyroot, jj, keyname, status);
1715 if (repeat)
1716 ffpkyf(fptr, keyname, value[ii], decim, tcomment, status);
1717 else
1718 ffpkyf(fptr, keyname, value[ii], decim, comm[ii], status);
1719
1720 if (*status > 0)
1721 return(*status);
1722 }
1723 return(*status);
1724 }
1725 /*--------------------------------------------------------------------------*/
ffpkne(fitsfile * fptr,const char * keyroot,int nstart,int nkey,float * value,int decim,char * comm[],int * status)1726 int ffpkne( fitsfile *fptr, /* I - FITS file pointer */
1727 const char *keyroot, /* I - root name of keywords to write */
1728 int nstart, /* I - starting index number */
1729 int nkey, /* I - number of keywords to write */
1730 float *value, /* I - array of keyword values */
1731 int decim, /* I - number of decimals to display */
1732 char *comm[], /* I - array of pointers to keyword comment */
1733 int *status) /* IO - error status */
1734 /*
1735 Write (put) an indexed array of keywords with index numbers between
1736 NSTART and (NSTART + NKEY -1) inclusive. Writes exponential float values.
1737 */
1738 {
1739 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1740 int ii, jj, repeat, len;
1741
1742 if (*status > 0) /* inherit input status value if > 0 */
1743 return(*status);
1744
1745 /* check if first comment string is to be repeated for all the keywords */
1746 /* by looking to see if the last non-blank character is a '&' char */
1747
1748 repeat = 0;
1749
1750 if (comm)
1751 {
1752 len = strlen(comm[0]);
1753
1754 while (len > 0 && comm[0][len - 1] == ' ')
1755 len--; /* ignore trailing blanks */
1756
1757 if (comm[0][len - 1] == '&')
1758 {
1759 len = minvalue(len, FLEN_COMMENT);
1760 tcomment[0] = '\0';
1761 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1762 repeat = 1;
1763 }
1764 }
1765 else
1766 {
1767 repeat = 1;
1768 tcomment[0] = '\0';
1769 }
1770
1771 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1772 {
1773 ffkeyn(keyroot, jj, keyname, status);
1774 if (repeat)
1775 ffpkye(fptr, keyname, value[ii], decim, tcomment, status);
1776 else
1777 ffpkye(fptr, keyname, value[ii], decim, comm[ii], status);
1778
1779 if (*status > 0)
1780 return(*status);
1781 }
1782 return(*status);
1783 }
1784 /*--------------------------------------------------------------------------*/
ffpkng(fitsfile * fptr,const char * keyroot,int nstart,int nkey,double * value,int decim,char * comm[],int * status)1785 int ffpkng( fitsfile *fptr, /* I - FITS file pointer */
1786 const char *keyroot, /* I - root name of keywords to write */
1787 int nstart, /* I - starting index number */
1788 int nkey, /* I - number of keywords to write */
1789 double *value, /* I - array of keyword values */
1790 int decim, /* I - number of decimals to display */
1791 char *comm[], /* I - array of pointers to keyword comment */
1792 int *status) /* IO - error status */
1793 /*
1794 Write (put) an indexed array of keywords with index numbers between
1795 NSTART and (NSTART + NKEY -1) inclusive. Writes fixed double values.
1796 */
1797 {
1798 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1799 int ii, jj, repeat, len;
1800
1801 if (*status > 0) /* inherit input status value if > 0 */
1802 return(*status);
1803
1804 /* check if first comment string is to be repeated for all the keywords */
1805 /* by looking to see if the last non-blank character is a '&' char */
1806
1807 repeat = 0;
1808
1809 if (comm)
1810 {
1811 len = strlen(comm[0]);
1812
1813 while (len > 0 && comm[0][len - 1] == ' ')
1814 len--; /* ignore trailing blanks */
1815
1816 if (comm[0][len - 1] == '&')
1817 {
1818 len = minvalue(len, FLEN_COMMENT);
1819 tcomment[0] = '\0';
1820 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1821 repeat = 1;
1822 }
1823 }
1824 else
1825 {
1826 repeat = 1;
1827 tcomment[0] = '\0';
1828 }
1829
1830 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1831 {
1832 ffkeyn(keyroot, jj, keyname, status);
1833 if (repeat)
1834 ffpkyg(fptr, keyname, value[ii], decim, tcomment, status);
1835 else
1836 ffpkyg(fptr, keyname, value[ii], decim, comm[ii], status);
1837
1838 if (*status > 0)
1839 return(*status);
1840 }
1841 return(*status);
1842 }
1843 /*--------------------------------------------------------------------------*/
ffpknd(fitsfile * fptr,const char * keyroot,int nstart,int nkey,double * value,int decim,char * comm[],int * status)1844 int ffpknd( fitsfile *fptr, /* I - FITS file pointer */
1845 const char *keyroot, /* I - root name of keywords to write */
1846 int nstart, /* I - starting index number */
1847 int nkey, /* I - number of keywords to write */
1848 double *value, /* I - array of keyword values */
1849 int decim, /* I - number of decimals to display */
1850 char *comm[], /* I - array of pointers to keyword comment */
1851 int *status) /* IO - error status */
1852 /*
1853 Write (put) an indexed array of keywords with index numbers between
1854 NSTART and (NSTART + NKEY -1) inclusive. Writes exponential double values.
1855 */
1856 {
1857 char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
1858 int ii, jj, repeat, len;
1859
1860 if (*status > 0) /* inherit input status value if > 0 */
1861 return(*status);
1862
1863 /* check if first comment string is to be repeated for all the keywords */
1864 /* by looking to see if the last non-blank character is a '&' char */
1865
1866 repeat = 0;
1867
1868 if (comm)
1869 {
1870 len = strlen(comm[0]);
1871
1872 while (len > 0 && comm[0][len - 1] == ' ')
1873 len--; /* ignore trailing blanks */
1874
1875 if (comm[0][len - 1] == '&')
1876 {
1877 len = minvalue(len, FLEN_COMMENT);
1878 tcomment[0] = '\0';
1879 strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
1880 repeat = 1;
1881 }
1882 }
1883 else
1884 {
1885 repeat = 1;
1886 tcomment[0] = '\0';
1887 }
1888
1889 for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
1890 {
1891 ffkeyn(keyroot, jj, keyname, status);
1892 if (repeat)
1893 ffpkyd(fptr, keyname, value[ii], decim, tcomment, status);
1894 else
1895 ffpkyd(fptr, keyname, value[ii], decim, comm[ii], status);
1896
1897 if (*status > 0)
1898 return(*status);
1899 }
1900 return(*status);
1901 }
1902 /*--------------------------------------------------------------------------*/
ffptdm(fitsfile * fptr,int colnum,int naxis,long naxes[],int * status)1903 int ffptdm( fitsfile *fptr, /* I - FITS file pointer */
1904 int colnum, /* I - column number */
1905 int naxis, /* I - number of axes in the data array */
1906 long naxes[], /* I - length of each data axis */
1907 int *status) /* IO - error status */
1908 /*
1909 write the TDIMnnn keyword describing the dimensionality of a column
1910 */
1911 {
1912 char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT];
1913 char value[80], message[81];
1914 int ii;
1915 long totalpix = 1, repeat;
1916 tcolumn *colptr;
1917
1918 if (*status > 0)
1919 return(*status);
1920
1921 if (colnum < 1 || colnum > 999)
1922 {
1923 ffpmsg("column number is out of range 1 - 999 (ffptdm)");
1924 return(*status = BAD_COL_NUM);
1925 }
1926
1927 if (naxis < 1)
1928 {
1929 ffpmsg("naxis is less than 1 (ffptdm)");
1930 return(*status = BAD_DIMEN);
1931 }
1932
1933 /* reset position to the correct HDU if necessary */
1934 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
1935 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
1936 else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
1937 if ( ffrdef(fptr, status) > 0) /* rescan header */
1938 return(*status);
1939
1940 if ( (fptr->Fptr)->hdutype != BINARY_TBL)
1941 {
1942 ffpmsg(
1943 "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)");
1944 return(*status = NOT_BTABLE);
1945 }
1946
1947 strcpy(tdimstr, "("); /* start constructing the TDIM value */
1948
1949 for (ii = 0; ii < naxis; ii++)
1950 {
1951 if (ii > 0)
1952 strcat(tdimstr, ","); /* append the comma separator */
1953
1954 if (naxes[ii] < 0)
1955 {
1956 ffpmsg("one or more TDIM values are less than 0 (ffptdm)");
1957 return(*status = BAD_TDIM);
1958 }
1959
1960 sprintf(value, "%ld", naxes[ii]);
1961 strcat(tdimstr, value); /* append the axis size */
1962
1963 totalpix *= naxes[ii];
1964 }
1965
1966 colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
1967 colptr += (colnum - 1); /* point to the specified column number */
1968
1969 if ((long) colptr->trepeat != totalpix)
1970 {
1971 /* There is an apparent inconsistency between TDIMn and TFORMn. */
1972 /* The colptr->trepeat value may be out of date, so re-read */
1973 /* the TFORMn keyword to be sure. */
1974
1975 ffkeyn("TFORM", colnum, keyname, status); /* construct TFORMn name */
1976 ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword */
1977 ffbnfm(value, NULL, &repeat, NULL, status); /* parse the repeat count */
1978
1979 if (*status > 0 || repeat != totalpix)
1980 {
1981 sprintf(message,
1982 "column vector length, %ld, does not equal TDIMn array size, %ld",
1983 (long) colptr->trepeat, totalpix);
1984 ffpmsg(message);
1985 return(*status = BAD_TDIM);
1986 }
1987 }
1988
1989 strcat(tdimstr, ")" ); /* append the closing parenthesis */
1990
1991 strcpy(comm, "size of the multidimensional array");
1992 ffkeyn("TDIM", colnum, keyname, status); /* construct TDIMn name */
1993 ffpkys(fptr, keyname, tdimstr, comm, status); /* write the keyword */
1994 return(*status);
1995 }
1996 /*--------------------------------------------------------------------------*/
ffptdmll(fitsfile * fptr,int colnum,int naxis,LONGLONG naxes[],int * status)1997 int ffptdmll( fitsfile *fptr, /* I - FITS file pointer */
1998 int colnum, /* I - column number */
1999 int naxis, /* I - number of axes in the data array */
2000 LONGLONG naxes[], /* I - length of each data axis */
2001 int *status) /* IO - error status */
2002 /*
2003 write the TDIMnnn keyword describing the dimensionality of a column
2004 */
2005 {
2006 char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT];
2007 char value[80], message[81];
2008 int ii;
2009 LONGLONG totalpix = 1, repeat;
2010 tcolumn *colptr;
2011
2012 if (*status > 0)
2013 return(*status);
2014
2015 if (colnum < 1 || colnum > 999)
2016 {
2017 ffpmsg("column number is out of range 1 - 999 (ffptdm)");
2018 return(*status = BAD_COL_NUM);
2019 }
2020
2021 if (naxis < 1)
2022 {
2023 ffpmsg("naxis is less than 1 (ffptdm)");
2024 return(*status = BAD_DIMEN);
2025 }
2026
2027 /* reset position to the correct HDU if necessary */
2028 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
2029 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
2030 else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
2031 if ( ffrdef(fptr, status) > 0) /* rescan header */
2032 return(*status);
2033
2034 if ( (fptr->Fptr)->hdutype != BINARY_TBL)
2035 {
2036 ffpmsg(
2037 "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)");
2038 return(*status = NOT_BTABLE);
2039 }
2040
2041 strcpy(tdimstr, "("); /* start constructing the TDIM value */
2042
2043 for (ii = 0; ii < naxis; ii++)
2044 {
2045 if (ii > 0)
2046 strcat(tdimstr, ","); /* append the comma separator */
2047
2048 if (naxes[ii] < 0)
2049 {
2050 ffpmsg("one or more TDIM values are less than 0 (ffptdm)");
2051 return(*status = BAD_TDIM);
2052 }
2053
2054 /* cast to double because the 64-bit int conversion character in */
2055 /* sprintf is platform dependent ( %lld, %ld, %I64d ) */
2056
2057 sprintf(value, "%.0f", (double) naxes[ii]);
2058
2059 strcat(tdimstr, value); /* append the axis size */
2060
2061 totalpix *= naxes[ii];
2062 }
2063
2064 colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
2065 colptr += (colnum - 1); /* point to the specified column number */
2066
2067 if ( colptr->trepeat != totalpix)
2068 {
2069 /* There is an apparent inconsistency between TDIMn and TFORMn. */
2070 /* The colptr->trepeat value may be out of date, so re-read */
2071 /* the TFORMn keyword to be sure. */
2072
2073 ffkeyn("TFORM", colnum, keyname, status); /* construct TFORMn name */
2074 ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword */
2075 ffbnfmll(value, NULL, &repeat, NULL, status); /* parse the repeat count */
2076
2077 if (*status > 0 || repeat != totalpix)
2078 {
2079 sprintf(message,
2080 "column vector length, %.0f, does not equal TDIMn array size, %.0f",
2081 (double) (colptr->trepeat), (double) totalpix);
2082 ffpmsg(message);
2083 return(*status = BAD_TDIM);
2084 }
2085 }
2086
2087 strcat(tdimstr, ")" ); /* append the closing parenthesis */
2088
2089 strcpy(comm, "size of the multidimensional array");
2090 ffkeyn("TDIM", colnum, keyname, status); /* construct TDIMn name */
2091 ffpkys(fptr, keyname, tdimstr, comm, status); /* write the keyword */
2092 return(*status);
2093 }
2094 /*--------------------------------------------------------------------------*/
ffphps(fitsfile * fptr,int bitpix,int naxis,long naxes[],int * status)2095 int ffphps( fitsfile *fptr, /* I - FITS file pointer */
2096 int bitpix, /* I - number of bits per data value pixel */
2097 int naxis, /* I - number of axes in the data array */
2098 long naxes[], /* I - length of each data axis */
2099 int *status) /* IO - error status */
2100 /*
2101 write STANDARD set of required primary header keywords
2102 */
2103 {
2104 int simple = 1; /* does file conform to FITS standard? 1/0 */
2105 long pcount = 0; /* number of group parameters (usually 0) */
2106 long gcount = 1; /* number of random groups (usually 1 or 0) */
2107 int extend = 1; /* may FITS file have extensions? */
2108
2109 ffphpr(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status);
2110 return(*status);
2111 }
2112 /*--------------------------------------------------------------------------*/
ffphpsll(fitsfile * fptr,int bitpix,int naxis,LONGLONG naxes[],int * status)2113 int ffphpsll( fitsfile *fptr, /* I - FITS file pointer */
2114 int bitpix, /* I - number of bits per data value pixel */
2115 int naxis, /* I - number of axes in the data array */
2116 LONGLONG naxes[], /* I - length of each data axis */
2117 int *status) /* IO - error status */
2118 /*
2119 write STANDARD set of required primary header keywords
2120 */
2121 {
2122 int simple = 1; /* does file conform to FITS standard? 1/0 */
2123 LONGLONG pcount = 0; /* number of group parameters (usually 0) */
2124 LONGLONG gcount = 1; /* number of random groups (usually 1 or 0) */
2125 int extend = 1; /* may FITS file have extensions? */
2126
2127 ffphprll(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status);
2128 return(*status);
2129 }
2130 /*--------------------------------------------------------------------------*/
ffphpr(fitsfile * fptr,int simple,int bitpix,int naxis,long naxes[],LONGLONG pcount,LONGLONG gcount,int extend,int * status)2131 int ffphpr( fitsfile *fptr, /* I - FITS file pointer */
2132 int simple, /* I - does file conform to FITS standard? 1/0 */
2133 int bitpix, /* I - number of bits per data value pixel */
2134 int naxis, /* I - number of axes in the data array */
2135 long naxes[], /* I - length of each data axis */
2136 LONGLONG pcount, /* I - number of group parameters (usually 0) */
2137 LONGLONG gcount, /* I - number of random groups (usually 1 or 0) */
2138 int extend, /* I - may FITS file have extensions? */
2139 int *status) /* IO - error status */
2140 /*
2141 write required primary header keywords
2142 */
2143 {
2144 int ii;
2145 LONGLONG naxesll[20];
2146
2147 for (ii = 0; (ii < naxis) && (ii < 20); ii++)
2148 naxesll[ii] = naxes[ii];
2149
2150 ffphprll(fptr, simple, bitpix, naxis, naxesll, pcount, gcount,
2151 extend, status);
2152
2153 return(*status);
2154 }
2155 /*--------------------------------------------------------------------------*/
ffphprll(fitsfile * fptr,int simple,int bitpix,int naxis,LONGLONG naxes[],LONGLONG pcount,LONGLONG gcount,int extend,int * status)2156 int ffphprll( fitsfile *fptr, /* I - FITS file pointer */
2157 int simple, /* I - does file conform to FITS standard? 1/0 */
2158 int bitpix, /* I - number of bits per data value pixel */
2159 int naxis, /* I - number of axes in the data array */
2160 LONGLONG naxes[], /* I - length of each data axis */
2161 LONGLONG pcount, /* I - number of group parameters (usually 0) */
2162 LONGLONG gcount, /* I - number of random groups (usually 1 or 0) */
2163 int extend, /* I - may FITS file have extensions? */
2164 int *status) /* IO - error status */
2165 /*
2166 write required primary header keywords
2167 */
2168 {
2169 int ii;
2170 long longbitpix, tnaxes[20];
2171 char name[FLEN_KEYWORD], comm[FLEN_COMMENT], message[FLEN_ERRMSG];
2172
2173 if (*status > 0)
2174 return(*status);
2175
2176 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
2177 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
2178
2179 if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
2180 return(*status = HEADER_NOT_EMPTY);
2181
2182 if (naxis != 0) /* never try to compress a null image */
2183 {
2184 if ( (fptr->Fptr)->request_compress_type )
2185 {
2186
2187 for (ii = 0; ii < naxis; ii++)
2188 tnaxes[ii] = (long) naxes[ii];
2189
2190 /* write header for a compressed image */
2191 imcomp_init_table(fptr, bitpix, naxis, tnaxes, 1, status);
2192 return(*status);
2193 }
2194 }
2195
2196 if ((fptr->Fptr)->curhdu == 0)
2197 { /* write primary array header */
2198 if (simple)
2199 strcpy(comm, "file does conform to FITS standard");
2200 else
2201 strcpy(comm, "file does not conform to FITS standard");
2202
2203 ffpkyl(fptr, "SIMPLE", simple, comm, status);
2204 }
2205 else
2206 { /* write IMAGE extension header */
2207 strcpy(comm, "IMAGE extension");
2208 ffpkys(fptr, "XTENSION", "IMAGE", comm, status);
2209 }
2210
2211 longbitpix = bitpix;
2212
2213 /* test for the 3 special cases that represent unsigned integers */
2214 if (longbitpix == USHORT_IMG)
2215 longbitpix = SHORT_IMG;
2216 else if (longbitpix == ULONG_IMG)
2217 longbitpix = LONG_IMG;
2218 else if (longbitpix == SBYTE_IMG)
2219 longbitpix = BYTE_IMG;
2220
2221 if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG &&
2222 longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG &&
2223 longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG)
2224 {
2225 sprintf(message,
2226 "Illegal value for BITPIX keyword: %d", bitpix);
2227 ffpmsg(message);
2228 return(*status = BAD_BITPIX);
2229 }
2230
2231 strcpy(comm, "number of bits per data pixel");
2232 if (ffpkyj(fptr, "BITPIX", longbitpix, comm, status) > 0)
2233 return(*status);
2234
2235 if (naxis < 0 || naxis > 999)
2236 {
2237 sprintf(message,
2238 "Illegal value for NAXIS keyword: %d", naxis);
2239 ffpmsg(message);
2240 return(*status = BAD_NAXIS);
2241 }
2242
2243 strcpy(comm, "number of data axes");
2244 ffpkyj(fptr, "NAXIS", naxis, comm, status);
2245
2246 strcpy(comm, "length of data axis ");
2247 for (ii = 0; ii < naxis; ii++)
2248 {
2249 if (naxes[ii] < 0)
2250 {
2251 sprintf(message,
2252 "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
2253 ffpmsg(message);
2254 return(*status = BAD_NAXES);
2255 }
2256
2257 sprintf(&comm[20], "%d", ii + 1);
2258 ffkeyn("NAXIS", ii + 1, name, status);
2259 ffpkyj(fptr, name, naxes[ii], comm, status);
2260 }
2261
2262 if ((fptr->Fptr)->curhdu == 0) /* the primary array */
2263 {
2264 if (extend)
2265 {
2266 /* only write EXTEND keyword if value = true */
2267 strcpy(comm, "FITS dataset may contain extensions");
2268 ffpkyl(fptr, "EXTEND", extend, comm, status);
2269 }
2270
2271 if (pcount < 0)
2272 {
2273 ffpmsg("pcount value is less than 0");
2274 return(*status = BAD_PCOUNT);
2275 }
2276
2277 else if (gcount < 1)
2278 {
2279 ffpmsg("gcount value is less than 1");
2280 return(*status = BAD_GCOUNT);
2281 }
2282
2283 else if (pcount > 0 || gcount > 1)
2284 {
2285 /* only write these keyword if non-standard values */
2286 strcpy(comm, "random group records are present");
2287 ffpkyl(fptr, "GROUPS", 1, comm, status);
2288
2289 strcpy(comm, "number of random group parameters");
2290 ffpkyj(fptr, "PCOUNT", pcount, comm, status);
2291
2292 strcpy(comm, "number of random groups");
2293 ffpkyj(fptr, "GCOUNT", gcount, comm, status);
2294 }
2295
2296 /* write standard block of self-documentating comments */
2297 ffprec(fptr,
2298 "COMMENT FITS (Flexible Image Transport System) format is defined in 'Astronomy",
2299 status);
2300 ffprec(fptr,
2301 "COMMENT and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H",
2302 status);
2303 }
2304
2305 else /* an IMAGE extension */
2306
2307 { /* image extension; cannot have random groups */
2308 if (pcount != 0)
2309 {
2310 ffpmsg("image extensions must have pcount = 0");
2311 *status = BAD_PCOUNT;
2312 }
2313
2314 else if (gcount != 1)
2315 {
2316 ffpmsg("image extensions must have gcount = 1");
2317 *status = BAD_GCOUNT;
2318 }
2319
2320 else
2321 {
2322 strcpy(comm, "required keyword; must = 0");
2323 ffpkyj(fptr, "PCOUNT", 0, comm, status);
2324
2325 strcpy(comm, "required keyword; must = 1");
2326 ffpkyj(fptr, "GCOUNT", 1, comm, status);
2327 }
2328 }
2329
2330 /* Write the BSCALE and BZERO keywords, if an unsigned integer image */
2331 if (bitpix == USHORT_IMG)
2332 {
2333 strcpy(comm, "offset data range to that of unsigned short");
2334 ffpkyg(fptr, "BZERO", 32768., 0, comm, status);
2335 strcpy(comm, "default scaling factor");
2336 ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
2337 }
2338 else if (bitpix == ULONG_IMG)
2339 {
2340 strcpy(comm, "offset data range to that of unsigned long");
2341 ffpkyg(fptr, "BZERO", 2147483648., 0, comm, status);
2342 strcpy(comm, "default scaling factor");
2343 ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
2344 }
2345 else if (bitpix == SBYTE_IMG)
2346 {
2347 strcpy(comm, "offset data range to that of signed byte");
2348 ffpkyg(fptr, "BZERO", -128., 0, comm, status);
2349 strcpy(comm, "default scaling factor");
2350 ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
2351 }
2352 return(*status);
2353 }
2354 /*--------------------------------------------------------------------------*/
ffphtb(fitsfile * fptr,LONGLONG naxis1,LONGLONG naxis2,int tfields,char ** ttype,long * tbcol,char ** tform,char ** tunit,const char * extnmx,int * status)2355 int ffphtb(fitsfile *fptr, /* I - FITS file pointer */
2356 LONGLONG naxis1, /* I - width of row in the table */
2357 LONGLONG naxis2, /* I - number of rows in the table */
2358 int tfields, /* I - number of columns in the table */
2359 char **ttype, /* I - name of each column */
2360 long *tbcol, /* I - byte offset in row to each column */
2361 char **tform, /* I - value of TFORMn keyword for each column */
2362 char **tunit, /* I - value of TUNITn keyword for each column */
2363 const char *extnmx, /* I - value of EXTNAME keyword, if any */
2364 int *status) /* IO - error status */
2365 /*
2366 Put required Header keywords into the ASCII TaBle:
2367 */
2368 {
2369 int ii, ncols, gotmem = 0;
2370 long rowlen; /* must be 'long' because it is passed to ffgabc */
2371 char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT], extnm[FLEN_VALUE];
2372
2373 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
2374 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
2375
2376 if (*status > 0)
2377 return(*status);
2378 else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
2379 return(*status = HEADER_NOT_EMPTY);
2380 else if (naxis1 < 0)
2381 return(*status = NEG_WIDTH);
2382 else if (naxis2 < 0)
2383 return(*status = NEG_ROWS);
2384 else if (tfields < 0 || tfields > 999)
2385 return(*status = BAD_TFIELDS);
2386
2387 extnm[0] = '\0';
2388 if (extnmx)
2389 strncat(extnm, extnmx, FLEN_VALUE-1);
2390
2391 rowlen = (long) naxis1;
2392
2393 if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */
2394 {
2395 /* allocate mem for tbcol; malloc can have problems allocating small */
2396 /* arrays, so allocate at least 20 bytes */
2397
2398 ncols = maxvalue(5, tfields);
2399 tbcol = (long *) calloc(ncols, sizeof(long));
2400
2401 if (tbcol)
2402 {
2403 gotmem = 1;
2404
2405 /* calculate width of a row and starting position of each column. */
2406 /* Each column will be separated by 1 blank space */
2407 ffgabc(tfields, tform, 1, &rowlen, tbcol, status);
2408 }
2409 }
2410 ffpkys(fptr, "XTENSION", "TABLE", "ASCII table extension", status);
2411 ffpkyj(fptr, "BITPIX", 8, "8-bit ASCII characters", status);
2412 ffpkyj(fptr, "NAXIS", 2, "2-dimensional ASCII table", status);
2413 ffpkyj(fptr, "NAXIS1", rowlen, "width of table in characters", status);
2414 ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status);
2415 ffpkyj(fptr, "PCOUNT", 0, "no group parameters (required keyword)", status);
2416 ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status);
2417 ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status);
2418
2419 for (ii = 0; ii < tfields; ii++) /* loop over every column */
2420 {
2421 if ( *(ttype[ii]) ) /* optional TTYPEn keyword */
2422 {
2423 sprintf(comm, "label for field %3d", ii + 1);
2424 ffkeyn("TTYPE", ii + 1, name, status);
2425 ffpkys(fptr, name, ttype[ii], comm, status);
2426 }
2427
2428 if (tbcol[ii] < 1 || tbcol[ii] > rowlen)
2429 *status = BAD_TBCOL;
2430
2431 sprintf(comm, "beginning column of field %3d", ii + 1);
2432 ffkeyn("TBCOL", ii + 1, name, status);
2433 ffpkyj(fptr, name, tbcol[ii], comm, status);
2434
2435 strcpy(tfmt, tform[ii]); /* required TFORMn keyword */
2436 ffupch(tfmt);
2437 ffkeyn("TFORM", ii + 1, name, status);
2438 ffpkys(fptr, name, tfmt, "Fortran-77 format of field", status);
2439
2440 if (tunit)
2441 {
2442 if (tunit[ii] && *(tunit[ii]) ) /* optional TUNITn keyword */
2443 {
2444 ffkeyn("TUNIT", ii + 1, name, status);
2445 ffpkys(fptr, name, tunit[ii], "physical unit of field", status) ;
2446 }
2447 }
2448
2449 if (*status > 0)
2450 break; /* abort loop on error */
2451 }
2452
2453 if (extnm[0]) /* optional EXTNAME keyword */
2454 ffpkys(fptr, "EXTNAME", extnm,
2455 "name of this ASCII table extension", status);
2456
2457 if (*status > 0)
2458 ffpmsg("Failed to write ASCII table header keywords (ffphtb)");
2459
2460 if (gotmem)
2461 free(tbcol);
2462
2463 return(*status);
2464 }
2465 /*--------------------------------------------------------------------------*/
ffphbn(fitsfile * fptr,LONGLONG naxis2,int tfields,char ** ttype,char ** tform,char ** tunit,const char * extnmx,LONGLONG pcount,int * status)2466 int ffphbn(fitsfile *fptr, /* I - FITS file pointer */
2467 LONGLONG naxis2, /* I - number of rows in the table */
2468 int tfields, /* I - number of columns in the table */
2469 char **ttype, /* I - name of each column */
2470 char **tform, /* I - value of TFORMn keyword for each column */
2471 char **tunit, /* I - value of TUNITn keyword for each column */
2472 const char *extnmx, /* I - value of EXTNAME keyword, if any */
2473 LONGLONG pcount, /* I - size of the variable length heap area */
2474 int *status) /* IO - error status */
2475 /*
2476 Put required Header keywords into the Binary Table:
2477 */
2478 {
2479 int ii, datatype, iread = 0;
2480 long repeat, width;
2481 LONGLONG naxis1;
2482
2483 char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT], extnm[FLEN_VALUE];
2484 char *cptr;
2485
2486 if (*status > 0)
2487 return(*status);
2488
2489 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
2490 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
2491
2492 if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
2493 return(*status = HEADER_NOT_EMPTY);
2494 else if (naxis2 < 0)
2495 return(*status = NEG_ROWS);
2496 else if (pcount < 0)
2497 return(*status = BAD_PCOUNT);
2498 else if (tfields < 0 || tfields > 999)
2499 return(*status = BAD_TFIELDS);
2500
2501 extnm[0] = '\0';
2502 if (extnmx)
2503 strncat(extnm, extnmx, FLEN_VALUE-1);
2504
2505 ffpkys(fptr, "XTENSION", "BINTABLE", "binary table extension", status);
2506 ffpkyj(fptr, "BITPIX", 8, "8-bit bytes", status);
2507 ffpkyj(fptr, "NAXIS", 2, "2-dimensional binary table", status);
2508
2509 naxis1 = 0;
2510 for (ii = 0; ii < tfields; ii++) /* sum the width of each field */
2511 {
2512 ffbnfm(tform[ii], &datatype, &repeat, &width, status);
2513
2514 if (datatype == TSTRING)
2515 naxis1 += repeat; /* one byte per char */
2516 else if (datatype == TBIT)
2517 naxis1 += (repeat + 7) / 8;
2518 else if (datatype > 0)
2519 naxis1 += repeat * (datatype / 10);
2520 else if (tform[ii][0] == 'P' || tform[ii][1] == 'P')
2521 /* this is a 'P' variable length descriptor (neg. datatype) */
2522 naxis1 += 8;
2523 else
2524 /* this is a 'Q' variable length descriptor (neg. datatype) */
2525 naxis1 += 16;
2526
2527 if (*status > 0)
2528 break; /* abort loop on error */
2529 }
2530
2531 ffpkyj(fptr, "NAXIS1", naxis1, "width of table in bytes", status);
2532 ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status);
2533
2534 /*
2535 the initial value of PCOUNT (= size of the variable length array heap)
2536 should always be zero. If any variable length data is written, then
2537 the value of PCOUNT will be updated when the HDU is closed
2538 */
2539 ffpkyj(fptr, "PCOUNT", 0, "size of special data area", status);
2540 ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status);
2541 ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status);
2542
2543 for (ii = 0; ii < tfields; ii++) /* loop over every column */
2544 {
2545 if ( *(ttype[ii]) ) /* optional TTYPEn keyword */
2546 {
2547 sprintf(comm, "label for field %3d", ii + 1);
2548 ffkeyn("TTYPE", ii + 1, name, status);
2549 ffpkys(fptr, name, ttype[ii], comm, status);
2550 }
2551
2552 strcpy(tfmt, tform[ii]); /* required TFORMn keyword */
2553 ffupch(tfmt);
2554
2555 ffkeyn("TFORM", ii + 1, name, status);
2556 strcpy(comm, "data format of field");
2557
2558 ffbnfm(tfmt, &datatype, &repeat, &width, status);
2559
2560 if (datatype == TSTRING)
2561 {
2562 strcat(comm, ": ASCII Character");
2563
2564 /* Do sanity check to see if an ASCII table format was used, */
2565 /* e.g., 'A8' instead of '8A', or a bad unit width eg '8A9'. */
2566 /* Don't want to return an error status, so write error into */
2567 /* the keyword comment. */
2568
2569 cptr = strchr(tfmt,'A');
2570 cptr++;
2571
2572 if (cptr)
2573 iread = sscanf(cptr,"%ld", &width);
2574
2575 if (iread == 1 && (width > repeat))
2576 {
2577 if (repeat == 1)
2578 strcpy(comm, "ERROR?? USING ASCII TABLE SYNTAX BY MISTAKE??");
2579 else
2580 strcpy(comm, "rAw FORMAT ERROR! UNIT WIDTH w > COLUMN WIDTH r");
2581 }
2582 }
2583 else if (datatype == TBIT)
2584 strcat(comm, ": BIT");
2585 else if (datatype == TBYTE)
2586 strcat(comm, ": BYTE");
2587 else if (datatype == TLOGICAL)
2588 strcat(comm, ": 1-byte LOGICAL");
2589 else if (datatype == TSHORT)
2590 strcat(comm, ": 2-byte INTEGER");
2591 else if (datatype == TUSHORT)
2592 strcat(comm, ": 2-byte INTEGER");
2593 else if (datatype == TLONG)
2594 strcat(comm, ": 4-byte INTEGER");
2595 else if (datatype == TLONGLONG)
2596 strcat(comm, ": 8-byte INTEGER");
2597 else if (datatype == TULONG)
2598 strcat(comm, ": 4-byte INTEGER");
2599 else if (datatype == TFLOAT)
2600 strcat(comm, ": 4-byte REAL");
2601 else if (datatype == TDOUBLE)
2602 strcat(comm, ": 8-byte DOUBLE");
2603 else if (datatype == TCOMPLEX)
2604 strcat(comm, ": COMPLEX");
2605 else if (datatype == TDBLCOMPLEX)
2606 strcat(comm, ": DOUBLE COMPLEX");
2607 else if (datatype < 0)
2608 strcat(comm, ": variable length array");
2609
2610 if (abs(datatype) == TSBYTE) /* signed bytes */
2611 {
2612 /* Replace the 'S' with an 'B' in the TFORMn code */
2613 cptr = tfmt;
2614 while (*cptr != 'S')
2615 cptr++;
2616
2617 *cptr = 'B';
2618 ffpkys(fptr, name, tfmt, comm, status);
2619
2620 /* write the TZEROn and TSCALn keywords */
2621 ffkeyn("TZERO", ii + 1, name, status);
2622 strcpy(comm, "offset for signed bytes");
2623
2624 ffpkyg(fptr, name, -128., 0, comm, status);
2625
2626 ffkeyn("TSCAL", ii + 1, name, status);
2627 strcpy(comm, "data are not scaled");
2628 ffpkyg(fptr, name, 1., 0, comm, status);
2629 }
2630 else if (abs(datatype) == TUSHORT)
2631 {
2632 /* Replace the 'U' with an 'I' in the TFORMn code */
2633 cptr = tfmt;
2634 while (*cptr != 'U')
2635 cptr++;
2636
2637 *cptr = 'I';
2638 ffpkys(fptr, name, tfmt, comm, status);
2639
2640 /* write the TZEROn and TSCALn keywords */
2641 ffkeyn("TZERO", ii + 1, name, status);
2642 strcpy(comm, "offset for unsigned integers");
2643
2644 ffpkyg(fptr, name, 32768., 0, comm, status);
2645
2646 ffkeyn("TSCAL", ii + 1, name, status);
2647 strcpy(comm, "data are not scaled");
2648 ffpkyg(fptr, name, 1., 0, comm, status);
2649 }
2650 else if (abs(datatype) == TULONG)
2651 {
2652 /* Replace the 'V' with an 'J' in the TFORMn code */
2653 cptr = tfmt;
2654 while (*cptr != 'V')
2655 cptr++;
2656
2657 *cptr = 'J';
2658 ffpkys(fptr, name, tfmt, comm, status);
2659
2660 /* write the TZEROn and TSCALn keywords */
2661 ffkeyn("TZERO", ii + 1, name, status);
2662 strcpy(comm, "offset for unsigned integers");
2663
2664 ffpkyg(fptr, name, 2147483648., 0, comm, status);
2665
2666 ffkeyn("TSCAL", ii + 1, name, status);
2667 strcpy(comm, "data are not scaled");
2668 ffpkyg(fptr, name, 1., 0, comm, status);
2669 }
2670 else
2671 {
2672 ffpkys(fptr, name, tfmt, comm, status);
2673 }
2674
2675 if (tunit)
2676 {
2677 if (tunit[ii] && *(tunit[ii]) ) /* optional TUNITn keyword */
2678 {
2679 ffkeyn("TUNIT", ii + 1, name, status);
2680 ffpkys(fptr, name, tunit[ii],
2681 "physical unit of field", status);
2682 }
2683 }
2684
2685 if (*status > 0)
2686 break; /* abort loop on error */
2687 }
2688
2689 if (extnm[0]) /* optional EXTNAME keyword */
2690 ffpkys(fptr, "EXTNAME", extnm,
2691 "name of this binary table extension", status);
2692
2693 if (*status > 0)
2694 ffpmsg("Failed to write binary table header keywords (ffphbn)");
2695
2696 return(*status);
2697 }
2698 /*--------------------------------------------------------------------------*/
ffphext(fitsfile * fptr,const char * xtensionx,int bitpix,int naxis,long naxes[],LONGLONG pcount,LONGLONG gcount,int * status)2699 int ffphext(fitsfile *fptr, /* I - FITS file pointer */
2700 const char *xtensionx, /* I - value for the XTENSION keyword */
2701 int bitpix, /* I - value for the BIXPIX keyword */
2702 int naxis, /* I - value for the NAXIS keyword */
2703 long naxes[], /* I - value for the NAXISn keywords */
2704 LONGLONG pcount, /* I - value for the PCOUNT keyword */
2705 LONGLONG gcount, /* I - value for the GCOUNT keyword */
2706 int *status) /* IO - error status */
2707 /*
2708 Put required Header keywords into a conforming extension:
2709 */
2710 {
2711 char message[FLEN_ERRMSG],comm[81], name[20], xtension[FLEN_VALUE];
2712 int ii;
2713
2714 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
2715 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
2716
2717 if (*status > 0)
2718 return(*status);
2719 else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
2720 return(*status = HEADER_NOT_EMPTY);
2721
2722 if (naxis < 0 || naxis > 999)
2723 {
2724 sprintf(message,
2725 "Illegal value for NAXIS keyword: %d", naxis);
2726 ffpmsg(message);
2727 return(*status = BAD_NAXIS);
2728 }
2729
2730 xtension[0] = '\0';
2731 strncat(xtension, xtensionx, FLEN_VALUE-1);
2732
2733 ffpkys(fptr, "XTENSION", xtension, "extension type", status);
2734 ffpkyj(fptr, "BITPIX", bitpix, "number of bits per data pixel", status);
2735 ffpkyj(fptr, "NAXIS", naxis, "number of data axes", status);
2736
2737 strcpy(comm, "length of data axis ");
2738 for (ii = 0; ii < naxis; ii++)
2739 {
2740 if (naxes[ii] < 0)
2741 {
2742 sprintf(message,
2743 "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
2744 ffpmsg(message);
2745 return(*status = BAD_NAXES);
2746 }
2747
2748 sprintf(&comm[20], "%d", ii + 1);
2749 ffkeyn("NAXIS", ii + 1, name, status);
2750 ffpkyj(fptr, name, naxes[ii], comm, status);
2751 }
2752
2753
2754 ffpkyj(fptr, "PCOUNT", pcount, " ", status);
2755 ffpkyj(fptr, "GCOUNT", gcount, " ", status);
2756
2757 if (*status > 0)
2758 ffpmsg("Failed to write extension header keywords (ffphext)");
2759
2760 return(*status);
2761 }
2762 /*--------------------------------------------------------------------------*/
ffi2c(LONGLONG ival,char * cval,int * status)2763 int ffi2c(LONGLONG ival, /* I - value to be converted to a string */
2764 char *cval, /* O - character string representation of the value */
2765 int *status) /* IO - error status */
2766 /*
2767 convert value to a null-terminated formatted string.
2768 */
2769 {
2770 if (*status > 0) /* inherit input status value if > 0 */
2771 return(*status);
2772
2773 cval[0] = '\0';
2774
2775 #if defined(_MSC_VER)
2776 /* Microsoft Visual C++ 6.0 uses '%I64d' syntax for 8-byte integers */
2777 if (sprintf(cval, "%I64d", ival) < 0)
2778
2779 #elif (USE_LL_SUFFIX == 1)
2780 if (sprintf(cval, "%lld", ival) < 0)
2781 #else
2782 if (sprintf(cval, "%ld", ival) < 0)
2783 #endif
2784 {
2785 ffpmsg("Error in ffi2c converting integer to string");
2786 *status = BAD_I2C;
2787 }
2788 return(*status);
2789 }
2790 /*--------------------------------------------------------------------------*/
ffl2c(int lval,char * cval,int * status)2791 int ffl2c(int lval, /* I - value to be converted to a string */
2792 char *cval, /* O - character string representation of the value */
2793 int *status) /* IO - error status ) */
2794 /*
2795 convert logical value to a null-terminated formatted string. If the
2796 input value == 0, then the output character is the letter F, else
2797 the output character is the letter T. The output string is null terminated.
2798 */
2799 {
2800 if (*status > 0) /* inherit input status value if > 0 */
2801 return(*status);
2802
2803 if (lval)
2804 strcpy(cval,"T");
2805 else
2806 strcpy(cval,"F");
2807
2808 return(*status);
2809 }
2810 /*--------------------------------------------------------------------------*/
ffs2c(const char * instr,char * outstr,int * status)2811 int ffs2c(const char *instr, /* I - null terminated input string */
2812 char *outstr, /* O - null terminated quoted output string */
2813 int *status) /* IO - error status */
2814 /*
2815 convert an input string to a quoted string. Leading spaces
2816 are significant. FITS string keyword values must be at least
2817 8 chars long so pad out string with spaces if necessary.
2818 Example: km/s ==> 'km/s '
2819 Single quote characters in the input string will be replace by
2820 two single quote characters. e.g., o'brian ==> 'o''brian'
2821 */
2822 {
2823 size_t len, ii, jj;
2824
2825 if (*status > 0) /* inherit input status value if > 0 */
2826 return(*status);
2827
2828 if (!instr) /* a null input pointer?? */
2829 {
2830 strcpy(outstr, "''"); /* a null FITS string */
2831 return(*status);
2832 }
2833
2834 outstr[0] = '\''; /* start output string with a quote */
2835
2836 len = strlen(instr);
2837 if (len > 68)
2838 len = 68; /* limit input string to 68 chars */
2839
2840 for (ii=0, jj=1; ii < len && jj < 69; ii++, jj++)
2841 {
2842 outstr[jj] = instr[ii]; /* copy each char from input to output */
2843 if (instr[ii] == '\'')
2844 {
2845 jj++;
2846 outstr[jj]='\''; /* duplicate any apostrophies in the input */
2847 }
2848 }
2849
2850 for (; jj < 9; jj++) /* pad string so it is at least 8 chars long */
2851 outstr[jj] = ' ';
2852
2853 if (jj == 70) /* only occurs if the last char of string was a quote */
2854 outstr[69] = '\0';
2855 else
2856 {
2857 outstr[jj] = '\''; /* append closing quote character */
2858 outstr[jj+1] = '\0'; /* terminate the string */
2859 }
2860
2861 return(*status);
2862 }
2863 /*--------------------------------------------------------------------------*/
ffr2f(float fval,int decim,char * cval,int * status)2864 int ffr2f(float fval, /* I - value to be converted to a string */
2865 int decim, /* I - number of decimal places to display */
2866 char *cval, /* O - character string representation of the value */
2867 int *status) /* IO - error status */
2868 /*
2869 convert float value to a null-terminated F format string
2870 */
2871 {
2872 char *cptr;
2873
2874 if (*status > 0) /* inherit input status value if > 0 */
2875 return(*status);
2876
2877 cval[0] = '\0';
2878
2879 if (decim < 0)
2880 {
2881 ffpmsg("Error in ffr2f: no. of decimal places < 0");
2882 return(*status = BAD_DECIM);
2883 }
2884
2885 if (sprintf(cval, "%.*f", decim, fval) < 0)
2886 {
2887 ffpmsg("Error in ffr2f converting float to string");
2888 *status = BAD_F2C;
2889 }
2890
2891 /* replace comma with a period (e.g. in French locale) */
2892 if ( (cptr = strchr(cval, ','))) *cptr = '.';
2893
2894 /* test if output string is 'NaN', 'INDEF', or 'INF' */
2895 if (strchr(cval, 'N'))
2896 {
2897 ffpmsg("Error in ffr2f: float value is a NaN or INDEF");
2898 *status = BAD_F2C;
2899 }
2900
2901 return(*status);
2902 }
2903 /*--------------------------------------------------------------------------*/
ffr2e(float fval,int decim,char * cval,int * status)2904 int ffr2e(float fval, /* I - value to be converted to a string */
2905 int decim, /* I - number of decimal places to display */
2906 char *cval, /* O - character string representation of the value */
2907 int *status) /* IO - error status */
2908 /*
2909 convert float value to a null-terminated exponential format string
2910 */
2911 {
2912 char *cptr;
2913
2914 if (*status > 0) /* inherit input status value if > 0 */
2915 return(*status);
2916
2917 cval[0] = '\0';
2918
2919 if (decim < 0)
2920 { /* use G format if decim is negative */
2921 if ( sprintf(cval, "%.*G", -decim, fval) < 0)
2922 {
2923 ffpmsg("Error in ffr2e converting float to string");
2924 *status = BAD_F2C;
2925 }
2926 else
2927 {
2928 /* test if E format was used, and there is no displayed decimal */
2929 if ( !strchr(cval, '.') && strchr(cval,'E') )
2930 {
2931 /* reformat value with a decimal point and single zero */
2932 if ( sprintf(cval, "%.1E", fval) < 0)
2933 {
2934 ffpmsg("Error in ffr2e converting float to string");
2935 *status = BAD_F2C;
2936 }
2937
2938 return(*status);
2939 }
2940 }
2941 }
2942 else
2943 {
2944 if ( sprintf(cval, "%.*E", decim, fval) < 0)
2945 {
2946 ffpmsg("Error in ffr2e converting float to string");
2947 *status = BAD_F2C;
2948 }
2949 }
2950
2951 if (*status <= 0)
2952 {
2953 /* replace comma with a period (e.g. in French locale) */
2954 if ( (cptr = strchr(cval, ','))) *cptr = '.';
2955
2956 /* test if output string is 'NaN', 'INDEF', or 'INF' */
2957 if (strchr(cval, 'N'))
2958 {
2959 ffpmsg("Error in ffr2e: float value is a NaN or INDEF");
2960 *status = BAD_F2C;
2961 }
2962 else if ( !strchr(cval, '.') && !strchr(cval,'E') )
2963 {
2964 /* add decimal point if necessary to distinquish from integer */
2965 strcat(cval, ".");
2966 }
2967 }
2968
2969 return(*status);
2970 }
2971 /*--------------------------------------------------------------------------*/
ffd2f(double dval,int decim,char * cval,int * status)2972 int ffd2f(double dval, /* I - value to be converted to a string */
2973 int decim, /* I - number of decimal places to display */
2974 char *cval, /* O - character string representation of the value */
2975 int *status) /* IO - error status */
2976 /*
2977 convert double value to a null-terminated F format string
2978 */
2979 {
2980 char *cptr;
2981
2982 if (*status > 0) /* inherit input status value if > 0 */
2983 return(*status);
2984
2985 cval[0] = '\0';
2986
2987 if (decim < 0)
2988 {
2989 ffpmsg("Error in ffd2f: no. of decimal places < 0");
2990 return(*status = BAD_DECIM);
2991 }
2992
2993 if (sprintf(cval, "%.*f", decim, dval) < 0)
2994 {
2995 ffpmsg("Error in ffd2f converting double to string");
2996 *status = BAD_F2C;
2997 }
2998
2999 /* replace comma with a period (e.g. in French locale) */
3000 if ( (cptr = strchr(cval, ','))) *cptr = '.';
3001
3002 /* test if output string is 'NaN', 'INDEF', or 'INF' */
3003 if (strchr(cval, 'N'))
3004 {
3005 ffpmsg("Error in ffd2f: double value is a NaN or INDEF");
3006 *status = BAD_F2C;
3007 }
3008
3009 return(*status);
3010 }
3011 /*--------------------------------------------------------------------------*/
ffd2e(double dval,int decim,char * cval,int * status)3012 int ffd2e(double dval, /* I - value to be converted to a string */
3013 int decim, /* I - number of decimal places to display */
3014 char *cval, /* O - character string representation of the value */
3015 int *status) /* IO - error status */
3016 /*
3017 convert double value to a null-terminated exponential format string.
3018 */
3019 {
3020 char *cptr;
3021
3022 if (*status > 0) /* inherit input status value if > 0 */
3023 return(*status);
3024
3025 cval[0] = '\0';
3026
3027 if (decim < 0)
3028 { /* use G format if decim is negative */
3029 if ( sprintf(cval, "%.*G", -decim, dval) < 0)
3030 {
3031 ffpmsg("Error in ffd2e converting float to string");
3032 *status = BAD_F2C;
3033 }
3034 else
3035 {
3036 /* test if E format was used, and there is no displayed decimal */
3037 if ( !strchr(cval, '.') && strchr(cval,'E') )
3038 {
3039 /* reformat value with a decimal point and single zero */
3040 if ( sprintf(cval, "%.1E", dval) < 0)
3041 {
3042 ffpmsg("Error in ffd2e converting float to string");
3043 *status = BAD_F2C;
3044 }
3045
3046 return(*status);
3047 }
3048 }
3049 }
3050 else
3051 {
3052 if ( sprintf(cval, "%.*E", decim, dval) < 0)
3053 {
3054 ffpmsg("Error in ffd2e converting float to string");
3055 *status = BAD_F2C;
3056 }
3057 }
3058
3059 if (*status <= 0)
3060 {
3061 /* replace comma with a period (e.g. in French locale) */
3062 if ( (cptr = strchr(cval, ','))) *cptr = '.';
3063
3064 /* test if output string is 'NaN', 'INDEF', or 'INF' */
3065 if (strchr(cval, 'N'))
3066 {
3067 ffpmsg("Error in ffd2e: double value is a NaN or INDEF");
3068 *status = BAD_F2C;
3069 }
3070 else if ( !strchr(cval, '.') && !strchr(cval,'E') )
3071 {
3072 /* add decimal point if necessary to distinquish from integer */
3073 strcat(cval, ".");
3074 }
3075 }
3076
3077 return(*status);
3078 }
3079
3080