1 /*------------------------------------------------------------------------*/
2 /*                                                                        */
3 /*  These routines have been modified by William Pence for use by CFITSIO */
4 /*        The original files were provided by Doug Mink                   */
5 /*------------------------------------------------------------------------*/
6 
7 /* File imhfile.c
8  * August 6, 1998
9  * By Doug Mink, based on Mike VanHilst's readiraf.c
10 
11  * Module:      imhfile.c (IRAF .imh image file reading and writing)
12  * Purpose:     Read and write IRAF image files (and translate headers)
13  * Subroutine:  irafrhead (filename, lfhead, fitsheader, lihead)
14  *              Read IRAF image header
15  * Subroutine:  irafrimage (fitsheader)
16  *              Read IRAF image pixels (call after irafrhead)
17  * Subroutine:	same_path (pixname, hdrname)
18  *		Put filename and header path together
19  * Subroutine:	iraf2fits (hdrname, irafheader, nbiraf, nbfits)
20  *		Convert IRAF image header to FITS image header
21  * Subroutine:  irafgeti4 (irafheader, offset)
22  *		Get 4-byte integer from arbitrary part of IRAF header
23  * Subroutine:  irafgetc2 (irafheader, offset)
24  *		Get character string from arbitrary part of IRAF v.1 header
25  * Subroutine:  irafgetc (irafheader, offset)
26  *		Get character string from arbitrary part of IRAF header
27  * Subroutine:  iraf2str (irafstring, nchar)
28  * 		Convert 2-byte/char IRAF string to 1-byte/char string
29  * Subroutine:	irafswap (bitpix,string,nbytes)
30  *		Swap bytes in string in place, with FITS bits/pixel code
31  * Subroutine:	irafswap2 (string,nbytes)
32  *		Swap bytes in string in place
33  * Subroutine	irafswap4 (string,nbytes)
34  *		Reverse bytes of Integer*4 or Real*4 vector in place
35  * Subroutine	irafswap8 (string,nbytes)
36  *		Reverse bytes of Real*8 vector in place
37 
38 
39  * Copyright:   2000 Smithsonian Astrophysical Observatory
40  *              You may do anything you like with this file except remove
41  *              this copyright.  The Smithsonian Astrophysical Observatory
42  *              makes no representations about the suitability of this
43  *              software for any purpose.  It is provided "as is" without
44  *              express or implied warranty.
45  */
46 
47 #include "fitsio2.h"
48 #include <stdio.h>		/* define stderr, FD, and NULL */
49 #include <stdlib.h>
50 #include <stddef.h>  /* stddef.h is apparently needed to define size_t */
51 #include <string.h>
52 
53 #define FILE_NOT_OPENED 104
54 
55 /* Parameters from iraf/lib/imhdr.h for IRAF version 1 images */
56 #define SZ_IMPIXFILE	 79		/* name of pixel storage file */
57 #define SZ_IMHDRFILE	 79   		/* length of header storage file */
58 #define SZ_IMTITLE	 79		/* image title string */
59 #define LEN_IMHDR	2052		/* length of std header */
60 
61 /* Parameters from iraf/lib/imhdr.h for IRAF version 2 images */
62 #define	SZ_IM2PIXFILE	255		/* name of pixel storage file */
63 #define	SZ_IM2HDRFILE	255		/* name of header storage file */
64 #define	SZ_IM2TITLE	383		/* image title string */
65 #define LEN_IM2HDR	2046		/* length of std header */
66 
67 /* Offsets into header in bytes for parameters in IRAF version 1 images */
68 #define IM_HDRLEN	 12		/* Length of header in 4-byte ints */
69 #define IM_PIXTYPE       16             /* Datatype of the pixels */
70 #define IM_NDIM          20             /* Number of dimensions */
71 #define IM_LEN           24             /* Length (as stored) */
72 #define IM_PHYSLEN       52             /* Physical length (as stored) */
73 #define IM_PIXOFF        88             /* Offset of the pixels */
74 #define IM_CTIME        108             /* Time of image creation */
75 #define IM_MTIME        112             /* Time of last modification */
76 #define IM_LIMTIME      116             /* Time of min,max computation */
77 #define IM_MAX          120             /* Maximum pixel value */
78 #define IM_MIN          124             /* Maximum pixel value */
79 #define IM_PIXFILE      412             /* Name of pixel storage file */
80 #define IM_HDRFILE      572             /* Name of header storage file */
81 #define IM_TITLE        732             /* Image name string */
82 
83 /* Offsets into header in bytes for parameters in IRAF version 2 images */
84 #define IM2_HDRLEN	  6		/* Length of header in 4-byte ints */
85 #define IM2_PIXTYPE      10             /* Datatype of the pixels */
86 #define IM2_SWAPPED      14             /* Pixels are byte swapped */
87 #define IM2_NDIM         18             /* Number of dimensions */
88 #define IM2_LEN          22             /* Length (as stored) */
89 #define IM2_PHYSLEN      50             /* Physical length (as stored) */
90 #define IM2_PIXOFF       86             /* Offset of the pixels */
91 #define IM2_CTIME       106             /* Time of image creation */
92 #define IM2_MTIME       110             /* Time of last modification */
93 #define IM2_LIMTIME     114             /* Time of min,max computation */
94 #define IM2_MAX         118             /* Maximum pixel value */
95 #define IM2_MIN         122             /* Maximum pixel value */
96 #define IM2_PIXFILE     126             /* Name of pixel storage file */
97 #define IM2_HDRFILE     382             /* Name of header storage file */
98 #define IM2_TITLE       638             /* Image name string */
99 
100 /* Codes from iraf/unix/hlib/iraf.h */
101 #define	TY_CHAR		2
102 #define	TY_SHORT	3
103 #define	TY_INT		4
104 #define	TY_LONG		5
105 #define	TY_REAL		6
106 #define	TY_DOUBLE	7
107 #define	TY_COMPLEX	8
108 #define TY_POINTER      9
109 #define TY_STRUCT       10
110 #define TY_USHORT       11
111 #define TY_UBYTE        12
112 
113 #define LEN_PIXHDR	1024
114 #define MAXINT  2147483647 /* Biggest number that can fit in long */
115 
116 static int isirafswapped(char *irafheader, int offset);
117 static int irafgeti4(char *irafheader, int offset);
118 static char *irafgetc2(char *irafheader, int offset, int nc);
119 static char *irafgetc(char *irafheader,	int offset, int	nc);
120 static char *iraf2str(char *irafstring, int nchar);
121 static char *irafrdhead(const char *filename, int *lihead);
122 static int irafrdimage (char **buffptr, size_t *buffsize,
123     size_t *filesize, int *status);
124 static int iraftofits (char *hdrname, char *irafheader, int nbiraf,
125     char **buffptr, size_t *nbfits, size_t *fitssize, int *status);
126 static char *same_path(char *pixname, const char *hdrname);
127 
128 static int swaphead=0;	/* =1 to swap data bytes of IRAF header values */
129 static int swapdata=0;  /* =1 to swap bytes in IRAF data pixels */
130 
131 static void irafswap(int bitpix, char *string, int nbytes);
132 static void irafswap2(char *string, int nbytes);
133 static void irafswap4(char *string, int nbytes);
134 static void irafswap8(char *string, int nbytes);
135 static int pix_version (char *irafheader);
136 static int irafncmp (char *irafheader, char *teststring, int nc);
137 static int machswap(void);
138 static int head_version (char *irafheader);
139 static int hgeti4(char* hstring, char* keyword, int* val);
140 static int hgets(char* hstring, char* keyword, int lstr, char* string);
141 static char* hgetc(char* hstring, char* keyword);
142 static char* ksearch(char* hstring, char* keyword);
143 static char *blsearch (char* hstring, char* keyword);
144 static char *strsrch (char* s1,	char* s2);
145 static char *strnsrch (	char* s1,char* s2,int ls1);
146 static void hputi4(char* hstring,char* keyword,	int ival);
147 static void hputs(char* hstring,char* keyword,char* cval);
148 static void hputcom(char* hstring,char* keyword,char* comment);
149 static void hputl(char* hstring,char* keyword,int lval);
150 static void hputc(char* hstring,char* keyword,char* cval);
151 static int getirafpixname (const char *hdrname, char *irafheader, char *pixfilename, int *status);
152 int iraf2mem(char *filename, char **buffptr, size_t *buffsize,
153       size_t *filesize, int *status);
154 
155 void ffpmsg(const char *err_message);
156 
157 /* CFITS_API is defined below for use on Windows systems.  */
158 /* It is used to identify the public functions which should be exported. */
159 /* This has no effect on non-windows platforms where "WIN32" is not defined */
160 
161 /* this is only needed to export the "fits_delete_iraf_file" symbol, which */
162 /* is called in fpackutil.c (and perhaps in other applications programs) */
163 
164 #if defined (WIN32)
165   #if defined(cfitsio_EXPORTS)
166     #define CFITS_API __declspec(dllexport)
167   #else
168     #define CFITS_API //__declspec(dllimport)
169   #endif /* CFITS_API */
170 #else /* defined (WIN32) */
171  #define CFITS_API
172 #endif
173 
174 int CFITS_API fits_delete_iraf_file(const char *filename, int *status);
175 
176 
177 /*--------------------------------------------------------------------------*/
fits_delete_iraf_file(const char * filename,int * status)178 int fits_delete_iraf_file(const char *filename,  /* name of input file      */
179              int *status)                        /* IO - error status       */
180 
181 /*
182    Delete the iraf .imh header file and the associated .pix data file
183 */
184 {
185     char *irafheader;
186     int lenirafhead;
187 
188     char pixfilename[SZ_IM2PIXFILE+1];
189 
190     /* read IRAF header into dynamically created char array (free it later!) */
191     irafheader = irafrdhead(filename, &lenirafhead);
192 
193     if (!irafheader)
194     {
195 	return(*status = FILE_NOT_OPENED);
196     }
197 
198     getirafpixname (filename, irafheader, pixfilename, status);
199 
200     /* don't need the IRAF header any more */
201     free(irafheader);
202 
203     if (*status > 0)
204        return(*status);
205 
206     remove(filename);
207     remove(pixfilename);
208 
209     return(*status);
210 }
211 
212 /*--------------------------------------------------------------------------*/
iraf2mem(char * filename,char ** buffptr,size_t * buffsize,size_t * filesize,int * status)213 int iraf2mem(char *filename,     /* name of input file                 */
214              char **buffptr,     /* O - memory pointer (initially NULL)    */
215              size_t *buffsize,   /* O - size of mem buffer, in bytes        */
216              size_t *filesize,   /* O - size of FITS file, in bytes         */
217              int *status)        /* IO - error status                       */
218 
219 /*
220    Driver routine that reads an IRAF image into memory, also converting
221    it into FITS format.
222 */
223 {
224     char *irafheader;
225     int lenirafhead;
226 
227     *buffptr = NULL;
228     *buffsize = 0;
229     *filesize = 0;
230 
231     /* read IRAF header into dynamically created char array (free it later!) */
232     irafheader = irafrdhead(filename, &lenirafhead);
233 
234     if (!irafheader)
235     {
236 	return(*status = FILE_NOT_OPENED);
237     }
238 
239     /* convert IRAF header to FITS header in memory */
240     iraftofits(filename, irafheader, lenirafhead, buffptr, buffsize, filesize,
241                status);
242 
243     /* don't need the IRAF header any more */
244     free(irafheader);
245 
246     if (*status > 0)
247        return(*status);
248 
249     *filesize = (((*filesize - 1) / 2880 ) + 1 ) * 2880; /* multiple of 2880 */
250 
251     /* append the image data onto the FITS header */
252     irafrdimage(buffptr, buffsize, filesize, status);
253 
254     return(*status);
255 }
256 
257 /*--------------------------------------------------------------------------*/
258 /* Subroutine:	irafrdhead  (was irafrhead in D. Mink's original code)
259  * Purpose:	Open and read the iraf .imh file.
260  * Returns:	NULL if failure, else pointer to IRAF .imh image header
261  * Notes:	The imhdr format is defined in iraf/lib/imhdr.h, some of
262  *		which defines or mimicked, above.
263  */
264 
irafrdhead(const char * filename,int * lihead)265 static char *irafrdhead (
266     const char *filename,  /* Name of IRAF header file */
267     int *lihead)           /* Length of IRAF image header in bytes (returned) */
268 {
269     FILE *fd;
270     int nbr;
271     char *irafheader;
272     char errmsg[FLEN_ERRMSG];
273     long nbhead;
274     int nihead;
275 
276     *lihead = 0;
277 
278     /* open the image header file */
279     fd = fopen (filename, "rb");
280     if (fd == NULL) {
281         ffpmsg("unable to open IRAF header file:");
282         ffpmsg(filename);
283 	return (NULL);
284 	}
285 
286     /* Find size of image header file */
287     if (fseek(fd, 0, 2) != 0)  /* move to end of the file */
288     {
289         ffpmsg("IRAFRHEAD: cannot seek in file:");
290         ffpmsg(filename);
291         return(NULL);
292     }
293 
294     nbhead = ftell(fd);     /* position = size of file */
295     if (nbhead < 0)
296     {
297         ffpmsg("IRAFRHEAD: cannot get pos. in file:");
298         ffpmsg(filename);
299         return(NULL);
300     }
301 
302     if (fseek(fd, 0, 0) != 0) /* move back to beginning */
303     {
304         ffpmsg("IRAFRHEAD: cannot seek to beginning of file:");
305         ffpmsg(filename);
306         return(NULL);
307     }
308 
309     /* allocate initial sized buffer */
310     nihead = nbhead + 5000;
311     irafheader = (char *) calloc (1, nihead);
312     if (irafheader == NULL) {
313 	snprintf(errmsg, FLEN_ERRMSG,"IRAFRHEAD Cannot allocate %d-byte header",
314 		      nihead);
315         ffpmsg(errmsg);
316         ffpmsg(filename);
317 	return (NULL);
318 	}
319     *lihead = nihead;
320 
321     /* Read IRAF header */
322     nbr = fread (irafheader, 1, nbhead, fd);
323     fclose (fd);
324 
325     /* Reject if header less than minimum length */
326     if (nbr < LEN_PIXHDR) {
327 	snprintf(errmsg, FLEN_ERRMSG,"IRAFRHEAD header file: %d / %d bytes read.",
328 		      nbr,LEN_PIXHDR);
329         ffpmsg(errmsg);
330         ffpmsg(filename);
331 	free (irafheader);
332 	return (NULL);
333 	}
334 
335     return (irafheader);
336 }
337 /*--------------------------------------------------------------------------*/
irafrdimage(char ** buffptr,size_t * buffsize,size_t * filesize,int * status)338 static int irafrdimage (
339     char **buffptr,	/* FITS image header (filled) */
340     size_t *buffsize,      /* allocated size of the buffer */
341     size_t *filesize,      /* actual size of the FITS file */
342     int *status)
343 {
344     FILE *fd;
345     char *bang;
346     int nax = 1, naxis1 = 1, naxis2 = 1, naxis3 = 1, naxis4 = 1, npaxis1 = 1, npaxis2;
347     int bitpix, bytepix, i;
348     char *fitsheader, *image;
349     int nbr, nbimage, nbaxis, nbl, nbdiff;
350     char *pixheader;
351     char *linebuff;
352     int imhver, lpixhead = 0;
353     char pixname[SZ_IM2PIXFILE+1];
354     char errmsg[FLEN_ERRMSG];
355     size_t newfilesize;
356 
357     fitsheader = *buffptr;           /* pointer to start of header */
358 
359     /* Convert pixel file name to character string */
360     hgets (fitsheader, "PIXFILE", SZ_IM2PIXFILE, pixname);
361     hgeti4 (fitsheader, "PIXOFF", &lpixhead);
362 
363     /* Open pixel file, ignoring machine name if present */
364     if ((bang = strchr (pixname, '!')) != NULL )
365 	fd = fopen (bang + 1, "rb");
366     else
367 	fd = fopen (pixname, "rb");
368 
369     /* Print error message and exit if pixel file is not found */
370     if (!fd) {
371         ffpmsg("IRAFRIMAGE: Cannot open IRAF pixel file:");
372         ffpmsg(pixname);
373 	return (*status = FILE_NOT_OPENED);
374 	}
375 
376     /* Read pixel header */
377     pixheader = (char *) calloc (lpixhead, 1);
378     if (pixheader == NULL) {
379             ffpmsg("IRAFRIMAGE: Cannot alloc memory for pixel header");
380             ffpmsg(pixname);
381             fclose (fd);
382 	    return (*status = FILE_NOT_OPENED);
383 	}
384     nbr = fread (pixheader, 1, lpixhead, fd);
385 
386     /* Check size of pixel header */
387     if (nbr < lpixhead) {
388 	snprintf(errmsg, FLEN_ERRMSG,"IRAF pixel file: %d / %d bytes read.",
389 		      nbr,LEN_PIXHDR);
390         ffpmsg(errmsg);
391 	free (pixheader);
392 	fclose (fd);
393 	return (*status = FILE_NOT_OPENED);
394 	}
395 
396     /* check pixel header magic word */
397     imhver = pix_version (pixheader);
398     if (imhver < 1) {
399         ffpmsg("File not valid IRAF pixel file:");
400         ffpmsg(pixname);
401 	free (pixheader);
402 	fclose (fd);
403 	return (*status = FILE_NOT_OPENED);
404 	}
405     free (pixheader);
406 
407     /* Find number of bytes to read */
408     hgeti4 (fitsheader,"NAXIS",&nax);
409     hgeti4 (fitsheader,"NAXIS1",&naxis1);
410     hgeti4 (fitsheader,"NPAXIS1",&npaxis1);
411     if (nax > 1) {
412         hgeti4 (fitsheader,"NAXIS2",&naxis2);
413         hgeti4 (fitsheader,"NPAXIS2",&npaxis2);
414 	}
415     if (nax > 2)
416         hgeti4 (fitsheader,"NAXIS3",&naxis3);
417     if (nax > 3)
418         hgeti4 (fitsheader,"NAXIS4",&naxis4);
419 
420     hgeti4 (fitsheader,"BITPIX",&bitpix);
421     if (bitpix < 0)
422 	bytepix = -bitpix / 8;
423     else
424 	bytepix = bitpix / 8;
425 
426     nbimage = naxis1 * naxis2 * naxis3 * naxis4 * bytepix;
427 
428     newfilesize = *filesize + nbimage;  /* header + data */
429     newfilesize = (((newfilesize - 1) / 2880 ) + 1 ) * 2880;
430 
431     if (newfilesize > *buffsize)   /* need to allocate more memory? */
432     {
433       fitsheader =  (char *) realloc (*buffptr, newfilesize);
434       if (fitsheader == NULL) {
435 	snprintf(errmsg, FLEN_ERRMSG,"IRAFRIMAGE Cannot allocate %d-byte image buffer",
436 		(int) (*filesize));
437         ffpmsg(errmsg);
438         ffpmsg(pixname);
439 	fclose (fd);
440 	return (*status = FILE_NOT_OPENED);
441 	}
442     }
443 
444     *buffptr = fitsheader;
445     *buffsize = newfilesize;
446 
447     image = fitsheader + *filesize;
448     *filesize = newfilesize;
449 
450     /* Read IRAF image all at once if physical and image dimensions are the same */
451     if (npaxis1 == naxis1)
452 	nbr = fread (image, 1, nbimage, fd);
453 
454     /* Read IRAF image one line at a time if physical and image dimensions differ */
455     else {
456 	nbdiff = (npaxis1 - naxis1) * bytepix;
457 	nbaxis = naxis1 * bytepix;
458 	linebuff = image;
459 	nbr = 0;
460 	if (naxis2 == 1 && naxis3 > 1)
461 	    naxis2 = naxis3;
462 	for (i = 0; i < naxis2; i++) {
463 	    nbl = fread (linebuff, 1, nbaxis, fd);
464 	    nbr = nbr + nbl;
465 	    fseek (fd, nbdiff, 1);
466 	    linebuff = linebuff + nbaxis;
467 	    }
468 	}
469     fclose (fd);
470 
471     /* Check size of image */
472     if (nbr < nbimage) {
473 	snprintf(errmsg, FLEN_ERRMSG,"IRAF pixel file: %d / %d bytes read.",
474 		      nbr,nbimage);
475         ffpmsg(errmsg);
476         ffpmsg(pixname);
477 	return (*status = FILE_NOT_OPENED);
478 	}
479 
480     /* Byte-reverse image, if necessary */
481     if (swapdata)
482 	irafswap (bitpix, image, nbimage);
483 
484     return (*status);
485 }
486 /*--------------------------------------------------------------------------*/
487 /* Return IRAF image format version number from magic word in IRAF header*/
488 
head_version(char * irafheader)489 static int head_version (
490     char *irafheader)	/* IRAF image header from file */
491 
492 {
493 
494     /* Check header file magic word */
495     if (irafncmp (irafheader, "imhdr", 5) != 0 ) {
496 	if (strncmp (irafheader, "imhv2", 5) != 0)
497 	    return (0);
498 	else
499 	    return (2);
500 	}
501     else
502 	return (1);
503 }
504 
505 /*--------------------------------------------------------------------------*/
506 /* Return IRAF image format version number from magic word in IRAF pixel file */
507 
pix_version(char * irafheader)508 static int pix_version (
509     char *irafheader)   /* IRAF image header from file */
510 {
511 
512     /* Check pixel file header magic word */
513     if (irafncmp (irafheader, "impix", 5) != 0) {
514 	if (strncmp (irafheader, "impv2", 5) != 0)
515 	    return (0);
516 	else
517 	    return (2);
518 	}
519     else
520 	return (1);
521 }
522 
523 /*--------------------------------------------------------------------------*/
524 /* Verify that file is valid IRAF imhdr or impix by checking first 5 chars
525  * Returns:	0 on success, 1 on failure */
526 
irafncmp(char * irafheader,char * teststring,int nc)527 static int irafncmp (
528 
529 char	*irafheader,	/* IRAF image header from file */
530 char	*teststring,	/* C character string to compare */
531 int	nc)		/* Number of characters to compate */
532 
533 {
534     char *line;
535 
536     if ((line = iraf2str (irafheader, nc)) == NULL)
537 	return (1);
538     if (strncmp (line, teststring, nc) == 0) {
539 	free (line);
540 	return (0);
541 	}
542     else {
543 	free (line);
544 	return (1);
545 	}
546 }
547 /*--------------------------------------------------------------------------*/
548 
549 /* Convert IRAF image header to FITS image header, returning FITS header */
550 
iraftofits(char * hdrname,char * irafheader,int nbiraf,char ** buffptr,size_t * nbfits,size_t * fitssize,int * status)551 static int iraftofits (
552     char    *hdrname,  /* IRAF header file name (may be path) */
553     char    *irafheader,  /* IRAF image header */
554     int	    nbiraf,	  /* Number of bytes in IRAF header */
555     char    **buffptr,    /* pointer to the FITS header  */
556     size_t  *nbfits,      /* allocated size of the FITS header buffer */
557     size_t  *fitssize,  /* Number of bytes in FITS header (returned) */
558                         /*  = number of bytes to the end of the END keyword */
559     int     *status)
560 {
561     char *objname;	/* object name from FITS file */
562     int lstr, i, j, k, ib, nax, nbits;
563     char *pixname, *newpixname, *bang, *chead;
564     char *fitsheader;
565     int nblock, nlines;
566     char *fhead, *fhead1, *fp, endline[81];
567     char irafchar;
568     char fitsline[81];
569     int pixtype;
570     int imhver, n, imu, pixoff, impixoff;
571 /*    int immax, immin, imtime;  */
572     int imndim, imlen, imphyslen, impixtype;
573     char errmsg[FLEN_ERRMSG];
574 
575     /* Set up last line of FITS header */
576     (void)strncpy (endline,"END", 3);
577     for (i = 3; i < 80; i++)
578 	endline[i] = ' ';
579     endline[80] = 0;
580 
581     /* Check header magic word */
582     imhver = head_version (irafheader);
583     if (imhver < 1) {
584 	ffpmsg("File not valid IRAF image header");
585         ffpmsg(hdrname);
586 	return(*status = FILE_NOT_OPENED);
587 	}
588     if (imhver == 2) {
589 	nlines = 24 + ((nbiraf - LEN_IM2HDR) / 81);
590 	imndim = IM2_NDIM;
591 	imlen = IM2_LEN;
592 	imphyslen = IM2_PHYSLEN;
593 	impixtype = IM2_PIXTYPE;
594 	impixoff = IM2_PIXOFF;
595 /*	imtime = IM2_MTIME; */
596 /*	immax = IM2_MAX;  */
597 /*	immin = IM2_MIN; */
598 	}
599     else {
600 	nlines = 24 + ((nbiraf - LEN_IMHDR) / 162);
601 	imndim = IM_NDIM;
602 	imlen = IM_LEN;
603 	imphyslen = IM_PHYSLEN;
604 	impixtype = IM_PIXTYPE;
605 	impixoff = IM_PIXOFF;
606 /*	imtime = IM_MTIME; */
607 /*	immax = IM_MAX; */
608 /*	immin = IM_MIN; */
609 	}
610 
611     /*  Initialize FITS header */
612     nblock = (nlines * 80) / 2880;
613     *nbfits = (nblock + 5) * 2880 + 4;
614     fitsheader = (char *) calloc (*nbfits, 1);
615     if (fitsheader == NULL) {
616 	snprintf(errmsg, FLEN_ERRMSG,"IRAF2FITS Cannot allocate %d-byte FITS header",
617 		(int) (*nbfits));
618         ffpmsg(hdrname);
619 	return (*status = FILE_NOT_OPENED);
620 	}
621 
622     fhead = fitsheader;
623     *buffptr = fitsheader;
624     (void)strncpy (fitsheader, endline, 80);
625     hputl (fitsheader, "SIMPLE", 1);
626     fhead = fhead + 80;
627 
628     /*  check if the IRAF file is in big endian (sun) format (= 0) or not. */
629     /*  This is done by checking the 4 byte integer in the header that     */
630     /*  represents the iraf pixel type.  This 4-byte word is guaranteed to */
631     /*  have the least sig byte != 0 and the most sig byte = 0,  so if the */
632     /*  first byte of the word != 0, then the file in little endian format */
633     /*  like on an Alpha machine.                                          */
634 
635     swaphead = isirafswapped(irafheader, impixtype);
636     if (imhver == 1)
637         swapdata = swaphead; /* vers 1 data has same swapness as header */
638     else
639         swapdata = irafgeti4 (irafheader, IM2_SWAPPED);
640 
641     /*  Set pixel size in FITS header */
642     pixtype = irafgeti4 (irafheader, impixtype);
643     switch (pixtype) {
644 	case TY_CHAR:
645 	    nbits = 8;
646 	    break;
647 	case TY_UBYTE:
648 	    nbits = 8;
649 	    break;
650 	case TY_SHORT:
651 	    nbits = 16;
652 	    break;
653 	case TY_USHORT:
654 	    nbits = -16;
655 	    break;
656 	case TY_INT:
657 	case TY_LONG:
658 	    nbits = 32;
659 	    break;
660 	case TY_REAL:
661 	    nbits = -32;
662 	    break;
663 	case TY_DOUBLE:
664 	    nbits = -64;
665 	    break;
666 	default:
667 	    snprintf(errmsg,FLEN_ERRMSG,"Unsupported IRAF data type: %d", pixtype);
668             ffpmsg(errmsg);
669             ffpmsg(hdrname);
670 	    return (*status = FILE_NOT_OPENED);
671 	}
672     hputi4 (fitsheader,"BITPIX",nbits);
673     hputcom (fitsheader,"BITPIX", "IRAF .imh pixel type");
674     fhead = fhead + 80;
675 
676     /*  Set image dimensions in FITS header */
677     nax = irafgeti4 (irafheader, imndim);
678     hputi4 (fitsheader,"NAXIS",nax);
679     hputcom (fitsheader,"NAXIS", "IRAF .imh naxis");
680     fhead = fhead + 80;
681 
682     n = irafgeti4 (irafheader, imlen);
683     hputi4 (fitsheader, "NAXIS1", n);
684     hputcom (fitsheader,"NAXIS1", "IRAF .imh image naxis[1]");
685     fhead = fhead + 80;
686 
687     if (nax > 1) {
688 	n = irafgeti4 (irafheader, imlen+4);
689 	hputi4 (fitsheader, "NAXIS2", n);
690 	hputcom (fitsheader,"NAXIS2", "IRAF .imh image naxis[2]");
691         fhead = fhead + 80;
692 	}
693     if (nax > 2) {
694 	n = irafgeti4 (irafheader, imlen+8);
695 	hputi4 (fitsheader, "NAXIS3", n);
696 	hputcom (fitsheader,"NAXIS3", "IRAF .imh image naxis[3]");
697 	fhead = fhead + 80;
698 	}
699     if (nax > 3) {
700 	n = irafgeti4 (irafheader, imlen+12);
701 	hputi4 (fitsheader, "NAXIS4", n);
702 	hputcom (fitsheader,"NAXIS4", "IRAF .imh image naxis[4]");
703 	fhead = fhead + 80;
704 	}
705 
706     /* Set object name in FITS header */
707     if (imhver == 2)
708 	objname = irafgetc (irafheader, IM2_TITLE, SZ_IM2TITLE);
709     else
710 	objname = irafgetc2 (irafheader, IM_TITLE, SZ_IMTITLE);
711     if ((lstr = strlen (objname)) < 8) {
712 	for (i = lstr; i < 8; i++)
713 	    objname[i] = ' ';
714 	objname[8] = 0;
715 	}
716     hputs (fitsheader,"OBJECT",objname);
717     hputcom (fitsheader,"OBJECT", "IRAF .imh title");
718     free (objname);
719     fhead = fhead + 80;
720 
721     /* Save physical axis lengths so image file can be read */
722     n = irafgeti4 (irafheader, imphyslen);
723     hputi4 (fitsheader, "NPAXIS1", n);
724     hputcom (fitsheader,"NPAXIS1", "IRAF .imh physical naxis[1]");
725     fhead = fhead + 80;
726     if (nax > 1) {
727 	n = irafgeti4 (irafheader, imphyslen+4);
728 	hputi4 (fitsheader, "NPAXIS2", n);
729 	hputcom (fitsheader,"NPAXIS2", "IRAF .imh physical naxis[2]");
730 	fhead = fhead + 80;
731 	}
732     if (nax > 2) {
733 	n = irafgeti4 (irafheader, imphyslen+8);
734 	hputi4 (fitsheader, "NPAXIS3", n);
735 	hputcom (fitsheader,"NPAXIS3", "IRAF .imh physical naxis[3]");
736 	fhead = fhead + 80;
737 	}
738     if (nax > 3) {
739 	n = irafgeti4 (irafheader, imphyslen+12);
740 	hputi4 (fitsheader, "NPAXIS4", n);
741 	hputcom (fitsheader,"NPAXIS4", "IRAF .imh physical naxis[4]");
742 	fhead = fhead + 80;
743 	}
744 
745     /* Save image header filename in header */
746     hputs (fitsheader,"IMHFILE",hdrname);
747     hputcom (fitsheader,"IMHFILE", "IRAF header file name");
748     fhead = fhead + 80;
749 
750     /* Save image pixel file pathname in header */
751     if (imhver == 2)
752 	pixname = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE);
753     else
754 	pixname = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE);
755     if (strncmp(pixname, "HDR", 3) == 0 ) {
756 	newpixname = same_path (pixname, hdrname);
757         if (newpixname) {
758           free (pixname);
759           pixname = newpixname;
760 	  }
761 	}
762     if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) {
763 	newpixname = same_path (pixname, hdrname);
764         if (newpixname) {
765           free (pixname);
766           pixname = newpixname;
767 	  }
768 	}
769 
770     if ((bang = strchr (pixname, '!')) != NULL )
771 	hputs (fitsheader,"PIXFILE",bang+1);
772     else
773 	hputs (fitsheader,"PIXFILE",pixname);
774     free (pixname);
775     hputcom (fitsheader,"PIXFILE", "IRAF .pix pixel file");
776     fhead = fhead + 80;
777 
778     /* Save image offset from star of pixel file */
779     pixoff = irafgeti4 (irafheader, impixoff);
780     pixoff = (pixoff - 1) * 2;
781     hputi4 (fitsheader, "PIXOFF", pixoff);
782     hputcom (fitsheader,"PIXOFF", "IRAF .pix pixel offset (Do not change!)");
783     fhead = fhead + 80;
784 
785     /* Save IRAF file format version in header */
786     hputi4 (fitsheader,"IMHVER",imhver);
787     hputcom (fitsheader,"IMHVER", "IRAF .imh format version (1 or 2)");
788     fhead = fhead + 80;
789 
790     /* Save flag as to whether to swap IRAF data for this file and machine */
791     if (swapdata)
792 	hputl (fitsheader, "PIXSWAP", 1);
793     else
794 	hputl (fitsheader, "PIXSWAP", 0);
795     hputcom (fitsheader,"PIXSWAP", "IRAF pixels, FITS byte orders differ if T");
796     fhead = fhead + 80;
797 
798     /* Add user portion of IRAF header to FITS header */
799     fitsline[80] = 0;
800     if (imhver == 2) {
801 	imu = LEN_IM2HDR;
802 	chead = irafheader;
803 	j = 0;
804 	for (k = 0; k < 80; k++)
805 	    fitsline[k] = ' ';
806 	for (i = imu; i < nbiraf; i++) {
807 	    irafchar = chead[i];
808 	    if (irafchar == 0)
809 		break;
810 	    else if (irafchar == 10) {
811 		(void)strncpy (fhead, fitsline, 80);
812 		/* fprintf (stderr,"%80s\n",fitsline); */
813 		if (strncmp (fitsline, "OBJECT ", 7) != 0) {
814 		    fhead = fhead + 80;
815 		    }
816 		for (k = 0; k < 80; k++)
817 		    fitsline[k] = ' ';
818 		j = 0;
819 		}
820 	    else {
821 		if (j > 80) {
822 		    if (strncmp (fitsline, "OBJECT ", 7) != 0) {
823 			(void)strncpy (fhead, fitsline, 80);
824 			/* fprintf (stderr,"%80s\n",fitsline); */
825 			j = 9;
826 			fhead = fhead + 80;
827 			}
828 		    for (k = 0; k < 80; k++)
829 			fitsline[k] = ' ';
830 		    }
831 		if (irafchar > 32 && irafchar < 127)
832 		    fitsline[j] = irafchar;
833 		j++;
834 		}
835 	    }
836 	}
837     else {
838 	imu = LEN_IMHDR;
839 	chead = irafheader;
840 	if (swaphead == 1)
841 	    ib = 0;
842 	else
843 	    ib = 1;
844 	for (k = 0; k < 80; k++)
845 	    fitsline[k] = ' ';
846 	j = 0;
847 	for (i = imu; i < nbiraf; i=i+2) {
848 	    irafchar = chead[i+ib];
849 	    if (irafchar == 0)
850 		break;
851 	    else if (irafchar == 10) {
852 		if (strncmp (fitsline, "OBJECT ", 7) != 0) {
853 		    (void)strncpy (fhead, fitsline, 80);
854 		    fhead = fhead + 80;
855 		    }
856 		/* fprintf (stderr,"%80s\n",fitsline); */
857 		j = 0;
858 		for (k = 0; k < 80; k++)
859 		    fitsline[k] = ' ';
860 		}
861 	    else {
862 		if (j > 80) {
863 		    if (strncmp (fitsline, "OBJECT ", 7) != 0) {
864 			(void)strncpy (fhead, fitsline, 80);
865 			j = 9;
866 			fhead = fhead + 80;
867 			}
868 		    /* fprintf (stderr,"%80s\n",fitsline); */
869 		    for (k = 0; k < 80; k++)
870 			fitsline[k] = ' ';
871 		    }
872 		if (irafchar > 32 && irafchar < 127)
873 		    fitsline[j] = irafchar;
874 		j++;
875 		}
876 	    }
877 	}
878 
879     /* Add END to last line */
880     (void)strncpy (fhead, endline, 80);
881 
882     /* Find end of last 2880-byte block of header */
883     fhead = ksearch (fitsheader, "END") + 80;
884     nblock = *nbfits / 2880;
885     fhead1 = fitsheader + (nblock * 2880);
886     *fitssize = fhead - fitsheader;  /* no. of bytes to end of END keyword */
887 
888     /* Pad rest of header with spaces */
889     strncpy (endline,"   ",3);
890     for (fp = fhead; fp < fhead1; fp = fp + 80) {
891 	(void)strncpy (fp, endline,80);
892 	}
893 
894     return (*status);
895 }
896 /*--------------------------------------------------------------------------*/
897 
898 /* get the IRAF pixel file name */
899 
getirafpixname(const char * hdrname,char * irafheader,char * pixfilename,int * status)900 static int getirafpixname (
901     const char *hdrname,  /* IRAF header file name (may be path) */
902     char    *irafheader,  /* IRAF image header */
903     char    *pixfilename,     /* IRAF pixel file name */
904     int     *status)
905 {
906     int imhver;
907     char *pixname, *newpixname, *bang;
908 
909     /* Check header magic word */
910     imhver = head_version (irafheader);
911     if (imhver < 1) {
912 	ffpmsg("File not valid IRAF image header");
913         ffpmsg(hdrname);
914 	return(*status = FILE_NOT_OPENED);
915 	}
916 
917     /* get image pixel file pathname in header */
918     if (imhver == 2)
919 	pixname = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE);
920     else
921 	pixname = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE);
922 
923     if (strncmp(pixname, "HDR", 3) == 0 ) {
924 	newpixname = same_path (pixname, hdrname);
925         if (newpixname) {
926           free (pixname);
927           pixname = newpixname;
928 	  }
929 	}
930 
931     if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) {
932 	newpixname = same_path (pixname, hdrname);
933         if (newpixname) {
934           free (pixname);
935           pixname = newpixname;
936 	  }
937 	}
938 
939     if ((bang = strchr (pixname, '!')) != NULL )
940 	strcpy(pixfilename,bang+1);
941     else
942 	strcpy(pixfilename,pixname);
943 
944     free (pixname);
945 
946     return (*status);
947 }
948 
949 /*--------------------------------------------------------------------------*/
950 /* Put filename and header path together */
951 
same_path(char * pixname,const char * hdrname)952 static char *same_path (
953 
954 char	*pixname,	/* IRAF pixel file pathname */
955 const char	*hdrname)	/* IRAF image header file pathname */
956 
957 {
958     int len;
959     char *newpixname;
960 
961 /*  WDP - 10/16/2007 - increased allocation to avoid possible overflow */
962 /*    newpixname = (char *) calloc (SZ_IM2PIXFILE, sizeof (char)); */
963 
964     newpixname = (char *) calloc (2*SZ_IM2PIXFILE+1, sizeof (char));
965     if (newpixname == NULL) {
966             ffpmsg("iraffits same_path: Cannot alloc memory for newpixname");
967 	    return (NULL);
968 	}
969 
970     /* Pixel file is in same directory as header */
971     if (strncmp(pixname, "HDR$", 4) == 0 ) {
972 	(void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE);
973 
974 	/* find the end of the pathname */
975 	len = strlen (newpixname);
976 #ifndef VMS
977 	while( (len > 0) && (newpixname[len-1] != '/') )
978 #else
979 	while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') )
980 #endif
981 	    len--;
982 
983 	/* add name */
984 	newpixname[len] = '\0';
985 	(void)strncat (newpixname, &pixname[4], SZ_IM2PIXFILE);
986 	}
987 
988     /* Bare pixel file with no path is assumed to be same as HDR$filename */
989     else if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) {
990 	(void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE);
991 
992 	/* find the end of the pathname */
993 	len = strlen (newpixname);
994 #ifndef VMS
995 	while( (len > 0) && (newpixname[len-1] != '/') )
996 #else
997 	while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') )
998 #endif
999 	    len--;
1000 
1001 	/* add name */
1002 	newpixname[len] = '\0';
1003 	(void)strncat (newpixname, pixname, SZ_IM2PIXFILE);
1004 	}
1005 
1006     /* Pixel file has same name as header file, but with .pix extension */
1007     else if (strncmp (pixname, "HDR", 3) == 0) {
1008 
1009 	/* load entire header name string into name buffer */
1010 	(void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE);
1011 	len = strlen (newpixname);
1012 	newpixname[len-3] = 'p';
1013 	newpixname[len-2] = 'i';
1014 	newpixname[len-1] = 'x';
1015 	}
1016 
1017     return (newpixname);
1018 }
1019 
1020 /*--------------------------------------------------------------------------*/
isirafswapped(char * irafheader,int offset)1021 static int isirafswapped (
1022 
1023 char	*irafheader,	/* IRAF image header */
1024 int	offset)		/* Number of bytes to skip before number */
1025 
1026     /*  check if the IRAF file is in big endian (sun) format (= 0) or not */
1027     /*  This is done by checking the 4 byte integer in the header that */
1028     /*  represents the iraf pixel type.  This 4-byte word is guaranteed to */
1029     /*  have the least sig byte != 0 and the most sig byte = 0,  so if the */
1030     /*  first byte of the word != 0, then the file in little endian format */
1031     /*  like on an Alpha machine.                                          */
1032 
1033 {
1034     int  swapped;
1035 
1036     if (irafheader[offset] != 0)
1037 	swapped = 1;
1038     else
1039 	swapped = 0;
1040 
1041     return (swapped);
1042 }
1043 /*--------------------------------------------------------------------------*/
irafgeti4(char * irafheader,int offset)1044 static int irafgeti4 (
1045 
1046 char	*irafheader,	/* IRAF image header */
1047 int	offset)		/* Number of bytes to skip before number */
1048 
1049 {
1050     char *ctemp, *cheader;
1051     int  temp;
1052 
1053     cheader = irafheader;
1054     ctemp = (char *) &temp;
1055 
1056     if (machswap() != swaphead) {
1057 	ctemp[3] = cheader[offset];
1058 	ctemp[2] = cheader[offset+1];
1059 	ctemp[1] = cheader[offset+2];
1060 	ctemp[0] = cheader[offset+3];
1061 	}
1062     else {
1063 	ctemp[0] = cheader[offset];
1064 	ctemp[1] = cheader[offset+1];
1065 	ctemp[2] = cheader[offset+2];
1066 	ctemp[3] = cheader[offset+3];
1067 	}
1068     return (temp);
1069 }
1070 
1071 /*--------------------------------------------------------------------------*/
1072 /* IRAFGETC2 -- Get character string from arbitrary part of v.1 IRAF header */
1073 
irafgetc2(char * irafheader,int offset,int nc)1074 static char *irafgetc2 (
1075 
1076 char	*irafheader,	/* IRAF image header */
1077 int	offset,		/* Number of bytes to skip before string */
1078 int	nc)		/* Maximum number of characters in string */
1079 
1080 {
1081     char *irafstring, *string;
1082 
1083     irafstring = irafgetc (irafheader, offset, 2*(nc+1));
1084     string = iraf2str (irafstring, nc);
1085     free (irafstring);
1086 
1087     return (string);
1088 }
1089 
1090 /*--------------------------------------------------------------------------*/
1091 /* IRAFGETC -- Get character string from arbitrary part of IRAF header */
1092 
irafgetc(char * irafheader,int offset,int nc)1093 static char *irafgetc (
1094 
1095 char	*irafheader,	/* IRAF image header */
1096 int	offset,		/* Number of bytes to skip before string */
1097 int	nc)		/* Maximum number of characters in string */
1098 
1099 {
1100     char *ctemp, *cheader;
1101     int i;
1102 
1103     cheader = irafheader;
1104     ctemp = (char *) calloc (nc+1, 1);
1105     if (ctemp == NULL) {
1106 	ffpmsg("IRAFGETC Cannot allocate memory for string variable");
1107 	return (NULL);
1108 	}
1109     for (i = 0; i < nc; i++) {
1110 	ctemp[i] = cheader[offset+i];
1111 	if (ctemp[i] > 0 && ctemp[i] < 32)
1112 	    ctemp[i] = ' ';
1113 	}
1114 
1115     return (ctemp);
1116 }
1117 
1118 /*--------------------------------------------------------------------------*/
1119 /* Convert IRAF 2-byte/char string to 1-byte/char string */
1120 
iraf2str(char * irafstring,int nchar)1121 static char *iraf2str (
1122 
1123 char	*irafstring,	/* IRAF 2-byte/character string */
1124 int	nchar)		/* Number of characters in string */
1125 {
1126     char *string;
1127     int i, j;
1128 
1129     string = (char *) calloc (nchar+1, 1);
1130     if (string == NULL) {
1131 	ffpmsg("IRAF2STR Cannot allocate memory for string variable");
1132 	return (NULL);
1133 	}
1134 
1135     /* the chars are in bytes 1, 3, 5, ... if bigendian format (SUN) */
1136     /* else in bytes 0, 2, 4, ... if little endian format (Alpha)    */
1137 
1138     if (irafstring[0] != 0)
1139 	j = 0;
1140     else
1141 	j = 1;
1142 
1143     /* Convert appropriate byte of input to output character */
1144     for (i = 0; i < nchar; i++) {
1145 	string[i] = irafstring[j];
1146 	j = j + 2;
1147 	}
1148 
1149     return (string);
1150 }
1151 
1152 /*--------------------------------------------------------------------------*/
1153 /* IRAFSWAP -- Reverse bytes of any type of vector in place */
1154 
irafswap(int bitpix,char * string,int nbytes)1155 static void irafswap (
1156 
1157 int	bitpix,		/* Number of bits per pixel */
1158 			/*  16 = short, -16 = unsigned short, 32 = int */
1159 			/* -32 = float, -64 = double */
1160 char	*string,	/* Address of starting point of bytes to swap */
1161 int	nbytes)		/* Number of bytes to swap */
1162 
1163 {
1164     switch (bitpix) {
1165 
1166 	case 16:
1167 	    if (nbytes < 2) return;
1168 	    irafswap2 (string,nbytes);
1169 	    break;
1170 
1171 	case 32:
1172 	    if (nbytes < 4) return;
1173 	    irafswap4 (string,nbytes);
1174 	    break;
1175 
1176 	case -16:
1177 	    if (nbytes < 2) return;
1178 	    irafswap2 (string,nbytes);
1179 	    break;
1180 
1181 	case -32:
1182 	    if (nbytes < 4) return;
1183 	    irafswap4 (string,nbytes);
1184 	    break;
1185 
1186 	case -64:
1187 	    if (nbytes < 8) return;
1188 	    irafswap8 (string,nbytes);
1189 	    break;
1190 
1191 	}
1192     return;
1193 }
1194 
1195 /*--------------------------------------------------------------------------*/
1196 /* IRAFSWAP2 -- Swap bytes in string in place */
1197 
irafswap2(char * string,int nbytes)1198 static void irafswap2 (
1199 
1200 char *string,	/* Address of starting point of bytes to swap */
1201 int nbytes)	/* Number of bytes to swap */
1202 
1203 {
1204     char *sbyte, temp, *slast;
1205 
1206     slast = string + nbytes;
1207     sbyte = string;
1208     while (sbyte < slast) {
1209 	temp = sbyte[0];
1210 	sbyte[0] = sbyte[1];
1211 	sbyte[1] = temp;
1212 	sbyte= sbyte + 2;
1213 	}
1214     return;
1215 }
1216 
1217 /*--------------------------------------------------------------------------*/
1218 /* IRAFSWAP4 -- Reverse bytes of Integer*4 or Real*4 vector in place */
1219 
irafswap4(char * string,int nbytes)1220 static void irafswap4 (
1221 
1222 char *string,	/* Address of Integer*4 or Real*4 vector */
1223 int nbytes)	/* Number of bytes to reverse */
1224 
1225 {
1226     char *sbyte, *slast;
1227     char temp0, temp1, temp2, temp3;
1228 
1229     slast = string + nbytes;
1230     sbyte = string;
1231     while (sbyte < slast) {
1232 	temp3 = sbyte[0];
1233 	temp2 = sbyte[1];
1234 	temp1 = sbyte[2];
1235 	temp0 = sbyte[3];
1236 	sbyte[0] = temp0;
1237 	sbyte[1] = temp1;
1238 	sbyte[2] = temp2;
1239 	sbyte[3] = temp3;
1240 	sbyte = sbyte + 4;
1241 	}
1242 
1243     return;
1244 }
1245 
1246 /*--------------------------------------------------------------------------*/
1247 /* IRAFSWAP8 -- Reverse bytes of Real*8 vector in place */
1248 
irafswap8(char * string,int nbytes)1249 static void irafswap8 (
1250 
1251 char *string,	/* Address of Real*8 vector */
1252 int nbytes)	/* Number of bytes to reverse */
1253 
1254 {
1255     char *sbyte, *slast;
1256     char temp[8];
1257 
1258     slast = string + nbytes;
1259     sbyte = string;
1260     while (sbyte < slast) {
1261 	temp[7] = sbyte[0];
1262 	temp[6] = sbyte[1];
1263 	temp[5] = sbyte[2];
1264 	temp[4] = sbyte[3];
1265 	temp[3] = sbyte[4];
1266 	temp[2] = sbyte[5];
1267 	temp[1] = sbyte[6];
1268 	temp[0] = sbyte[7];
1269 	sbyte[0] = temp[0];
1270 	sbyte[1] = temp[1];
1271 	sbyte[2] = temp[2];
1272 	sbyte[3] = temp[3];
1273 	sbyte[4] = temp[4];
1274 	sbyte[5] = temp[5];
1275 	sbyte[6] = temp[6];
1276 	sbyte[7] = temp[7];
1277 	sbyte = sbyte + 8;
1278 	}
1279     return;
1280 }
1281 
1282 /*--------------------------------------------------------------------------*/
1283 static int
machswap(void)1284 machswap (void)
1285 
1286 {
1287     char *ctest;
1288     int itest;
1289 
1290     itest = 1;
1291     ctest = (char *)&itest;
1292     if (*ctest)
1293 	return (1);
1294     else
1295 	return (0);
1296 }
1297 
1298 /*--------------------------------------------------------------------------*/
1299 /*             the following routines were originally in hget.c             */
1300 /*--------------------------------------------------------------------------*/
1301 
1302 
1303 static int lhead0 = 0;
1304 
1305 /*--------------------------------------------------------------------------*/
1306 
1307 /* Extract long value for variable from FITS header string */
1308 
1309 static int
hgeti4(hstring,keyword,ival)1310 hgeti4 (hstring,keyword,ival)
1311 
1312 char *hstring;	/* character string containing FITS header information
1313 		   in the format <keyword>= <value> {/ <comment>} */
1314 char *keyword;	/* character string containing the name of the keyword
1315 		   the value of which is returned.  hget searches for a
1316 		   line beginning with this string.  if "[n]" is present,
1317 		   the n'th token in the value is returned.
1318 		   (the first 8 characters must be unique) */
1319 int *ival;
1320 {
1321 char *value;
1322 double dval;
1323 int minint;
1324 char val[30];
1325 
1326 /* Get value and comment from header string */
1327 	value = hgetc (hstring,keyword);
1328 
1329 /* Translate value from ASCII to binary */
1330 	if (value != NULL) {
1331 	    minint = -MAXINT - 1;
1332             if (strlen(value) > 29)
1333                return(0);
1334 	    strcpy (val, value);
1335 	    dval = atof (val);
1336 	    if (dval+0.001 > MAXINT)
1337 		*ival = MAXINT;
1338 	    else if (dval >= 0)
1339 		*ival = (int) (dval + 0.001);
1340 	    else if (dval-0.001 < minint)
1341 		*ival = minint;
1342 	    else
1343 		*ival = (int) (dval - 0.001);
1344 	    return (1);
1345 	    }
1346 	else {
1347 	    return (0);
1348 	    }
1349 }
1350 
1351 /*-------------------------------------------------------------------*/
1352 /* Extract string value for variable from FITS header string */
1353 
1354 static int
hgets(hstring,keyword,lstr,str)1355 hgets (hstring, keyword, lstr, str)
1356 
1357 char *hstring;	/* character string containing FITS header information
1358 		   in the format <keyword>= <value> {/ <comment>} */
1359 char *keyword;	/* character string containing the name of the keyword
1360 		   the value of which is returned.  hget searches for a
1361 		   line beginning with this string.  if "[n]" is present,
1362 		   the n'th token in the value is returned.
1363 		   (the first 8 characters must be unique) */
1364 int lstr;	/* Size of str in characters */
1365 char *str;	/* String (returned) */
1366 {
1367 	char *value;
1368 	int lval;
1369 
1370 /* Get value and comment from header string */
1371 	value = hgetc (hstring,keyword);
1372 
1373 	if (value != NULL) {
1374 	    lval = strlen (value);
1375 	    if (lval < lstr)
1376 		strcpy (str, value);
1377 	    else if (lstr > 1) {
1378 		strncpy (str, value, lstr-1);
1379                 str[lstr-1]=0;
1380             }
1381 	    else {
1382 		str[0] = value[0];
1383             }
1384 	    return (1);
1385 	    }
1386 	else
1387 	    return (0);
1388 }
1389 
1390 /*-------------------------------------------------------------------*/
1391 /* Extract character value for variable from FITS header string */
1392 
1393 static char *
hgetc(hstring,keyword0)1394 hgetc (hstring,keyword0)
1395 
1396 char *hstring;	/* character string containing FITS header information
1397 		   in the format <keyword>= <value> {/ <comment>} */
1398 char *keyword0;	/* character string containing the name of the keyword
1399 		   the value of which is returned.  hget searches for a
1400 		   line beginning with this string.  if "[n]" is present,
1401 		   the n'th token in the value is returned.
1402 		   (the first 8 characters must be unique) */
1403 {
1404 	static char cval[80];
1405 	char *value;
1406 	char cwhite[2];
1407 	char squot[2], dquot[2], lbracket[2], rbracket[2], slash[2], comma[2];
1408 	char keyword[81]; /* large for ESO hierarchical keywords */
1409 	char line[100];
1410 	char *vpos, *cpar = NULL;
1411 	char *q1, *q2 = NULL, *v1, *v2, *c1, *brack1, *brack2;
1412         char *saveptr;
1413 	int ipar, i;
1414 
1415 	squot[0] = 39;
1416 	squot[1] = 0;
1417 	dquot[0] = 34;
1418 	dquot[1] = 0;
1419 	lbracket[0] = 91;
1420 	lbracket[1] = 0;
1421 	comma[0] = 44;
1422 	comma[1] = 0;
1423 	rbracket[0] = 93;
1424 	rbracket[1] = 0;
1425 	slash[0] = 47;
1426 	slash[1] = 0;
1427 
1428 /* Find length of variable name */
1429 	strncpy (keyword,keyword0, sizeof(keyword)-1);
1430         keyword[80]=0;
1431 	brack1 = strsrch (keyword,lbracket);
1432 	if (brack1 == NULL)
1433 	    brack1 = strsrch (keyword,comma);
1434 	if (brack1 != NULL) {
1435 	    *brack1 = '\0';
1436 	    brack1++;
1437 	    }
1438 
1439 /* Search header string for variable name */
1440 	vpos = ksearch (hstring,keyword);
1441 
1442 /* Exit if not found */
1443 	if (vpos == NULL) {
1444 	    return (NULL);
1445 	    }
1446 
1447 /* Initialize line to nulls */
1448 	 for (i = 0; i < 100; i++)
1449 	    line[i] = 0;
1450 
1451 /* In standard FITS, data lasts until 80th character */
1452 
1453 /* Extract entry for this variable from the header */
1454 	strncpy (line,vpos,80);
1455 
1456 /* check for quoted value */
1457 	q1 = strsrch (line,squot);
1458 	c1 = strsrch (line,slash);
1459 	if (q1 != NULL) {
1460 	    if (c1 != NULL && q1 < c1)
1461 		q2 = strsrch (q1+1,squot);
1462 	    else if (c1 == NULL)
1463 		q2 = strsrch (q1+1,squot);
1464 	    else
1465 		q1 = NULL;
1466 	    }
1467 	else {
1468 	    q1 = strsrch (line,dquot);
1469 	    if (q1 != NULL) {
1470 		if (c1 != NULL && q1 < c1)
1471 		    q2 = strsrch (q1+1,dquot);
1472 		else if (c1 == NULL)
1473 		    q2 = strsrch (q1+1,dquot);
1474 		else
1475 		    q1 = NULL;
1476 		}
1477 	    else {
1478 		q1 = NULL;
1479 		q2 = line + 10;
1480 		}
1481 	    }
1482 
1483 /* Extract value and remove excess spaces */
1484 	if (q1 != NULL) {
1485 	    v1 = q1 + 1;
1486 	    v2 = q2;
1487 	    c1 = strsrch (q2,"/");
1488 	    }
1489 	else {
1490 	    v1 = strsrch (line,"=") + 1;
1491 	    c1 = strsrch (line,"/");
1492 	    if (c1 != NULL)
1493 		v2 = c1;
1494 	    else
1495 		v2 = line + 79;
1496 	    }
1497 
1498 /* Ignore leading spaces */
1499 	while (*v1 == ' ' && v1 < v2) {
1500 	    v1++;
1501 	    }
1502 
1503 /* Drop trailing spaces */
1504 	*v2 = '\0';
1505 	v2--;
1506 	while (*v2 == ' ' && v2 > v1) {
1507 	    *v2 = '\0';
1508 	    v2--;
1509 	    }
1510 
1511 	if (!strcmp (v1, "-0"))
1512 	    v1++;
1513 	strcpy (cval,v1);
1514 	value = cval;
1515 
1516 /* If keyword has brackets, extract appropriate token from value */
1517 	if (brack1 != NULL) {
1518 	    brack2 = strsrch (brack1,rbracket);
1519 	    if (brack2 != NULL)
1520 		*brack2 = '\0';
1521 	    ipar = atoi (brack1);
1522 	    if (ipar > 0) {
1523 		cwhite[0] = ' ';
1524 		cwhite[1] = '\0';
1525 		for (i = 1; i <= ipar; i++) {
1526 		    cpar = ffstrtok (v1,cwhite,&saveptr);
1527 		    v1 = NULL;
1528 		    }
1529 		if (cpar != NULL) {
1530 		    strcpy (cval,cpar);
1531 		    }
1532 		else
1533 		    value = NULL;
1534 		}
1535 	    }
1536 
1537 	return (value);
1538 }
1539 
1540 
1541 /*-------------------------------------------------------------------*/
1542 /* Find beginning of fillable blank line before FITS header keyword line */
1543 
1544 static char *
blsearch(hstring,keyword)1545 blsearch (hstring,keyword)
1546 
1547 /* Find entry for keyword keyword in FITS header string hstring.
1548    (the keyword may have a maximum of eight letters)
1549    NULL is returned if the keyword is not found */
1550 
1551 char *hstring;	/* character string containing fits-style header
1552 		information in the format <keyword>= <value> {/ <comment>}
1553 		the default is that each entry is 80 characters long;
1554 		however, lines may be of arbitrary length terminated by
1555 		nulls, carriage returns or linefeeds, if packed is true.  */
1556 char *keyword;	/* character string containing the name of the variable
1557 		to be returned.  ksearch searches for a line beginning
1558 		with this string.  The string may be a character
1559 		literal or a character variable terminated by a null
1560 		or '$'.  it is truncated to 8 characters. */
1561 {
1562     char *loc, *headnext, *headlast, *pval, *lc, *line;
1563     char *bval;
1564     int icol, nextchar, lkey, nleft, lhstr;
1565 
1566     pval = 0;
1567 
1568     /* Search header string for variable name */
1569     if (lhead0)
1570 	lhstr = lhead0;
1571     else {
1572 	lhstr = 0;
1573 	while (lhstr < 57600 && hstring[lhstr] != 0)
1574 	    lhstr++;
1575 	}
1576     headlast = hstring + lhstr;
1577     headnext = hstring;
1578     pval = NULL;
1579     while (headnext < headlast) {
1580 	nleft = headlast - headnext;
1581 	loc = strnsrch (headnext, keyword, nleft);
1582 
1583 	/* Exit if keyword is not found */
1584 	if (loc == NULL) {
1585 	    break;
1586 	    }
1587 
1588 	icol = (loc - hstring) % 80;
1589 	lkey = strlen (keyword);
1590 	nextchar = (int) *(loc + lkey);
1591 
1592 	/* If this is not in the first 8 characters of a line, keep searching */
1593 	if (icol > 7)
1594 	    headnext = loc + 1;
1595 
1596 	/* If parameter name in header is longer, keep searching */
1597 	else if (nextchar != 61 && nextchar > 32 && nextchar < 127)
1598 	    headnext = loc + 1;
1599 
1600 	/* If preceeding characters in line are not blanks, keep searching */
1601 	else {
1602 	    line = loc - icol;
1603 	    for (lc = line; lc < loc; lc++) {
1604 		if (*lc != ' ')
1605 		    headnext = loc + 1;
1606 		}
1607 
1608 	/* Return pointer to start of line if match */
1609 	    if (loc >= headnext) {
1610 		pval = line;
1611 		break;
1612 		}
1613 	    }
1614 	}
1615 
1616     /* Return NULL if keyword is found at start of FITS header string */
1617     if (pval == NULL)
1618 	return (pval);
1619 
1620     /* Return NULL if  found the first keyword in the header */
1621     if (pval == hstring)
1622         return (NULL);
1623 
1624     /* Find last nonblank line before requested keyword */
1625     bval = pval - 80;
1626     while (!strncmp (bval,"        ",8))
1627 	bval = bval - 80;
1628     bval = bval + 80;
1629 
1630     /* Return pointer to calling program if blank lines found */
1631     if (bval < pval)
1632 	return (bval);
1633     else
1634 	return (NULL);
1635 }
1636 
1637 
1638 /*-------------------------------------------------------------------*/
1639 /* Find FITS header line containing specified keyword */
1640 
ksearch(hstring,keyword)1641 static char *ksearch (hstring,keyword)
1642 
1643 /* Find entry for keyword keyword in FITS header string hstring.
1644    (the keyword may have a maximum of eight letters)
1645    NULL is returned if the keyword is not found */
1646 
1647 char *hstring;	/* character string containing fits-style header
1648 		information in the format <keyword>= <value> {/ <comment>}
1649 		the default is that each entry is 80 characters long;
1650 		however, lines may be of arbitrary length terminated by
1651 		nulls, carriage returns or linefeeds, if packed is true.  */
1652 char *keyword;	/* character string containing the name of the variable
1653 		to be returned.  ksearch searches for a line beginning
1654 		with this string.  The string may be a character
1655 		literal or a character variable terminated by a null
1656 		or '$'.  it is truncated to 8 characters. */
1657 {
1658     char *loc, *headnext, *headlast, *pval, *lc, *line;
1659     int icol, nextchar, lkey, nleft, lhstr;
1660 
1661     pval = 0;
1662 
1663 /* Search header string for variable name */
1664     if (lhead0)
1665 	lhstr = lhead0;
1666     else {
1667 	lhstr = 0;
1668 	while (lhstr < 57600 && hstring[lhstr] != 0)
1669 	    lhstr++;
1670 	}
1671     headlast = hstring + lhstr;
1672     headnext = hstring;
1673     pval = NULL;
1674     while (headnext < headlast) {
1675 	nleft = headlast - headnext;
1676 	loc = strnsrch (headnext, keyword, nleft);
1677 
1678 	/* Exit if keyword is not found */
1679 	if (loc == NULL) {
1680 	    break;
1681 	    }
1682 
1683 	icol = (loc - hstring) % 80;
1684 	lkey = strlen (keyword);
1685 	nextchar = (int) *(loc + lkey);
1686 
1687 	/* If this is not in the first 8 characters of a line, keep searching */
1688 	if (icol > 7)
1689 	    headnext = loc + 1;
1690 
1691 	/* If parameter name in header is longer, keep searching */
1692 	else if (nextchar != 61 && nextchar > 32 && nextchar < 127)
1693 	    headnext = loc + 1;
1694 
1695 	/* If preceeding characters in line are not blanks, keep searching */
1696 	else {
1697 	    line = loc - icol;
1698 	    for (lc = line; lc < loc; lc++) {
1699 		if (*lc != ' ')
1700 		    headnext = loc + 1;
1701 		}
1702 
1703 	/* Return pointer to start of line if match */
1704 	    if (loc >= headnext) {
1705 		pval = line;
1706 		break;
1707 		}
1708 	    }
1709 	}
1710 
1711 /* Return pointer to calling program */
1712 	return (pval);
1713 
1714 }
1715 
1716 /*-------------------------------------------------------------------*/
1717 /* Find string s2 within null-terminated string s1 */
1718 
1719 static char *
strsrch(s1,s2)1720 strsrch (s1, s2)
1721 
1722 char *s1;	/* String to search */
1723 char *s2;	/* String to look for */
1724 
1725 {
1726     int ls1;
1727     ls1 = strlen (s1);
1728     return (strnsrch (s1, s2, ls1));
1729 }
1730 
1731 /*-------------------------------------------------------------------*/
1732 /* Find string s2 within string s1 */
1733 
1734 static char *
strnsrch(s1,s2,ls1)1735 strnsrch (s1, s2, ls1)
1736 
1737 char	*s1;	/* String to search */
1738 char	*s2;	/* String to look for */
1739 int	ls1;	/* Length of string being searched */
1740 
1741 {
1742     char *s,*s1e;
1743     char cfirst,clast;
1744     int i,ls2;
1745 
1746     /* Return null string if either pointer is NULL */
1747     if (s1 == NULL || s2 == NULL)
1748 	return (NULL);
1749 
1750     /* A zero-length pattern is found in any string */
1751     ls2 = strlen (s2);
1752     if (ls2 ==0)
1753 	return (s1);
1754 
1755     /* Only a zero-length string can be found in a zero-length string */
1756     if (ls1 ==0)
1757 	return (NULL);
1758 
1759     cfirst = s2[0];
1760     clast = s2[ls2-1];
1761     s1e = s1 + ls1 - ls2 + 1;
1762     s = s1;
1763     while (s < s1e) {
1764 
1765 	/* Search for first character in pattern string */
1766 	if (*s == cfirst) {
1767 
1768 	    /* If single character search, return */
1769 	    if (ls2 == 1)
1770 		return (s);
1771 
1772 	    /* Search for last character in pattern string if first found */
1773 	    if (s[ls2-1] == clast) {
1774 
1775 		/* If two-character search, return */
1776 		if (ls2 == 2)
1777 		    return (s);
1778 
1779 		/* If 3 or more characters, check for rest of search string */
1780 		i = 1;
1781 		while (i < ls2 && s[i] == s2[i])
1782 		    i++;
1783 
1784 		/* If entire string matches, return */
1785 		if (i >= ls2)
1786 		    return (s);
1787 		}
1788 	    }
1789 	s++;
1790 	}
1791     return (NULL);
1792 }
1793 
1794 /*-------------------------------------------------------------------*/
1795 /*             the following routines were originally in hget.c      */
1796 /*-------------------------------------------------------------------*/
1797 /*  HPUTI4 - Set int keyword = ival in FITS header string */
1798 
1799 static void
hputi4(hstring,keyword,ival)1800 hputi4 (hstring,keyword,ival)
1801 
1802   char *hstring;	/* character string containing FITS-style header
1803 			   information in the format
1804 			   <keyword>= <value> {/ <comment>}
1805 			   each entry is padded with spaces to 80 characters */
1806 
1807   char *keyword;		/* character string containing the name of the variable
1808 			   to be returned.  hput searches for a line beginning
1809 			   with this string, and if there isn't one, creates one.
1810 		   	   The first 8 characters of keyword must be unique. */
1811   int ival;		/* int number */
1812 {
1813     char value[30];
1814 
1815     /* Translate value from binary to ASCII */
1816     snprintf (value,30,"%d",ival);
1817 
1818     /* Put value into header string */
1819     hputc (hstring,keyword,value);
1820 
1821     /* Return to calling program */
1822     return;
1823 }
1824 
1825 /*-------------------------------------------------------------------*/
1826 
1827 /*  HPUTL - Set keyword = F if lval=0, else T, in FITS header string */
1828 
1829 static void
hputl(hstring,keyword,lval)1830 hputl (hstring, keyword,lval)
1831 
1832 char *hstring;		/* FITS header */
1833 char *keyword;		/* Keyword name */
1834 int lval;		/* logical variable (0=false, else true) */
1835 {
1836     char value[8];
1837 
1838     /* Translate value from binary to ASCII */
1839     if (lval)
1840 	strcpy (value, "T");
1841     else
1842 	strcpy (value, "F");
1843 
1844     /* Put value into header string */
1845     hputc (hstring,keyword,value);
1846 
1847     /* Return to calling program */
1848     return;
1849 }
1850 
1851 /*-------------------------------------------------------------------*/
1852 
1853 /*  HPUTS - Set character string keyword = 'cval' in FITS header string */
1854 
1855 static void
hputs(hstring,keyword,cval)1856 hputs (hstring,keyword,cval)
1857 
1858 char *hstring;	/* FITS header */
1859 char *keyword;	/* Keyword name */
1860 char *cval;	/* character string containing the value for variable
1861 		   keyword.  trailing and leading blanks are removed.  */
1862 {
1863     char squot = 39;
1864     char value[70];
1865     int lcval;
1866 
1867     /*  find length of variable string */
1868 
1869     lcval = strlen (cval);
1870     if (lcval > 67)
1871 	lcval = 67;
1872 
1873     /* Put quotes around string */
1874     value[0] = squot;
1875     strncpy (&value[1],cval,lcval);
1876     value[lcval+1] = squot;
1877     value[lcval+2] = 0;
1878 
1879     /* Put value into header string */
1880     hputc (hstring,keyword,value);
1881 
1882     /* Return to calling program */
1883     return;
1884 }
1885 
1886 /*---------------------------------------------------------------------*/
1887 /*  HPUTC - Set character string keyword = value in FITS header string */
1888 
1889 static void
hputc(hstring,keyword,value)1890 hputc (hstring,keyword,value)
1891 
1892 char *hstring;
1893 char *keyword;
1894 char *value;	/* character string containing the value for variable
1895 		   keyword.  trailing and leading blanks are removed.  */
1896 {
1897     char squot = 39;
1898     char line[100];
1899     char newcom[50];
1900     char blank[80];
1901     char *v, *vp, *v1, *v2, *q1, *q2, *c1, *ve;
1902     int lkeyword, lcom, lval, lc, i;
1903 
1904     for (i = 0; i < 80; i++)
1905 	blank[i] = ' ';
1906 
1907     /*  find length of keyword and value */
1908     lkeyword = strlen (keyword);
1909     lval = strlen (value);
1910 
1911     /*  If COMMENT or HISTORY, always add it just before the END */
1912     if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 ||
1913 	strncmp (keyword,"HISTORY",7) == 0)) {
1914 
1915 	/* Find end of header */
1916 	v1 = ksearch (hstring,"END");
1917 	v2 = v1 + 80;
1918 
1919 	/* Move END down one line */
1920 	strncpy (v2, v1, 80);
1921 
1922 	/* Insert keyword */
1923 	strncpy (v1,keyword,7);
1924 
1925 	/* Pad with spaces */
1926 	for (vp = v1+lkeyword; vp < v2; vp++)
1927 	    *vp = ' ';
1928 
1929 	/* Insert comment */
1930 	strncpy (v1+9,value,lval);
1931 	return;
1932 	}
1933 
1934     /* Otherwise search for keyword */
1935     else
1936 	v1 = ksearch (hstring,keyword);
1937 
1938     /*  If parameter is not found, find a place to put it */
1939     if (v1 == NULL) {
1940 
1941 	/* First look for blank lines before END */
1942         v1 = blsearch (hstring, "END");
1943 
1944 	/*  Otherwise, create a space for it at the end of the header */
1945 	if (v1 == NULL) {
1946 	    ve = ksearch (hstring,"END");
1947 	    v1 = ve;
1948 	    v2 = v1 + 80;
1949 	    strncpy (v2, ve, 80);
1950 	    }
1951 	else
1952 	    v2 = v1 + 80;
1953 	lcom = 0;
1954 	newcom[0] = 0;
1955 	}
1956 
1957     /*  Otherwise, extract the entry for this keyword from the header */
1958     else {
1959 	strncpy (line, v1, 80);
1960 	line[80] = 0;
1961 	v2 = v1 + 80;
1962 
1963 	/*  check for quoted value */
1964 	q1 = strchr (line, squot);
1965 	if (q1 != NULL)
1966 	    q2 = strchr (q1+1,squot);
1967 	else
1968 	    q2 = line;
1969 
1970 	/*  extract comment and remove trailing spaces */
1971 
1972 	c1 = strchr (q2,'/');
1973 	if (c1 != NULL) {
1974 	    lcom = 80 - (c1 - line);
1975 	    strncpy (newcom, c1+1, lcom);
1976 	    vp = newcom + lcom - 1;
1977 	    while (vp-- > newcom && *vp == ' ')
1978 		*vp = 0;
1979 	    lcom = strlen (newcom);
1980 	    }
1981 	else {
1982 	    newcom[0] = 0;
1983 	    lcom = 0;
1984 	    }
1985 	}
1986 
1987     /* Fill new entry with spaces */
1988     for (vp = v1; vp < v2; vp++)
1989 	*vp = ' ';
1990 
1991     /*  Copy keyword to new entry */
1992     strncpy (v1, keyword, lkeyword);
1993 
1994     /*  Add parameter value in the appropriate place */
1995     vp = v1 + 8;
1996     *vp = '=';
1997     vp = v1 + 9;
1998     *vp = ' ';
1999     vp = vp + 1;
2000     if (*value == squot) {
2001 	strncpy (vp, value, lval);
2002 	if (lval+12 > 31)
2003 	    lc = lval + 12;
2004 	else
2005 	    lc = 30;
2006 	}
2007     else {
2008 	vp = v1 + 30 - lval;
2009 	strncpy (vp, value, lval);
2010 	lc = 30;
2011 	}
2012 
2013     /* Add comment in the appropriate place */
2014 	if (lcom > 0) {
2015 	    if (lc+2+lcom > 80)
2016 		lcom = 78 - lc;
2017 	    vp = v1 + lc + 2;     /* Jul 16 1997: was vp = v1 + lc * 2 */
2018 	    *vp = '/';
2019 	    vp = vp + 1;
2020 	    strncpy (vp, newcom, lcom);
2021 	    for (v = vp + lcom; v < v2; v++)
2022 		*v = ' ';
2023 	    }
2024 
2025 	return;
2026 }
2027 
2028 /*-------------------------------------------------------------------*/
2029 /*  HPUTCOM - Set comment for keyword or on line in FITS header string */
2030 
2031 static void
hputcom(hstring,keyword,comment)2032 hputcom (hstring,keyword,comment)
2033 
2034   char *hstring;
2035   char *keyword;
2036   char *comment;
2037 {
2038 	char squot;
2039 	char line[100];
2040 	int lkeyword, lcom;
2041 	char *vp, *v1, *v2, *c0 = NULL, *c1, *q1, *q2;
2042 
2043 	squot = 39;
2044 
2045 /*  Find length of variable name */
2046 	lkeyword = strlen (keyword);
2047 
2048 /*  If COMMENT or HISTORY, always add it just before the END */
2049 	if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 ||
2050 	    strncmp (keyword,"HISTORY",7) == 0)) {
2051 
2052 	/* Find end of header */
2053 	    v1 = ksearch (hstring,"END");
2054 	    v2 = v1 + 80;
2055 	    strncpy (v2, v1, 80);
2056 
2057 	/*  blank out new line and insert keyword */
2058 	    for (vp = v1; vp < v2; vp++)
2059 		*vp = ' ';
2060 	    strncpy (v1, keyword, lkeyword);
2061 	    }
2062 
2063 /* search header string for variable name */
2064 	else {
2065 	    v1 = ksearch (hstring,keyword);
2066 	    v2 = v1 + 80;
2067 
2068 	/* if parameter is not found, return without doing anything */
2069 	    if (v1 == NULL) {
2070 		return;
2071 		}
2072 
2073 	/* otherwise, extract entry for this variable from the header */
2074 	    strncpy (line, v1, 80);
2075 
2076 	/* check for quoted value */
2077 	    q1 = strchr (line,squot);
2078 	    if (q1 != NULL)
2079 		q2 = strchr (q1+1,squot);
2080 	    else
2081 		q2 = NULL;
2082 
2083 	    if (q2 == NULL || q2-line < 31)
2084 		c0 = v1 + 31;
2085 	    else
2086 		c0 = v1 + (q2-line) + 2; /* allan: 1997-09-30, was c0=q2+2 */
2087 
2088 	    strncpy (c0, "/ ",2);
2089 	    }
2090 
2091 /* create new entry */
2092 	lcom = strlen (comment);
2093 
2094 	if (lcom > 0) {
2095 	    c1 = c0 + 2;
2096 	    if (c1+lcom > v2)
2097 		lcom = v2 - c1;
2098 	    strncpy (c1, comment, lcom);
2099 	    }
2100 
2101 }
2102