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