1 /*** File libwcs/hget.c
2 *** November 6, 2015
3 *** By Jessica Mink, jmink@cfa.harvard.edu
4 *** Harvard-Smithsonian Center for Astrophysics
5 *** Copyright (C) 1994-2015
6 *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA
7
8 This library is free software; you can redistribute it and/or
9 modify it under the terms of the GNU Lesser General Public
10 License as published by the Free Software Foundation; either
11 version 2 of the License, or (at your option) any later version.
12
13 This library is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 Lesser General Public License for more details.
17
18 You should have received a copy of the GNU Lesser General Public
19 License along with this library; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21
22 Correspondence concerning WCSTools should be addressed as follows:
23 Internet email: jmink@cfa.harvard.edu
24 Postal address: Jessica Mink
25 Smithsonian Astrophysical Observatory
26 60 Garden St.
27 Cambridge, MA 02138 USA
28
29 * Module: hget.c (Get FITS Header parameter values)
30 * Purpose: Extract values for variables from FITS header string
31 * Subroutine: hgeti2 (hstring,keyword,ival) returns short integer
32 * Subroutine: hgeti4c (hstring,keyword,wchar,ival) returns long integer
33 * Subroutine: hgeti4 (hstring,keyword,ival) returns long integer
34 * Subroutine: hgetr4 (hstring,keyword,rval) returns real
35 * Subroutine: hgetra (hstring,keyword,ra) returns double RA in degrees
36 * Subroutine: hgetdec (hstring,keyword,dec) returns double Dec in degrees
37 * Subroutine: hgetr8c (hstring,keyword,wchar,dval) returns double
38 * Subroutine: hgetr8 (hstring,keyword,dval) returns double
39 * Subroutine: hgetl (hstring,keyword,lval) returns logical int (0=F, 1=T)
40 * Subroutine: hgetsc (hstring,keyword,wchar,lstr,str) returns character string
41 * Subroutine: hgets (hstring,keyword, lstr, str) returns character string
42 * Subroutine: hgetm (hstring,keyword, lstr, str) returns multi-keyword string
43 * Subroutine: hgetdate (hstring,keyword,date) returns date as fractional year
44 * Subroutine: hgetndec (hstring, keyword, ndec) returns number of dec. places
45 * Subroutine: hgetc (hstring,keyword) returns character string
46 * Subroutine: blsearch (hstring,keyword) returns pointer to blank lines
47 before keyword
48 * Subroutine: ksearch (hstring,keyword) returns pointer to header string entry
49 * Subroutine: str2ra (in) converts string to right ascension in degrees
50 * Subroutine: str2dec (in) converts string to declination in degrees
51 * Subroutine: strsrch (s1, s2) finds string s2 in null-terminated string s1
52 * Subroutine: strnsrch (s1, s2, ls1) finds string s2 in ls1-byte string s1
53 * Subroutine: hlength (header,lhead) sets length of FITS header for searching
54 * Subroutine: isnum (string) returns 1 if integer, 2 if fp number,
55 * 3 if hh:mm:dd.ss time, 4 if yyyy-mm-dd date, else 0
56 * Subroutine: notnum (string) returns 0 if number, else 1
57 * Subroutine: numdec (string) returns number of decimal places in numeric string
58 * Subroutine: strfix (string,blankfill,zerodrop) removes extraneous characters
59 */
60
61 #include <string.h> /* NULL, strlen, strstr, strcpy */
62 #include <stdio.h>
63 #include "fitshead.h" /* FITS header extraction subroutines */
64 #include <stdlib.h>
65 #ifndef VMS
66 #include <limits.h>
67 #else
68 #define INT_MAX 2147483647 /* Biggest number that can fit in long */
69 #define SHRT_MAX 32767
70 #endif
71 #define VLENGTH 81
72
73 #ifdef USE_SAOLIB
74 static int use_saolib=0;
75 #endif
76
77 char *hgetc ();
78
79 static char val[VLENGTH+1];
80 static int multiline = 0;
81
82 static int lhead0 = 0; /* Length of header string */
83
84 /* Set the length of the header string, if not terminated by NULL */
85 int
hlength(header,lhead)86 hlength (header, lhead)
87 const char *header; /* FITS header */
88 int lhead; /* Maximum length of FITS header */
89 {
90 char *hend;
91 if (lhead > 0)
92 lhead0 = lhead;
93 else {
94 lhead0 = 0;
95 hend = ksearch (header,"END");
96 lhead0 = hend + 80 - header;
97 }
98 return (lhead0);
99 }
100
101 /* Return the length of the header string, computing it if lhead0 not set */
102 int
gethlength(header)103 gethlength (header)
104 char *header; /* FITS header */
105 {
106 if (lhead0 > 0)
107 return (lhead0);
108 else
109 return (hlength (header, 0));
110 }
111
112
113 /* Extract Integer*4 value for variable from FITS header string */
114
115 int
hgeti4c(hstring,keyword,wchar,ival)116 hgeti4c (hstring,keyword,wchar,ival)
117
118 const char *hstring; /* character string containing FITS header information
119 in the format <keyword>= <value> {/ <comment>} */
120 const char *keyword; /* character string containing the name of the keyword
121 the value of which is returned. hget searches for
122 a line beginning with this string. if "[n]" is
123 present, the n'th token in the value is returned.
124 (the first 8 characters must be unique) */
125 const char *wchar; /* Character of multiple WCS header; =0 if unused */
126 int *ival; /* Keyword value returned */
127 {
128 char keyword1[16];
129 int lkey;
130
131 if (wchar[0] < (char) 64)
132 return (hgeti4 (hstring, keyword, ival));
133 else {
134 strcpy (keyword1, keyword);
135 lkey = strlen (keyword);
136 keyword1[lkey] = wchar[0];
137 keyword1[lkey+1] = (char) 0;
138 return (hgeti4 (hstring, keyword1, ival));
139 }
140 }
141
142
143 /* Extract long value for variable from FITS header string */
144
145 int
hgeti4(hstring,keyword,ival)146 hgeti4 (hstring,keyword,ival)
147
148 const char *hstring; /* character string containing FITS header information
149 in the format <keyword>= <value> {/ <comment>} */
150 const char *keyword; /* character string containing the name of the keyword
151 the value of which is returned. hget searches for a
152 line beginning with this string. if "[n]" is present,
153 the n'th token in the value is returned.
154 (the first 8 characters must be unique) */
155 int *ival;
156 {
157 char *value;
158 double dval;
159 int minint;
160 int lval;
161 char *dchar;
162
163 /* Get value and comment from header string */
164 value = hgetc (hstring,keyword);
165
166 /* Translate value from ASCII to binary */
167 if (value != NULL) {
168 if (value[0] == '#') value++;
169 minint = -INT_MAX - 1;
170 lval = strlen (value);
171 if (lval > VLENGTH) {
172 strncpy (val, value, VLENGTH);
173 val[VLENGTH] = (char) 0;
174 }
175 else
176 strcpy (val, value);
177 if (isnum (val) == 2) {
178 if ((dchar = strchr (val, 'D')))
179 *dchar = 'e';
180 if ((dchar = strchr (val, 'd')))
181 *dchar = 'e';
182 if ((dchar = strchr (val, 'E')))
183 *dchar = 'e';
184 }
185 dval = atof (val);
186 if (dval+0.001 > INT_MAX)
187 *ival = INT_MAX;
188 else if (dval >= 0)
189 *ival = (int) (dval + 0.001);
190 else if (dval-0.001 < minint)
191 *ival = minint;
192 else
193 *ival = (int) (dval - 0.001);
194 return (1);
195 }
196 else {
197 return (0);
198 }
199 }
200
201
202 /* Extract integer*2 value for variable from fits header string */
203
204 int
hgeti2(hstring,keyword,ival)205 hgeti2 (hstring,keyword,ival)
206
207 const char *hstring; /* character string containing FITS header information
208 in the format <keyword>= <value> {/ <comment>} */
209 const char *keyword; /* character string containing the name of the keyword
210 the value of which is returned. hget searches for a
211 line beginning with this string. if "[n]" is present,
212 the n'th token in the value is returned.
213 (the first 8 characters must be unique) */
214 short *ival;
215 {
216 char *value;
217 double dval;
218 int minshort;
219 int lval;
220 char *dchar;
221
222 /* Get value and comment from header string */
223 value = hgetc (hstring,keyword);
224
225 /* Translate value from ASCII to binary */
226 if (value != NULL) {
227 if (value[0] == '#') value++;
228 lval = strlen (value);
229 if (lval > VLENGTH) {
230 strncpy (val, value, VLENGTH);
231 val[VLENGTH] = (char) 0;
232 }
233 else
234 strcpy (val, value);
235 if (isnum (val) == 2) {
236 if ((dchar = strchr (val, 'D')))
237 *dchar = 'e';
238 if ((dchar = strchr (val, 'd')))
239 *dchar = 'e';
240 if ((dchar = strchr (val, 'E')))
241 *dchar = 'e';
242 }
243 dval = atof (val);
244 minshort = -SHRT_MAX - 1;
245 if (dval+0.001 > SHRT_MAX)
246 *ival = SHRT_MAX;
247 else if (dval >= 0)
248 *ival = (short) (dval + 0.001);
249 else if (dval-0.001 < minshort)
250 *ival = minshort;
251 else
252 *ival = (short) (dval - 0.001);
253 return (1);
254 }
255 else {
256 return (0);
257 }
258 }
259
260 /* Extract real value for variable from FITS header string */
261
262 int
hgetr4(hstring,keyword,rval)263 hgetr4 (hstring,keyword,rval)
264
265 const char *hstring; /* character string containing FITS header information
266 in the format <keyword>= <value> {/ <comment>} */
267 const char *keyword; /* character string containing the name of the keyword
268 the value of which is returned. hget searches for a
269 line beginning with this string. if "[n]" is present,
270 the n'th token in the value is returned.
271 (the first 8 characters must be unique) */
272 float *rval;
273 {
274 char *value;
275 int lval;
276 char *dchar;
277
278 /* Get value and comment from header string */
279 value = hgetc (hstring,keyword);
280
281 /* translate value from ASCII to binary */
282 if (value != NULL) {
283 if (value[0] == '#') value++;
284 lval = strlen (value);
285 if (lval > VLENGTH) {
286 strncpy (val, value, VLENGTH);
287 val[VLENGTH] = (char) 0;
288 }
289 else
290 strcpy (val, value);
291 if (isnum (val) == 2) {
292 if ((dchar = strchr (val, 'D')))
293 *dchar = 'e';
294 if ((dchar = strchr (val, 'd')))
295 *dchar = 'e';
296 if ((dchar = strchr (val, 'E')))
297 *dchar = 'e';
298 }
299 *rval = (float) atof (val);
300 return (1);
301 }
302 else {
303 return (0);
304 }
305 }
306
307
308 /* Extract real*8 right ascension in degrees from FITS header string */
309
310 int
hgetra(hstring,keyword,dval)311 hgetra (hstring,keyword,dval)
312
313 const char *hstring; /* character string containing FITS header information
314 in the format <keyword>= <value> {/ <comment>} */
315 const char *keyword; /* character string containing the name of the keyword
316 the value of which is returned. hget searches for a
317 line beginning with this string. if "[n]" is present,
318 the n'th token in the value is returned.
319 (the first 8 characters must be unique) */
320 double *dval; /* Right ascension in degrees (returned) */
321 {
322 char *value;
323
324 /* Get value from header string */
325 value = hgetc (hstring,keyword);
326
327 /* Translate value from ASCII colon-delimited string to binary */
328 if (value != NULL) {
329 *dval = str2ra (value);
330 return (1);
331 }
332 else
333 return (0);
334 }
335
336
337 /* Extract real*8 declination in degrees from FITS header string */
338
339 int
hgetdec(hstring,keyword,dval)340 hgetdec (hstring,keyword,dval)
341
342 const char *hstring; /* character string containing FITS header information
343 in the format <keyword>= <value> {/ <comment>} */
344 const char *keyword; /* character string containing the name of the keyword
345 the value of which is returned. hget searches for a
346 line beginning with this string. if "[n]" is present,
347 the n'th token in the value is returned.
348 (the first 8 characters must be unique) */
349 double *dval; /* Right ascension in degrees (returned) */
350 {
351 char *value;
352
353 /* Get value from header string */
354 value = hgetc (hstring,keyword);
355
356 /* Translate value from ASCII colon-delimited string to binary */
357 if (value != NULL) {
358 *dval = str2dec (value);
359 return (1);
360 }
361 else
362 return (0);
363 }
364
365
366 /* Extract real*8 value for variable from FITS header string */
367
368 int
hgetr8c(hstring,keyword,wchar,dval)369 hgetr8c (hstring,keyword,wchar,dval)
370
371 const char *hstring; /* character string containing FITS header information
372 in the format <keyword>= <value> {/ <comment>} */
373 const char *keyword; /* character string containing the name of the keyword
374 the value of which is returned. hget searches for
375 a line beginning with this string. if "[n]" is
376 present, the n'th token in the value is returned.
377 (the first 8 characters must be unique) */
378 const char *wchar; /* Character of multiple WCS header; =0 if unused */
379 double *dval; /* Keyword value returned */
380 {
381 char keyword1[16];
382 int lkey;
383
384 if (wchar[0] < (char) 64)
385 return (hgetr8 (hstring, keyword, dval));
386 else {
387 strcpy (keyword1, keyword);
388 lkey = strlen (keyword);
389 keyword1[lkey] = wchar[0];
390 keyword1[lkey+1] = (char) 0;
391 return (hgetr8 (hstring, keyword1, dval));
392 }
393 }
394
395
396
397 /* Extract real*8 value for variable from FITS header string */
398
399 int
hgetr8(hstring,keyword,dval)400 hgetr8 (hstring,keyword,dval)
401
402 const char *hstring; /* character string containing FITS header information
403 in the format <keyword>= <value> {/ <comment>} */
404 const char *keyword; /* character string containing the name of the keyword
405 the value of which is returned. hget searches for a
406 line beginning with this string. if "[n]" is present,
407 the n'th token in the value is returned.
408 (the first 8 characters must be unique) */
409 double *dval;
410 {
411 char *value;
412 int lval;
413 char *dchar;
414
415 /* Get value and comment from header string */
416 value = hgetc (hstring,keyword);
417
418 /* Translate value from ASCII to binary */
419 if (value != NULL) {
420 if (value[0] == '#') value++;
421 lval = strlen (value);
422 if (lval > VLENGTH) {
423 strncpy (val, value, VLENGTH);
424 val[VLENGTH] = (char) 0;
425 }
426 else
427 strcpy (val, value);
428 if (isnum (val) == 2) {
429 if ((dchar = strchr (val, 'D')))
430 *dchar = 'e';
431 if ((dchar = strchr (val, 'd')))
432 *dchar = 'e';
433 if ((dchar = strchr (val, 'E')))
434 *dchar = 'e';
435 }
436 *dval = atof (val);
437 return (1);
438 }
439 else {
440 return (0);
441 }
442 }
443
444
445 /* Extract logical value for variable from FITS header string */
446
447 int
hgetl(hstring,keyword,ival)448 hgetl (hstring,keyword,ival)
449
450 const char *hstring; /* character string containing FITS header information
451 in the format <keyword>= <value> {/ <comment>} */
452 const char *keyword; /* character string containing the name of the keyword
453 the value of which is returned. hget searches for a
454 line beginning with this string. if "[n]" is present,
455 the n'th token in the value is returned.
456 (the first 8 characters must be unique) */
457 int *ival;
458 {
459 char *value;
460 char newval;
461 int lval;
462
463 /* Get value and comment from header string */
464 value = hgetc (hstring,keyword);
465
466 /* Translate value from ASCII to binary */
467 if (value != NULL) {
468 lval = strlen (value);
469 if (lval > VLENGTH) {
470 strncpy (val, value, VLENGTH);
471 val[VLENGTH] = (char) 0;
472 }
473 else
474 strcpy (val, value);
475 newval = val[0];
476 if (newval == 't' || newval == 'T')
477 *ival = 1;
478 else
479 *ival = 0;
480 return (1);
481 }
482 else {
483 return (0);
484 }
485 }
486
487
488 /* Extract real*8 date from FITS header string (dd/mm/yy or dd-mm-yy) */
489
490 int
hgetdate(hstring,keyword,dval)491 hgetdate (hstring,keyword,dval)
492
493 const char *hstring; /* character string containing FITS header information
494 in the format <keyword>= <value> {/ <comment>} */
495 const char *keyword; /* character string containing the name of the keyword
496 the value of which is returned. hget searches for a
497 line beginning with this string. if "[n]" is present,
498 the n'th token in the value is returned.
499 (the first 8 characters must be unique) */
500 double *dval;
501 {
502 double yeardays, seconds, fday;
503 char *value,*sstr, *dstr, *tstr, *cstr, *nval;
504 int year, month, day, yday, i, hours, minutes;
505 static int mday[12] = {31,28,31,30,31,30,31,31,30,31,30,31};
506
507 /* Get value and comment from header string */
508 value = hgetc (hstring,keyword);
509
510 /* Translate value from ASCII to binary */
511 if (value != NULL) {
512 sstr = strchr (value,'/');
513 dstr = strchr (value,'-');
514
515 /* Original FITS date format: dd/mm/yy */
516 if (sstr > value) {
517 *sstr = '\0';
518 day = (int) atof (value);
519 *sstr = '/';
520 nval = sstr + 1;
521 sstr = strchr (nval,'/');
522 if (sstr == NULL)
523 sstr = strchr (nval,'-');
524 if (sstr > value) {
525 *sstr = '\0';
526 month = (int) atof (nval);
527 *sstr = '/';
528 nval = sstr + 1;
529 year = (int) atof (nval);
530 if (day > 31) {
531 yday = year;
532 year = day;
533 day = yday;
534 }
535 if (year >= 0 && year <= 49)
536 year = year + 2000;
537 else if (year < 100)
538 year = year + 1900;
539 if ((year % 4) == 0)
540 mday[1] = 29;
541 else
542 mday[1] = 28;
543 if ((year % 100) == 0 && (year % 400) != 0)
544 mday[1] = 28;
545 if (day > mday[month-1])
546 day = mday[month-1];
547 else if (day < 1)
548 day = 1;
549 if (mday[1] == 28)
550 yeardays = 365.0;
551 else
552 yeardays = 366.0;
553 yday = day - 1;
554 for (i = 0; i < month-1; i++)
555 yday = yday + mday[i];
556 *dval = (double) year + ((double)yday / yeardays);
557 return (1);
558 }
559 else
560 return (0);
561 }
562
563 /* New FITS date format: yyyy-mm-ddThh:mm:ss[.sss] */
564 else if (dstr > value) {
565 *dstr = '\0';
566 year = (int) atof (value);
567 *dstr = '-';
568 nval = dstr + 1;
569 dstr = strchr (nval,'-');
570 month = 1;
571 day = 1;
572 tstr = NULL;
573 if (dstr > value) {
574 *dstr = '\0';
575 month = (int) atof (nval);
576 *dstr = '-';
577 nval = dstr + 1;
578 tstr = strchr (nval,'T');
579 if (tstr > value)
580 *tstr = '\0';
581 day = (int) atof (nval);
582 if (tstr > value)
583 *tstr = 'T';
584 }
585
586 /* If year is < 32, it is really day of month in old format */
587 if (year < 32) {
588 i = year;
589 year = day + 1900;
590 day = i;
591 }
592
593 if ((year % 4) == 0)
594 mday[1] = 29;
595 else
596 mday[1] = 28;
597 if ((year % 100) == 0 && (year % 400) != 0)
598 mday[1] = 28;
599 if (day > mday[month-1])
600 day = mday[month-1];
601 else if (day < 1)
602 day = 1;
603 if (mday[1] == 28)
604 yeardays = 365.0;
605 else
606 yeardays = 366.0;
607 yday = day - 1;
608 for (i = 0; i < month-1; i++)
609 yday = yday + mday[i];
610 *dval = (double) year + ((double)yday / yeardays);
611
612 /* Extract time, if it is present */
613 if (tstr > value) {
614 nval = tstr + 1;
615 hours = 0.0;
616 minutes = 0.0;
617 seconds = 0.0;
618 cstr = strchr (nval,':');
619 if (cstr > value) {
620 *cstr = '\0';
621 hours = (int) atof (nval);
622 *cstr = ':';
623 nval = cstr + 1;
624 cstr = strchr (nval,':');
625 if (cstr > value) {
626 *cstr = '\0';
627 minutes = (int) atof (nval);
628 *cstr = ':';
629 nval = cstr + 1;
630 seconds = atof (nval);
631 }
632 else {
633 minutes = (int) atof (nval);
634 seconds = 0.0;
635 }
636 }
637 fday = ((3.6e3 * (double)hours) + (6.e1 * (double)minutes) +
638 seconds) / 8.64e4;
639 *dval = *dval + (fday / yeardays);
640 }
641 return (1);
642 }
643 else
644 return (0);
645 }
646 else
647 return (0);
648 }
649
650
651 /* Extract IRAF multiple-keyword string value from FITS header string */
652
653 int
hgetm(hstring,keyword,lstr,str)654 hgetm (hstring, keyword, lstr, str)
655
656 const char *hstring; /* character string containing FITS header information
657 in the format <keyword>= <value> {/ <comment>} */
658 const char *keyword; /* character string containing the root name of the keyword
659 the value of which is returned. hget searches for a
660 line beginning with this string. if "[n]" is present,
661 the n'th token in the value is returned.
662 (the first 8 characters must be unique) */
663 const int lstr; /* Size of str in characters */
664 char *str; /* String (returned) */
665 {
666 char *value;
667 char *stri;
668 char keywordi[16];
669 int lval, lstri, ikey;
670 char keyform[8];
671
672 stri = str;
673 lstri = lstr;
674
675 sprintf (keywordi, "%s_1", keyword);
676 if (ksearch (hstring, keywordi))
677 strcpy (keyform, "%s_%d");
678 else {
679 sprintf (keywordi, "%s_01", keyword);
680 if (ksearch (hstring, keywordi))
681 strcpy (keyform, "%s_%02d");
682 else {
683 sprintf (keywordi, "%s_001", keyword);
684 if (ksearch (hstring, keywordi))
685 strcpy (keyform, "%s_%03d");
686 else if (ksearch (hstring, keywordi))
687 strcpy (keyform, "%s_%03d");
688 else
689 return (0);
690 }
691 }
692
693 /* Loop through sequentially-named keywords */
694 multiline = 1;
695 for (ikey = 1; ikey < 500; ikey++) {
696 sprintf (keywordi, keyform, keyword, ikey);
697
698 /* Get value for this keyword */
699 value = hgetc (hstring, keywordi);
700 if (value != NULL) {
701 lval = strlen (value);
702 if (lval < lstri)
703 strcpy (stri, value);
704 else if (lstri > 1) {
705 strncpy (stri, value, lstri-1);
706 stri[lstri] = (char) 0;
707 break;
708 }
709 else {
710 str[0] = value[0];
711 break;
712 }
713 }
714 else
715 break;
716 stri = stri + lval;
717 lstri = lstri - lval;
718 }
719 multiline = 0;
720
721 /* Return 1 if any keyword found, else 0 */
722 if (ikey > 1)
723 return (1);
724 else
725 return (0);
726 }
727
728
729 /* Extract string value for variable from FITS header string */
730
731 int
hgetsc(hstring,keyword,wchar,lstr,str)732 hgetsc (hstring,keyword,wchar,lstr,str)
733
734 const char *hstring; /* character string containing FITS header information
735 in the format <keyword>= <value> {/ <comment>} */
736 const char *keyword; /* character string containing the name of the keyword
737 the value of which is returned. hget searches for
738 a line beginning with this string. if "[n]" is
739 present, the n'th token in the value is returned.
740 (the first 8 characters must be unique) */
741 const char *wchar; /* Character of multiple WCS header; =0 if unused */
742 const int lstr; /* Size of str in characters */
743 char *str; /* String (returned) */
744 {
745 char keyword1[16];
746 int lkey;
747
748 if (wchar[0] < (char) 64)
749 return (hgets (hstring, keyword, lstr, str));
750 else {
751 strcpy (keyword1, keyword);
752 lkey = strlen (keyword);
753 keyword1[lkey] = wchar[0];
754 keyword1[lkey+1] = (char) 0;
755 return (hgets (hstring, keyword1, lstr, str));
756 }
757 }
758
759
760 /* Extract string value for variable from FITS header string */
761
762 int
hgets(hstring,keyword,lstr,str)763 hgets (hstring, keyword, lstr, str)
764
765 const char *hstring; /* character string containing FITS header information
766 in the format <keyword>= <value> {/ <comment>} */
767 const char *keyword; /* character string containing the name of the keyword
768 the value of which is returned. hget searches for a
769 line beginning with this string. if "[n]" is present,
770 the n'th token in the value is returned.
771 (the first 8 characters must be unique) */
772 const int lstr; /* Size of str in characters */
773 char *str; /* String (returned) */
774 {
775 char *value;
776 int lval;
777
778 /* Get value and comment from header string */
779 value = hgetc (hstring,keyword);
780
781 if (value != NULL) {
782 lval = strlen (value);
783 if (lval < lstr)
784 strcpy (str, value);
785 else if (lstr > 1)
786 strncpy (str, value, lstr-1);
787 else
788 str[0] = value[0];
789 return (1);
790 }
791 else
792 return (0);
793 }
794
795
796 /* Extract number of decimal places for value in FITS header string */
797
798 int
hgetndec(hstring,keyword,ndec)799 hgetndec (hstring, keyword, ndec)
800
801 const char *hstring; /* character string containing FITS header information
802 in the format <keyword>= <value> {/ <comment>} */
803 const char *keyword; /* character string containing the name of the keyword
804 the value of which is returned. hget searches for a
805 line beginning with this string. if "[n]" is present,
806 the n'th token in the value is returned.
807 (the first 8 characters must be unique) */
808 int *ndec; /* Number of decimal places in keyword value */
809 {
810 char *value;
811 int i, nchar;
812
813 /* Get value and comment from header string */
814 value = hgetc (hstring,keyword);
815
816 /* Find end of string and count backward to decimal point */
817 *ndec = 0;
818 if (value != NULL) {
819 nchar = strlen (value);
820 for (i = nchar-1; i >= 0; i--) {
821 if (value[i] == '.')
822 return (1);
823 *ndec = *ndec + 1;
824 }
825 return (1);
826 }
827 else
828 return (0);
829 }
830
831
832 /* Extract character value for variable from FITS header string */
833
834 char *
hgetc(hstring,keyword0)835 hgetc (hstring,keyword0)
836
837 const char *hstring; /* character string containing FITS header information
838 in the format <keyword>= <value> {/ <comment>} */
839 const char *keyword0; /* character string containing the name of the keyword
840 the value of which is returned. hget searches for a
841 line beginning with this string. if "[n]" is present,
842 the n'th token in the value is returned.
843 (the first 8 characters must be unique) */
844 {
845 static char cval[80];
846 char *value;
847 char cwhite[2];
848 char squot[2], dquot[2], lbracket[2], rbracket[2], slash[2], comma[2];
849 char space;
850 char keyword[81]; /* large for ESO hierarchical keywords */
851 char line[100];
852 char *vpos, *cpar;
853 char *q1, *q2, *v1, *v2, *c1, *brack1, *brack2;
854 int ipar, i, lkey;
855
856 #ifdef USE_SAOLIB
857 int iel=1, ip=1, nel, np, ier;
858 char *get_fits_head_str();
859
860 if( !use_saolib ){
861 #endif
862
863 squot[0] = (char) 39;
864 squot[1] = (char) 0;
865 dquot[0] = (char) 34;
866 dquot[1] = (char) 0;
867 lbracket[0] = (char) 91;
868 lbracket[1] = (char) 0;
869 comma[0] = (char) 44;
870 comma[1] = (char) 0;
871 rbracket[0] = (char) 93;
872 rbracket[1] = (char) 0;
873 slash[0] = (char) 47;
874 slash[1] = (char) 0;
875 space = (char) 32;
876
877 /* Find length of variable name */
878 strncpy (keyword,keyword0, sizeof(keyword)-1);
879 brack1 = strsrch (keyword,lbracket);
880 if (brack1 == NULL)
881 brack1 = strsrch (keyword,comma);
882 if (brack1 != NULL) {
883 *brack1 = '\0';
884 brack1++;
885 }
886
887 /* Search header string for variable name */
888 vpos = ksearch (hstring,keyword);
889
890 /* Exit if not found */
891 if (vpos == NULL)
892 return (NULL);
893
894 /* Initialize line to nulls */
895 for (i = 0; i < 100; i++)
896 line[i] = 0;
897
898 /* In standard FITS, data lasts until 80th character */
899
900 /* Extract entry for this variable from the header */
901 strncpy (line,vpos,80);
902
903 /* Check for quoted value */
904 q1 = strsrch (line,squot);
905 c1 = strsrch (line,slash);
906 if (q1 != NULL) {
907 if (c1 != NULL && q1 < c1) {
908 q2 = strsrch (q1+1,squot);
909 if (q2 == NULL) {
910 q2 = c1 - 1;
911 while (*q2 == space)
912 q2--;
913 q2++;
914 }
915 else if (c1 < q2)
916 c1 = strsrch (q2,slash);
917 }
918 else if (c1 == NULL) {
919 q2 = strsrch (q1+1,squot);
920 if (q2 == NULL) {
921 q2 = line + 79;
922 while (*q2 == space)
923 q2--;
924 q2++;
925 }
926 }
927 else
928 q1 = NULL;
929 }
930 else {
931 q1 = strsrch (line,dquot);
932 if (q1 != NULL) {
933 if (c1 != NULL && q1 < c1) {
934 q2 = strsrch (q1+1,dquot);
935 if (q2 == NULL) {
936 q2 = c1 - 1;
937 while (*q2 == space)
938 q2--;
939 q2++;
940 }
941 else if (c1 < q2)
942 c1 = strsrch (q2,slash);
943 }
944 else if (c1 == NULL) {
945 q2 = strsrch (q1+1,dquot);
946 if (q2 == NULL) {
947 q2 = line + 79;
948 while (*q2 == space)
949 q2--;
950 q2++;
951 }
952 }
953 else
954 q1 = NULL;
955 }
956 else {
957 q1 = NULL;
958 q2 = line + 10;
959 }
960 }
961
962 /* Extract value and remove excess spaces */
963 if (q1 != NULL) {
964 v1 = q1 + 1;
965 v2 = q2;
966 }
967 else {
968 v1 = strsrch (line,"=");
969 if (v1 == NULL)
970 v1 = line + 9;
971 else
972 v1 = v1 + 1;
973 c1 = strsrch (line,"/");
974 if (c1 != NULL)
975 v2 = c1;
976 else
977 v2 = line + 79;
978 }
979
980 /* Ignore leading spaces if not multiline */
981 if (!multiline) {
982 while (*v1 == ' ' && v1 < v2) {
983 v1++;
984 }
985 }
986
987 /* Drop trailing spaces */
988 *v2 = '\0';
989 if (!multiline) {
990 v2--;
991 while ((*v2 == ' ' || *v2 == (char) 13) && v2 > v1) {
992 *v2 = '\0';
993 v2--;
994 }
995 }
996
997 /* Convert -zero to just plain 0 */
998 if (!strcmp (v1, "-0"))
999 v1++;
1000 strcpy (cval,v1);
1001 value = cval;
1002
1003 /* If keyword has brackets, extract appropriate token from value */
1004 if (brack1 != NULL) {
1005 brack2 = strsrch (brack1,rbracket);
1006 if (brack2 != NULL)
1007 *brack2 = '\0';
1008 if (isnum (brack1) == 1) {
1009 ipar = atoi (brack1);
1010 cwhite[0] = ' ';
1011 cwhite[1] = '\0';
1012 if (ipar > 0) {
1013 for (i = 1; i <= ipar; i++) {
1014 cpar = strtok (v1,cwhite);
1015 v1 = NULL;
1016 }
1017 if (cpar != NULL) {
1018 strcpy (cval,cpar);
1019 value = cval;
1020 }
1021 else
1022 value = NULL;
1023 }
1024
1025 /* If token counter is negative, include rest of value */
1026 else if (ipar < 0) {
1027 for (i = 1; i < -ipar; i++) {
1028 v1 = strchr (v1, ' ');
1029 if (v1 == NULL)
1030 break;
1031 else
1032 v1 = v1 + 1;
1033 }
1034 if (v1 != NULL) {
1035 strcpy (cval, v1);
1036 value = cval;
1037 }
1038 else
1039 value = NULL;
1040 }
1041 }
1042 else {
1043 lkey = strlen (brack1);
1044 for (i = 0; i < lkey; i++) {
1045 if (brack1[i] > 64 && brack1[i] < 91)
1046 brack1[i] = brack1[i] + 32;
1047 }
1048 v1 = igetc (cval, brack1);
1049 if (v1) {
1050 strcpy (cval,v1);
1051 value = cval;
1052 }
1053 else
1054 value = NULL;
1055 }
1056 }
1057
1058 return (value);
1059 #ifdef USE_SAOLIB
1060 } else {
1061 return(get_fits_head_str(keyword0, iel, ip, &nel, &np, &ier, hstring));
1062 }
1063 #endif
1064 }
1065
1066
1067 /* Find beginning of fillable blank line before FITS header keyword line */
1068
1069 char *
blsearch(hstring,keyword)1070 blsearch (hstring,keyword)
1071
1072 /* Find entry for keyword keyword in FITS header string hstring.
1073 (the keyword may have a maximum of eight letters)
1074 NULL is returned if the keyword is not found */
1075
1076 const char *hstring; /* character string containing fits-style header
1077 information in the format <keyword>= <value> {/ <comment>}
1078 the default is that each entry is 80 characters long;
1079 however, lines may be of arbitrary length terminated by
1080 nulls, carriage returns or linefeeds, if packed is true. */
1081 const char *keyword; /* character string containing the name of the variable
1082 to be returned. ksearch searches for a line beginning
1083 with this string. The string may be a character
1084 literal or a character variable terminated by a null
1085 or '$'. it is truncated to 8 characters. */
1086 {
1087 const char *headlast;
1088 char *loc, *headnext, *pval, *lc, *line;
1089 char *bval;
1090 int icol, nextchar, lkey, nleft, lhstr;
1091
1092 pval = 0;
1093
1094 /* Search header string for variable name */
1095 if (lhead0)
1096 lhstr = lhead0;
1097 else {
1098 lhstr = 0;
1099 while (lhstr < 256000 && hstring[lhstr] != 0)
1100 lhstr++;
1101 }
1102 headlast = hstring + lhstr;
1103 headnext = (char *) hstring;
1104 pval = NULL;
1105 while (headnext < headlast) {
1106 nleft = headlast - headnext;
1107 loc = strncsrch (headnext, keyword, nleft);
1108
1109 /* Exit if keyword is not found */
1110 if (loc == NULL) {
1111 break;
1112 }
1113
1114 icol = (loc - hstring) % 80;
1115 lkey = strlen (keyword);
1116 nextchar = (int) *(loc + lkey);
1117
1118 /* If this is not in the first 8 characters of a line, keep searching */
1119 if (icol > 7)
1120 headnext = loc + 1;
1121
1122 /* If parameter name in header is longer, keep searching */
1123 else if (nextchar != 61 && nextchar > 32 && nextchar < 127)
1124 headnext = loc + 1;
1125
1126 /* If preceeding characters in line are not blanks, keep searching */
1127 else {
1128 line = loc - icol;
1129 for (lc = line; lc < loc; lc++) {
1130 if (*lc != ' ')
1131 headnext = loc + 1;
1132 }
1133
1134 /* Return pointer to start of line if match */
1135 if (loc >= headnext) {
1136 pval = line;
1137 break;
1138 }
1139 }
1140 }
1141
1142 /* Return NULL to calling program if keyword is not found */
1143 if (pval == NULL)
1144 return (pval);
1145
1146 /* Return NULL if keyword is found at start of FITS header string */
1147 if (pval == hstring)
1148 return (NULL);
1149
1150 /* Find last nonblank in FITS header string line before requested keyword */
1151 bval = pval - 80;
1152 while (!strncmp (bval," ",8) && bval >= hstring)
1153 bval = bval - 80;
1154 bval = bval + 80;
1155
1156 /* Return pointer to calling program if blank lines found */
1157 if (bval < pval && bval >= hstring)
1158 return (bval);
1159 else
1160 return (NULL);
1161 }
1162
1163
1164 /* Find FITS header line containing specified keyword */
1165
1166 char *
ksearch(hstring,keyword)1167 ksearch (hstring,keyword)
1168
1169 /* Find entry for keyword keyword in FITS header string hstring.
1170 (the keyword may have a maximum of eight letters)
1171 NULL is returned if the keyword is not found */
1172
1173 const char *hstring; /* character string containing fits-style header
1174 information in the format <keyword>= <value> {/ <comment>}
1175 the default is that each entry is 80 characters long;
1176 however, lines may be of arbitrary length terminated by
1177 nulls, carriage returns or linefeeds, if packed is true. */
1178 const char *keyword; /* character string containing the name of the variable
1179 to be returned. ksearch searches for a line beginning
1180 with this string. The string may be a character
1181 literal or a character variable terminated by a null
1182 or '$'. it is truncated to 8 characters. */
1183 {
1184 const char *headlast;
1185 char *loc, *headnext, *pval, *lc, *line;
1186 int icol, nextchar, lkey, nleft, lhead, lmax;
1187
1188 #ifdef USE_SAOLIB
1189 int iel=1, ip=1, nel, np, ier;
1190 char *get_fits_head_str();
1191
1192 if( !use_saolib ){
1193 #endif
1194
1195 pval = 0;
1196
1197 /* Find current length of header string */
1198 if (lhead0)
1199 lmax = lhead0;
1200 else
1201 lmax = 256000;
1202 for (lhead = 0; lhead < lmax; lhead++) {
1203 if (hstring[lhead] <= (char) 0)
1204 break;
1205 }
1206
1207 /* Search header string for variable name */
1208 headlast = hstring + lhead;
1209 headnext = (char *) hstring;
1210 pval = NULL;
1211 while (headnext < headlast) {
1212 nleft = headlast - headnext;
1213 loc = strncsrch (headnext, keyword, nleft);
1214
1215 /* Exit if keyword is not found */
1216 if (loc == NULL) {
1217 break;
1218 }
1219
1220 icol = (loc - hstring) % 80;
1221 lkey = strlen (keyword);
1222 nextchar = (int) *(loc + lkey);
1223
1224 /* If this is not in the first 8 characters of a line, keep searching */
1225 if (icol > 7)
1226 headnext = loc + 1;
1227
1228 /* If parameter name in header is longer, keep searching */
1229 else if (nextchar != 61 && nextchar > 32 && nextchar < 127)
1230 headnext = loc + 1;
1231
1232 /* If preceeding characters in line are not blanks, keep searching */
1233 else {
1234 line = loc - icol;
1235 for (lc = line; lc < loc; lc++) {
1236 if (*lc != ' ')
1237 headnext = loc + 1;
1238 }
1239
1240 /* Return pointer to start of line if match */
1241 if (loc >= headnext) {
1242 pval = line;
1243 break;
1244 }
1245 }
1246 }
1247
1248 /* Return pointer to calling program */
1249 return (pval);
1250
1251 #ifdef USE_SAOLIB
1252 }
1253 else {
1254 if (get_fits_head_str(keyword,iel,ip,&nel,&np,&ier,hstring) != NULL)
1255 return(hstring);
1256 else
1257 return(NULL);
1258 }
1259 #endif
1260 }
1261
1262
1263 /* Return the right ascension in degrees from sexagesimal hours or decimal degrees */
1264
1265 double
str2ra(in)1266 str2ra (in)
1267
1268 const char *in; /* Character string of sexigesimal hours or decimal degrees */
1269
1270 {
1271 double ra; /* Right ascension in degrees (returned) */
1272
1273 ra = str2dec (in);
1274 if (strsrch (in,":"))
1275 ra = ra * 15.0;
1276
1277 return (ra);
1278 }
1279
1280
1281 /* Return the declination in degrees from sexagesimal or decimal degrees */
1282
1283 double
str2dec(in)1284 str2dec (in)
1285
1286 const char *in; /* Character string of sexigesimal or decimal degrees */
1287
1288 {
1289 double dec; /* Declination in degrees (returned) */
1290 double deg, min, sec, sign;
1291 char *value, *c1, *c2;
1292 int lval;
1293 char *dchar;
1294
1295 dec = 0.0;
1296
1297 /* Return 0.0 if string is null */
1298 if (in == NULL)
1299 return (dec);
1300
1301 /* Translate value from ASCII colon-delimited string to binary */
1302 if (in[0]) {
1303 value = (char *) in;
1304
1305 /* Remove leading spaces */
1306 while (*value == ' ')
1307 value++;
1308
1309 /* Save sign */
1310 if (*value == '-') {
1311 sign = -1.0;
1312 value++;
1313 }
1314 else if (*value == '+') {
1315 sign = 1.0;
1316 value++;
1317 }
1318 else
1319 sign = 1.0;
1320
1321 /* Turn comma into space */
1322 if ((c1 = strsrch (value,",")) != NULL)
1323 *c1 = ' ';
1324
1325 /* Remove trailing spaces */
1326 lval = strlen (value);
1327 while (value[lval-1] == ' ')
1328 lval--;
1329
1330 if ((c1 = strsrch (value,":")) == NULL)
1331 c1 = strnsrch (value," ",lval);
1332 if (c1 != NULL) {
1333 *c1 = 0;
1334 deg = (double) atoi (value);
1335 *c1 = ':';
1336 value = c1 + 1;
1337 if ((c2 = strsrch (value,":")) == NULL)
1338 c2 = strsrch (value," ");
1339 if (c2 != NULL) {
1340 *c2 = 0;
1341 min = (double) atoi (value);
1342 *c2 = ':';
1343 value = c2 + 1;
1344 sec = atof (value);
1345 }
1346 else {
1347 sec = 0.0;
1348 if ((c1 = strsrch (value,".")) != NULL)
1349 min = atof (value);
1350 if (strlen (value) > 0)
1351 min = (double) atoi (value);
1352 }
1353 dec = sign * (deg + (min / 60.0) + (sec / 3600.0));
1354 }
1355 else if (isnum (value) == 2) {
1356 if ((dchar = strchr (value, 'D')))
1357 *dchar = 'e';
1358 if ((dchar = strchr (value, 'd')))
1359 *dchar = 'e';
1360 if ((dchar = strchr (value, 'E')))
1361 *dchar = 'e';
1362 dec = sign * atof (value);
1363 }
1364 else
1365 dec = sign * (double) atoi (value);
1366 }
1367 return (dec);
1368 }
1369
1370
1371 /* Find string s2 within null-terminated string s1 */
1372
1373 char *
strsrch(s1,s2)1374 strsrch (s1, s2)
1375
1376 const char *s1; /* String to search */
1377 const char *s2; /* String to look for */
1378
1379 {
1380 int ls1;
1381 ls1 = strlen (s1);
1382 return (strnsrch (s1, s2, ls1));
1383 }
1384
1385
1386 /* Find string s2 within string s1 */
1387
1388 char *
strnsrch(s1,s2,ls1)1389 strnsrch (s1, s2, ls1)
1390
1391 const char *s1; /* String to search */
1392 const char *s2; /* String to look for */
1393 const int ls1; /* Length of string being searched */
1394
1395 {
1396 char *s,*s1e;
1397 char cfirst,clast;
1398 int i,ls2;
1399
1400 /* Return null string if either pointer is NULL */
1401 if (s1 == NULL || s2 == NULL)
1402 return (NULL);
1403
1404 /* A zero-length pattern is found in any string */
1405 ls2 = strlen (s2);
1406 if (ls2 ==0)
1407 return ((char *) s1);
1408
1409 /* Only a zero-length string can be found in a zero-length string */
1410 if (ls1 ==0)
1411 return (NULL);
1412
1413 cfirst = (char) s2[0];
1414 clast = (char) s2[ls2-1];
1415 s1e = (char *) s1 + (int) ls1 - ls2 + 1;
1416 s = (char *) s1;
1417 while (s < s1e) {
1418
1419 /* Search for first character in pattern string */
1420 if (*s == cfirst) {
1421
1422 /* If single character search, return */
1423 if (ls2 == 1)
1424 return (s);
1425
1426 /* Search for last character in pattern string if first found */
1427 if (s[ls2-1] == clast) {
1428
1429 /* If two-character search, return */
1430 if (ls2 == 2)
1431 return (s);
1432
1433 /* If 3 or more characters, check for rest of search string */
1434 i = 1;
1435 while (i < ls2 && s[i] == s2[i])
1436 i++;
1437
1438 /* If entire string matches, return */
1439 if (i >= ls2)
1440 return (s);
1441 }
1442 }
1443 s++;
1444 }
1445 return (NULL);
1446 }
1447
1448
1449 /* Find string s2 within null-terminated string s1 (case-free search) */
1450
1451 char *
strcsrch(s1,s2)1452 strcsrch (s1, s2)
1453
1454 const char *s1; /* String to search */
1455 const char *s2; /* String to look for */
1456
1457 {
1458 int ls1;
1459 ls1 = strlen ((char *) s1);
1460 return (strncsrch (s1, s2, ls1));
1461 }
1462
1463
1464 /* Find string s2 within string s1 (case-free search) */
1465
1466 char *
strncsrch(s1,s2,ls1)1467 strncsrch (s1, s2, ls1)
1468
1469 const char *s1; /* String to search */
1470 const char *s2; /* String to look for */
1471 const int ls1; /* Length of string being searched */
1472
1473 {
1474 char *s,*s1e, sl, *os2;
1475 char cfirst,ocfirst;
1476 char clast = ' ';
1477 char oclast = ' ';
1478 int i,ls2;
1479
1480 /* Return null string if either pointer is NULL */
1481 if (s1 == NULL || s2 == NULL)
1482 return (NULL);
1483
1484 /* A zero-length pattern is found in any string */
1485 ls2 = strlen (s2);
1486 if (ls2 ==0)
1487 return ((char *) s1);
1488
1489 /* Only a zero-length string can be found in a zero-length string */
1490 os2 = NULL;
1491 if (ls1 ==0)
1492 return (NULL);
1493
1494 /* For one or two characters, set opposite case first and last letters */
1495 if (ls2 < 3) {
1496 cfirst = (char) s2[0];
1497 if (cfirst > 96 && cfirst < 123)
1498 ocfirst = cfirst - 32;
1499 else if (cfirst > 64 && cfirst < 91)
1500 ocfirst = cfirst + 32;
1501 else
1502 ocfirst = cfirst;
1503 if (ls2 > 1) {
1504 clast = s2[1];
1505 if (clast > 96 && clast < 123)
1506 oclast = clast - 32;
1507 else if (clast > 64 && clast < 91)
1508 oclast = clast + 32;
1509 else
1510 oclast = clast;
1511 }
1512 }
1513
1514 /* Else duplicate string with opposite case letters for comparison */
1515 else {
1516 os2 = (char *) calloc (ls2, 1);
1517 for (i = 0; i < ls2; i++) {
1518 if (s2[i] > 96 && s2[i] < 123)
1519 os2[i] = s2[i] - 32;
1520 else if (s2[i] > 64 && s2[i] < 91)
1521 os2[i] = s2[i] + 32;
1522 else
1523 os2[i] = s2[i];
1524 }
1525 cfirst = s2[0];
1526 ocfirst = os2[0];
1527 clast = s2[ls2-1];
1528 oclast = os2[ls2-1];
1529 }
1530
1531 /* Loop through input string, character by character */
1532 s = (char *) s1;
1533 s1e = s + (int) ls1 - ls2 + 1;
1534 while (s < s1e) {
1535
1536 /* Search for first character in pattern string */
1537 if (*s == cfirst || *s == ocfirst) {
1538
1539 /* If single character search, return */
1540 if (ls2 == 1) {
1541 if (os2 != NULL)
1542 free (os2);
1543 return (s);
1544 }
1545
1546 /* Search for last character in pattern string if first found */
1547 sl = s[ls2-1];
1548 if (sl == clast || sl == oclast) {
1549
1550 /* If two-character search, return */
1551 if (ls2 == 2) {
1552 if (os2 != NULL)
1553 free (os2);
1554 return (s);
1555 }
1556
1557 /* If 3 or more characters, check for rest of search string */
1558 i = 1;
1559 while (i < ls2 && (s[i] == (char) s2[i] || s[i] == os2[i]))
1560 i++;
1561
1562 /* If entire string matches, return */
1563 if (i >= ls2) {
1564 if (os2 != NULL)
1565 free (os2);
1566 return (s);
1567 }
1568 }
1569 }
1570 s++;
1571 }
1572 if (os2 != NULL)
1573 free (os2);
1574 return (NULL);
1575 }
1576
1577
1578 int
notnum(string)1579 notnum (string)
1580
1581 const char *string; /* Character string */
1582 {
1583 if (isnum (string))
1584 return (0);
1585 else
1586 return (1);
1587 }
1588
1589
1590 /* ISNUM-- Return 1 if string is an integer number,
1591 2 if floating point,
1592 3 if sexigesimal, with or without decimal point
1593 4 if yyyy-mm-dd date
1594 else 0
1595 */
1596
1597 int
isnum(string)1598 isnum (string)
1599
1600 const char *string; /* Character string */
1601 {
1602 int lstr, i, nd, cl;
1603 char cstr, cstr1, cstr2;
1604 int fpcode;
1605
1606 /* Return 0 if string is NULL */
1607 if (string == NULL)
1608 return (0);
1609
1610 lstr = strlen (string);
1611 nd = 0;
1612 cl = 0;
1613 fpcode = 1;
1614
1615 /* Return 0 if string starts with a D or E */
1616 cstr = string[0];
1617 if (cstr == 'D' || cstr == 'd' ||
1618 cstr == 'E' || cstr == 'e') {
1619 return (0);
1620 }
1621
1622 /* Remove trailing spaces */
1623 while (string[lstr-1] == ' ')
1624 lstr--;
1625
1626 /* Numeric strings contain 0123456789-+ and d or e for exponents */
1627 for (i = 0; i < lstr; i++) {
1628 cstr = string[i];
1629 if (cstr == '\n')
1630 break;
1631
1632 /* Ignore leading spaces */
1633 if (cstr == ' ' && nd == 0)
1634 continue;
1635
1636 if ((cstr < 48 || cstr > 57) &&
1637 cstr != '+' && cstr != '-' &&
1638 cstr != 'D' && cstr != 'd' &&
1639 cstr != 'E' && cstr != 'e' &&
1640 cstr != ':' && cstr != '.')
1641 return (0);
1642 else if (cstr == '+' || cstr == '-') {
1643 if (string[i+1] == '-' || string[i+1] == '+')
1644 return (0);
1645 else if (i > 0) {
1646 cstr1 = string[i-1];
1647 cstr2 = string[i+1];
1648 if (cstr == '-' && cstr1 > 47 && cstr1 < 58 &&
1649 cstr2 > 47 && cstr2 < 58)
1650 return (4);
1651 else if (cstr1 != 'D' && cstr1 != 'd' &&
1652 cstr1 != 'E' && cstr1 != 'e' &&
1653 cstr1 != ':' && cstr1 != ' ')
1654 return (0);
1655 }
1656 }
1657 else if (cstr >= 47 && cstr <= 57)
1658 nd++;
1659
1660 /* Check for colon */
1661 else if (cstr == 58)
1662 cl++;
1663 if (cstr=='.' || cstr=='d' || cstr=='e' || cstr=='d' || cstr=='e')
1664 fpcode = 2;
1665 }
1666 if (nd > 0) {
1667 if (cl)
1668 fpcode = 3;
1669 return (fpcode);
1670 }
1671 else
1672 return (0);
1673 }
1674
1675
1676 /* NUMDEC -- Return number of decimal places in numeric string (-1 if not number) */
1677
1678 int
numdec(string)1679 numdec (string)
1680
1681 const char *string; /* Numeric string */
1682 {
1683 char *cdot;
1684 int lstr;
1685
1686 if (notnum (string) && !strchr (string, ':'))
1687 return (-1);
1688 else {
1689 lstr = strlen (string);
1690 if ((cdot = strchr (string, '.')) == NULL)
1691 return (0);
1692 else
1693 return (lstr - (cdot - string) - 1);
1694 }
1695 }
1696
1697
1698 #ifdef USE_SAOLIB
set_saolib(hstring)1699 int set_saolib(hstring)
1700 void *hstring;
1701 {
1702 if( *((int *)hstring) == 142857 )
1703 use_saolib = 1;
1704 else
1705 use_saolib = 0;
1706 }
1707
1708 #endif
1709
1710
1711 /* Remove exponent, leading #, surrounding parentheses,
1712 and/or trailing zeroes, if reasonable */
1713 void
strfix(string,fillblank,dropzero)1714 strfix (string, fillblank, dropzero)
1715
1716 char *string; /* String to modify */
1717 int fillblank; /* If nonzero, fill blanks with underscores */
1718 int dropzero; /* If nonzero, drop trailing zeroes */
1719 {
1720 char *sdot, *s, *strend, *str, ctemp, *slast;
1721 int ndek, lstr, i;
1722
1723 /* If number, ignore leading # and remove trailing non-numeric character */
1724 if (string[0] == '#') {
1725 strend = string + strlen (string);
1726 str = string + 1;
1727 strend = str + strlen (str) - 1;
1728 ctemp = *strend;
1729 if (!isnum (strend))
1730 *strend = (char) 0;
1731 if (isnum (str)) {
1732 strend = string + strlen (string);
1733 for (str = string; str < strend; str++)
1734 *str = *(str + 1);
1735 }
1736 else
1737 *strend = ctemp;
1738 }
1739
1740 /* Remove parentheses if they enclose the string */
1741 if (string[0] == '(') {
1742 lstr = strlen (string);
1743 if (string[lstr-1] == ')') {
1744 string[lstr-1] = (char) 0;
1745 strend = string + lstr - 1;
1746 for (str = string; str < strend; str++)
1747 *str = *(str+1);
1748 string[lstr-2] = (char) 0;
1749 }
1750 }
1751
1752 /* Remove positive exponent if there are enough digits given */
1753 if (isnum (string) > 1 && strsrch (string, "E+") != NULL) {
1754 lstr = strlen (string);
1755 ndek = (int) (string[lstr-1] - 48);
1756 ndek = ndek + (10 * ((int) (string[lstr-2] - 48)));
1757 if (ndek < lstr - 7) {
1758 lstr = lstr - 4;
1759 string[lstr] = (char) 0;
1760 string[lstr+1] = (char) 0;
1761 string[lstr+2] = (char) 0;
1762 string[lstr+3] = (char) 0;
1763 sdot = strchr (string, '.');
1764 if (ndek > 0 && sdot != NULL) {
1765 for (i = 1; i <= ndek; i++) {
1766 *sdot = *(sdot+1);
1767 sdot++;
1768 *sdot = '.';
1769 }
1770 }
1771 }
1772 }
1773
1774 /* Remove trailing zeroes if they are not significant */
1775 if (dropzero) {
1776 if (isnum (string) > 1 && strchr (string, '.') != NULL &&
1777 strsrch (string, "E-") == NULL &&
1778 strsrch (string, "E+") == NULL &&
1779 strsrch (string, "e-") == NULL &&
1780 strsrch (string, "e+") == NULL) {
1781 lstr = strlen (string);
1782 s = string + lstr - 1;
1783 while (*s == '0' && lstr > 1) {
1784 if (*(s - 1) != '.') {
1785 *s = (char) 0;
1786 lstr --;
1787 }
1788 s--;
1789 }
1790 }
1791 }
1792
1793 /* Remove trailing decimal point */
1794 lstr = strlen (string);
1795 s = string + lstr - 1;
1796 if (*s == '.')
1797 *s = (char) 0;
1798
1799 /* Replace embedded blanks with underscores, if requested to */
1800 if (fillblank) {
1801 lstr = strlen (string);
1802 slast = string + lstr;
1803 for (s = string; s < slast; s++) {
1804 if (*s == ' ') *s = '_';
1805 }
1806 }
1807
1808 return;
1809
1810 }
1811
1812 /* Oct 28 1994 New program
1813 *
1814 * Mar 1 1995 Search for / after second quote, not first one
1815 * May 2 1995 Initialize line in HGETC; deal with logicals in HGETL better
1816 * May 4 1995 Declare STRSRCH in KSEARCH
1817 * Aug 7 1995 Fix line initialization in HGETC
1818 * Dec 22 1995 Add HGETRA and HGETDEC to get degrees from xx:xx:xx.xxx string
1819 *
1820 * Jan 26 1996 Fix HGETL to not crash when parameter is not present
1821 * Feb 1 1996 Fix HGETC to deal with quotes correctly
1822 * Feb 1 1996 Fix HGETDEG to deal with sign correctly
1823 * Feb 6 1996 Add HGETS to update character strings
1824 * Feb 8 1996 Fix STRSRCH to find final characters in string
1825 * Feb 23 1996 Add string to degree conversions
1826 * Apr 26 1996 Add HGETDATE to get fractional year from date string
1827 * May 22 1996 Fix documentation; return double from STR2RA and STR2DEC
1828 * May 28 1996 Fix string translation of RA and Dec when no seconds
1829 * Jun 10 1996 Remove unused variables after running lint
1830 * Jun 17 1996 Fix bug which failed to return single character strings
1831 * Jul 1 1996 Skip sign when reading declination after testing for it
1832 * Jul 19 1996 Do not divide by 15 if RA header value is already in degrees
1833 * Aug 5 1996 Add STRNSRCH to search strings which are not null-terminated
1834 * Aug 6 1996 Make minor changes after lint
1835 * Aug 8 1996 Fix ksearch bug which finds wrong keywords
1836 * Aug 13 1996 Fix sign bug in STR2DEC for degrees
1837 * Aug 26 1996 Drop unused variables ICOL0, NLINE, PREVCHAR from KSEARCH
1838 * Sep 10 1996 Fix header length setting code
1839 * Oct 15 1996 Clean up loops and fix ICOL assignment
1840 * Nov 13 1996 Handle integer degrees correctly in STR2DEC
1841 * Nov 21 1996 Make changes for Linux thanks to Sidik Isani
1842 * Dec 12 1996 Add ISNUM to check to see whether strings are numbers
1843 *
1844 * Jan 22 1997 Add ifdefs for Eric Mandel (SAOtng)
1845 * Jan 27 1997 Convert to integer through ATOF so exponents are recognized
1846 * Jul 25 1997 Implement FITS version of ISO date format
1847 *
1848 * Feb 24 1998 Implement code to return IRAF multiple-keyword strings
1849 * Mar 12 1998 Add subroutine NOTNUM
1850 * Mar 27 1998 Add changes to match SKYCAT version
1851 * Apr 30 1998 Add BLSEARCH() to find blank lines before END
1852 * May 27 1998 Add HGETNDEC() to get number of decimal places in entry
1853 * Jun 1 1998 Add VMS patch from Harry Payne at StSci
1854 * Jun 18 1998 Fix code which extracts tokens from string values
1855 * Jul 21 1998 Drop minus sign for values of -0
1856 * Sep 29 1998 Treat hyphen-separated date as old format if 2-digit year
1857 * Oct 7 1998 Clean up search for last blank line
1858 *
1859 * Apr 5 1999 Check lengths of strings before copying them
1860 * May 5 1999 values.h -> POSIX limits.h: MAXINT->INT_MAX, MAXSHORT->SHRT_MAX
1861 * Jul 15 1999 Add hgetm() options of 1- or 2-digit keyword extensions
1862 * Oct 6 1999 Add gethlength() to return header length
1863 * Oct 14 1999 In ksearch(), search only to null not to end of buffer
1864 * Oct 15 1999 Return 1 from hgetndec() if successful
1865 * Oct 20 1999 Drop unused variable after lint (val in hgetndec)
1866 * Dec 3 1999 Fix isnum() to reject strings starting with a d or e
1867 * Dec 20 1999 Update hgetdate() to get minutes and seconds right
1868 *
1869 * Feb 10 2000 Parse RA and Dec with spaces as well as colons as separators
1870 * Feb 11 2000 Add null at end of multi-line keyword value character string
1871 * Feb 25 2000 Change max search string length from 57600 to 256000
1872 * Mar 15 2000 Deal with missing second quotes in string values
1873 * Mar 17 2000 Return 2 from isnum() if number is floating point (.de)
1874 * Mar 17 2000 Ignore leading # for numeric values in header
1875 * Mar 21 2000 Implement -n to get string value starting with nth token
1876 * Apr 5 2000 Reject +- in isnum()
1877 * Jun 9 2000 Read keyword values even if no equal sign is present
1878 * Sep 20 2000 Ignore linefeed at end of number in isnum()
1879 * Oct 23 2000 Fix handling of embedded + or - in isnum()
1880 *
1881 * Jan 19 2000 Return 0 from isnum(), str2ra(), and str2dec() if string is null
1882 * Mar 30 2001 Fix header length finding algorithm in ksearch()
1883 * Jul 13 2001 Make val[] static int instead of int; drop unused variables
1884 * Sep 12 2001 Read yyyy/mm/dd dates as well as dd/mm/yyyy
1885 * Sep 20 2001 Ignore leading spaces in str2dec()
1886 * Sep 20 2001 Ignore trailing spaces in isnum()
1887 *
1888 * Apr 3 2002 Add hgetr8c(), hgeti4c(), and hgetsc() for multiple WCS handling
1889 * Apr 26 2002 Fix bug in hgetsc(), hgeti4c(), and hgetr8c() found by Bill Joye
1890 * Jun 26 2002 Do not drop leading or trailing spaces in multi-line values
1891 * Aug 6 2002 Add strcsrch() and strncsrch() for case-insensitive searches
1892 * Aug 30 2002 Fix bug so strcsrch() really is case-insensitive
1893 * Oct 20 2003 Add numdec() to return number of decimal places in a string
1894 * Dec 9 2003 Fix numdec() to return 0 if no digits after decimal point
1895 *
1896 * Feb 26 2004 Extract value from keyword=value strings within a keyword value
1897 * Apr 9 2004 Use strncsrch() in ksearch() to find differently-cased keywords
1898 * Apr 28 2004 Free os2 in strncsrch() only if it is allocated
1899 * Jul 13 2004 Accept D, d, E, or e as exponent delimiter in floating points
1900 * Aug 30 2004 Change numdec() to accept sexigesimal numbers (:'s)
1901 *
1902 * Jun 27 2005 Drop unused variables
1903 * Aug 30 2005 Adjust code in hlength()
1904 *
1905 * Jun 20 2006 Initialize uninitialized variables in strnsrch()
1906 * Jun 29 2006 Add new subroutine strfix() to clean strings for other uses
1907 * Jul 13 2006 Increase maximum number of multiline keywords from 20 to 500
1908 *
1909 * Jan 4 2007 Declare header, keyword to be const
1910 * Jan 4 2007 Change WCS letter from char to char*
1911 * Feb 28 2007 If header length is not set in hlength, set it to 0
1912 * May 31 2007 Add return value of 3 to isnum() if string has colon(s)
1913 * Aug 22 2007 If closing quote not found, make one up
1914 *
1915 * Nov 12 2009 In strfix(), if drop enclosing parantheses
1916 *
1917 * Apr 19 2011 In str2dec(), change comma to space
1918 * May 19 2011 In strncsrch() always free allocated memory before returning
1919 *
1920 * Nov 6 2015 In isnum(), add return of 4 for yyyy-mm-dd dates
1921 *
1922 * Jun 9 2016 Fix isnum() tests for added coloned times and dashed dates
1923 */
1924