# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. include include include include include include include include include "fxf.h" # FXF_OPEN -- Open/create a FITS format image with extensions. procedure fxf_open (kernel, im, o_im, root, extn, ksection, group, gc_arg, acmode, status) int kernel #I IKI kernel pointer im #I image descriptor pointer o_im #I other descriptor for NEW_COPY image char root[ARB] #I root image name char extn[ARB] #I extension, if any char ksection[ARB] #I [extname,extver,overwrite,append,inherit..] int group #I index of group to be accessed int gc_arg #I [NOT USED] int acmode #I access mode int status #O status flag to calling routine long fi[LEN_FINFO] int newimage, i, gn, ksinh, type, fmode pointer sp, path, fit_extn, ua, o_fit, fit bool pre_read, fks_extn_or_ver, dyh, fsec, plio int fxf_check_dup_extnv(), itoc(), strcmp(), strncmp() int open(), access(), imgeti(), fstatl(), finfo(), fxf_header_size() pointer pl_open() errchk fmkcopy, calloc, open, fxf_rheader, fxf_prhdr, fxf_gaccess errchk fxf_fclobber, fxf_ksection, fxf_alloc, syserr, syserrs errchk fxf_check_group define duperr_ 91 define err_ 92 begin call smark (sp) call salloc (path, SZ_PATHNAME, TY_CHAR) call salloc (fit_extn, FITS_LENEXTN, TY_CHAR) call fxf_init() ua = IM_USERAREA(im) fmode = acmode # Allocate internal FITS image descriptor. call fxf_alloc (fit) IM_KDES(im) = fit IM_HFD(im) = NULL FIT_IM(fit) = im call amovki (1, FIT_LENAXIS(fit,1), IM_MAXDIM) # Generate full header file name. if (extn[1] == EOS) { call fxf_gethdrextn (im, o_im, fmode, Memc[fit_extn], FITS_LENEXTN) call iki_mkfname (root, Memc[fit_extn], Memc[path], SZ_PATHNAME) call strcpy (Memc[fit_extn], extn, FITS_LENEXTN) } else call iki_mkfname (root, extn, Memc[path], SZ_PATHNAME) # Header and pixel filename are the same. call strcpy (Memc[path], IM_HDRFILE(im), SZ_IMHDRFILE) call strcpy (IM_HDRFILE(im), IM_PIXFILE(im), SZ_IMPIXFILE) newimage = NO if (access (IM_HDRFILE(im), 0, 0) == NO) newimage = YES FIT_NEWIMAGE(fit) = newimage # Initialize kernel section default values. call fxf_ksinit (fit) # For simplicity treat the APPEND mode as NEW_IMAGE. For the FK # is the same. if (fmode == APPEND) fmode = NEW_IMAGE FIT_ACMODE(fit) = fmode # Read fkinit and ksection and check that the extension number # specifications therein and the IMIO cluster index "group" are # consistent. call fxf_check_group (im, ksection, fmode, group, ksinh) fks_extn_or_ver = FKS_EXTNAME(fit) != EOS || !IS_INDEFL(FKS_EXTVER(fit)) # Check if a file section is necessary. fsec = (fks_extn_or_ver || group >= 0) call fxf_gaccess (im, fsec) # The previous call could have changed FIT_NEWIMAGE; reset value. newimage = FIT_NEWIMAGE(fit) if (fks_extn_or_ver) FIT_GROUP(fit) = -1 # See if we want to write a dummy primary unit. # # For PLIO, if creating a new output file and we want to create a # BINTABLE, create a dummy header. Otherwise see if a type is # requested, in which case we would need to create a dummmy header # if no file is present yet. type = 0 if (FKS_SUBTYPE(fit) == FK_PLIO) type = FK_PLIO dyh = false if (newimage == YES && (fks_extn_or_ver || type > 0)) { call fxf_dummy_header (im, status) if (status == ERR) goto err_ newimage = NO dyh = true if (fmode == NEW_COPY && type == FK_PLIO) FIT_PIXOFF(fit) = fxf_header_size(im) + FITS_BLOCK_CHARS } if (newimage == NO) { if (finfo (IM_HDRFILE(im), fi) != ERR) FIT_EOFSIZE(fit) = (FI_SIZE(fi)+SZB_CHAR-1)/SZB_CHAR + 1 else call syserrs (SYS_FOPEN, IM_HDRFILE(im)) } if (newimage == YES) FKS_OVERWRITE(fit) = NO else FIT_XTENSION(fit) = YES FIT_NEWIMAGE(fit) = newimage # If all these conditions are met then set the pre_read flag. pre_read = (fks_extn_or_ver || FKS_OVERWRITE(fit) == YES || FKS_INHERIT(fit) == YES) if (newimage == NO && fmode != READ_ONLY) { # See that INHERIT makes sense if it has been set by # 'fkinit' when reading a file with PHU (naxis != 0). if (FKS_INHERIT(fit) == YES && group != 0) { gn = 0 iferr (call fxf_prhdr (im, gn)) { FKS_INHERIT(fit) = NO # Issue an error only if the inherit is in the filename. if (fmode == NEW_COPY && ksinh == YES) call syserr (SYS_FXFBADINH) } else if (FIT_NAXIS(fit) != 0) FKS_INHERIT(fit) = NO # Reset the pre_read flag. pre_read = ((FKS_DUPNAME(fit) == NO && FKS_INHERIT(fit) == YES) || FKS_OVERWRITE(fit) == YES) } if (pre_read && fmode != NEW_COPY && !dyh) call fxf_prhdr (im, group) if (access (IM_HDRFILE(im), fmode, 0) == NO) call syserrs (SYS_FNOWRITEPERM, IM_HDRFILE(im)) } switch (fmode) { case NEW_IMAGE, APPEND: if (newimage == NO) { # Make sure the UA is empty when overwriting. if (pre_read && FKS_OVERWRITE(fit) == YES) Memc[ua] = EOS if (FKS_DUPNAME(fit) == NO) if (fxf_check_dup_extnv (im, group) == YES) goto duperr_ } else { # See if it is necessary to invalidate the cache entry for the # current filename. It could happen that the user has deleted # the filename and a new file with the same is created. call fxf_check_old_name (im) } if (FKS_INHERIT(fit) == YES) FIT_INHERIT(fit) = YES # Initialize a new copy of a PLIO image mask. if (type == FK_PLIO) IM_PL(im) = pl_open (NULL) case NEW_COPY: # Completely new copy of an existing image. This could mean a # new file or append a new image to an existing file. # Initialize a new copy of a PLIO image mask. if (type == FK_PLIO) { IM_PL(im) = pl_open (NULL) if (IM_PL(o_im) != NULL) call fxf_plpf (im) } if (newimage == YES || FKS_APPEND(fit) == NO) call fxf_check_old_name (im) # For a PLIO mask, make sure there are no SUBYTPE keywords in # the UA since this will be rewritten by fxf_updhdr(). if (IM_PL(o_im) != NULL) call fxf_clean_pl (im) if (IM_KDES(o_im) != NULL && IM_KERNEL(o_im) == IM_KERNEL(im)) { o_fit = IM_KDES(o_im) call strcpy (FIT_EXTTYPE(o_fit), FIT_EXTTYPE(fit), SZ_EXTTYPE) call strcpy (FIT_EXTNAME(o_fit), FIT_EXTNAME(fit), LEN_CARD) FIT_EXTVER(fit) = FIT_EXTVER(o_fit) # Reset the value of the keyword INHERIT in the new_copy # image if the input has a no_inherit in the filename. FIT_INHERIT(fit) = NO call fxf_filter_keyw (im, "INHERIT") # Change the value only if explicitly done in the output # kernel section. if (FKS_INHERIT(fit) == YES) FIT_INHERIT(fit) = YES } else { # Reblock if old image is imh for example. if (IM_UABLOCKED(im) != YES) call fxf_reblock (im) # See if the old image have EXTNAME or EXTVER keywords. # Notice that old image does not have to be of FITS type. iferr (call imgstr (o_im,"EXTNAME",FIT_EXTNAME(fit),LEN_CARD)) FIT_EXTNAME(fit) = EOS iferr (FIT_EXTVER(fit) = imgeti (o_im, "EXTVER")) FIT_EXTVER(fit) = INDEFL call strcpy ("IMAGE", FIT_EXTTYPE(fit), SZ_EXTTYPE) } # Delete ORIGIN keyword, since we are going to put a new one. call fxf_filter_keyw (im, "ORIGIN") # Now that we have a new_copy of the input FITS structure, # initialize some of its members. FIT_HFD(fit) = NULL FIT_NEWIMAGE(fit) = newimage if (newimage == NO) FIT_XTENSION(fit) = YES FIT_ACMODE(fit) = fmode if (FKS_APPEND(fit) != YES) FIT_GROUP(fit) = group FIT_BSCALE(fit) = 1.0d0 FIT_BZERO(fit) = 0.0d0 if (FKS_OVERWRITE(fit) == NO) { if (FKS_EXTNAME(fit) == EOS) call strcpy (FIT_EXTNAME(fit), FKS_EXTNAME(fit), LEN_CARD) else call imastr (im, "EXTNAME", FKS_EXTNAME(fit)) if (IS_INDEFL(FKS_EXTVER(fit))) FKS_EXTVER(fit) = FIT_EXTVER(fit) else call imaddi (im, "EXTVER", FKS_EXTVER(fit)) # We need to pre_read extensions headers to check for # duplicates with these extname and extver. if (FKS_EXTNAME(fit) != EOS ||!IS_INDEFL(FKS_EXTVER(fit))) pre_read = true } if (newimage == NO && !dyh) { if (pre_read) { iferr (call fxf_prhdr (im, group)) ; } # Check for duplicated EXTNAME and/or EXTVER if any of the # following conditions are met. if (FKS_DUPNAME(fit) == NO && FKS_OVERWRITE(fit) == NO && (fks_extn_or_ver || FIT_EXTNAME(fit) != EOS || !IS_INDEFL(FIT_EXTVER(fit)))) { if (fxf_check_dup_extnv (im, group) == YES) goto duperr_ } } FIT_NAXIS(fit) = IM_NDIM(im) do i = 1, IM_NDIM(im) FIT_LENAXIS(fit,i) = IM_LEN(im,i) # Inherit datatype of input template image if specified, # otherwise default datatype to real. if (IM_PIXTYPE(o_im) != NULL) IM_PIXTYPE(im) = IM_PIXTYPE(o_im) else IM_PIXTYPE(im) = TY_REAL default: # No Overwrite allowed in READ_ONLY or READ_WRITE. FKS_OVERWRITE(fit) = NO # Check that we have single FITS file. if (!fsec && group == -1) group = 0 # Open an existing image. iferr (call fpathname (IM_HDRFILE(im), Memc[path], SZ_PATHNAME)) goto err_ if (fmode == READ_WRITE) IM_HFD(im) = open (Memc[path], READ_WRITE, BINARY_FILE) else IM_HFD(im) = open (Memc[path], READ_ONLY, BINARY_FILE) iferr (call fxf_rheader (im, group, fmode)) { call close (IM_HFD(im)) call mfree (fit, TY_STRUCT) call sfree (sp) status = ERR call erract (EA_ERROR) } if (group == 0) FIT_XTENSION(fit) = NO else FIT_XTENSION(fit) = YES # Some non-iraf fits files might have keywords that are # imcompatible with our header. For example if hediting the header, # make sure that they are eliminated. if (fmode == READ_WRITE) call fxf_discard_keyw (im) FIT_EOFSIZE(fit) = fstatl (IM_HFD(im), F_FILESIZE) + 1 # PLIO. If we read the header of a PLIO_1 compressed image file # then it is a PL file; now read the data. plio = (strncmp (FIT_EXTSTYPE(fit), "PLIO_1", 6) == 0) if (plio) { call fxf_plread (im) # We need to setup the IMIO descriptor if we need to write # over a section; in particular IM_PFD needs to be defined. if (fmode == READ_WRITE) call fxf_plpf (im) } # Close the header file. call close (IM_HFD(im)) IM_HFD(im) = NULL # Do not allow the user to see any non_IMAGE extensions. if (strcmp ("IMAGE", FIT_EXTTYPE(fit)) != 0 && strcmp ("SIMPLE", FIT_EXTTYPE(fit)) != 0 && !plio) call syserrs (SYS_IKIEXTN, IM_NAME(im)) } FIT_HFD(fit) = IM_HFD(im) status = OK call sfree (sp) return duperr_ i = itoc (group, Memc[path], LEN_CARD) call syserrs (SYS_FXFOPEXTNV, Memc[path]) err_ status = ERR call mfree (fit, TY_STRUCT) call sfree (sp) end # FXF_ALLOC -- Initialize memory for the FIT descriptor. procedure fxf_alloc (fit) pointer fit #I input fits descriptor errchk calloc begin call calloc (fit, LEN_FITDES, TY_STRUCT) FIT_GROUP(fit) = -1 FIT_PIXTYPE(fit) = NULL FIT_BSCALE(fit) = 1.0d0 FIT_BZERO(fit) = 0.0d0 FIT_XTENSION(fit) = NO FIT_INHERIT(fit) = NO FIT_EOFSIZE(fit) = 0 FIT_EXTNAME(fit) = EOS FIT_EXTVER(fit) = INDEFL end # FXF_INIT -- Initialize any runtime FITS kernel descriptors to their # process startup state. procedure fxf_init() int i bool first_time data first_time /true/ include "fxfcache.com" begin # Disable the hdrcache until it is fully initialized in rfitshdr. if (first_time) { rf_cachesize = 0 do i = 1, MAX_CACHE { rf_fit[i] = 0 } first_time = false } end # FXF_KS_RDHDR -- Procedure to preread the FITS headers up to group # 'group'. The idea is to have the offset pointers in memory since the # can be overwritten or when no group (i.e. -1) is given and the extname or # extver are specified. procedure fxf_prhdr (im, group) pointer im #I image descriptor int group #I maximum group number to read int poff, extv pointer fit, lim, lfit, sp, path errchk fpathname, open, syserr, fxf_alloc, calloc int open(), imgeti() begin call smark (sp) call salloc (path, SZ_PATHNAME, TY_CHAR) # We will use a local temporary imio and fit structures. # call calloc (lim, LEN_IMDES+LEN_IMHDR+MIN_LENUSERAREA, TY_STRUCT) call calloc (lim, LEN_IMDES+IM_LENHDRMEM(im), TY_STRUCT) call fxf_alloc (lfit) IM_KDES(lim) = lfit fit = IM_KDES(im) FIT_GROUP(lfit) = group FIT_ACMODE(lfit) = FIT_ACMODE(fit) call strcpy (FKS_EXTNAME(fit), FKS_EXTNAME(lfit), LEN_CARD) FKS_EXTVER(lfit) = FKS_EXTVER(fit) iferr (extv = imgeti (im, "EXTVER")) extv = INDEFL FKS_OVERWRITE(lfit) = FKS_OVERWRITE(fit) FKS_DUPNAME(lfit) = FKS_DUPNAME(fit) FKS_INHERIT(lfit) = FKS_INHERIT(fit) FKS_CACHESIZE(lfit) = FKS_CACHESIZE(fit) # Open an existing image. call strcpy (IM_HDRFILE(im), IM_HDRFILE(lim), SZ_PATHNAME) call strcpy (IM_NAME(im), IM_NAME(lim), SZ_PATHNAME) call fpathname (IM_HDRFILE(im), Memc[path], SZ_PATHNAME) IM_HFD(lim) = open (Memc[path], READ_ONLY, BINARY_FILE) IM_LENHDRMEM(lim) = IM_LENHDRMEM(im) # If we want to inherit the global header we need to read # the group specified in the filename. iferr (call fxf_rfitshdr (lim, group, poff)) { call close (IM_HFD(lim)) call mfree (lfit, TY_STRUCT) call mfree (lim, TY_STRUCT) call sfree (sp) call erract (EA_ERROR) } else { call close (IM_HFD(lim)) call sfree (sp) if (FKS_OVERWRITE(fit) == YES) FIT_GROUP(fit) = FIT_GROUP(lfit) group = FIT_GROUP(lfit) # Now set the offset pointers to the original 'fit' struct. FIT_HDRPTR(fit) = FIT_HDRPTR(lfit) FIT_PIXPTR(fit) = FIT_PIXPTR(lfit) FIT_EXTEND(fit) = FIT_EXTEND(lfit) FIT_CACHEHDR(fit) = FIT_CACHEHDR(lfit) FIT_CACHEHLEN(fit) = FIT_CACHEHLEN(lfit) FIT_NAXIS(fit) = FIT_NAXIS(lfit) FIT_INHERIT(fit) = FIT_INHERIT(lfit) FIT_PLMAXLEN(fit) = FIT_PLMAXLEN(lfit) IM_CTIME(im) = IM_CTIME(lim) call mfree (lfit, TY_STRUCT) call mfree (lim, TY_STRUCT) if (extv != INDEFL) call imaddi (im, "EXTVER", extv) } end # FXF_DUMMY_HEADER -- Built a minimum Primary Fits header. This is # necessary in case we are creating an IMAGE extension and we don't # want to put any information in the PHU. procedure fxf_dummy_header (im, status) pointer im #I image descriptor int status #O status flag char blank[1] pointer sp, path, spp, mii, pn, n int iso_cutover, fd, nblanks, size_rec int strlen(), open(), envgeti() long clktime() begin call smark (sp) call salloc (spp, FITS_BLOCK_BYTES, TY_CHAR) call salloc (mii, FITS_BLOCK_CHARS, TY_INT) call salloc (path, SZ_PATHNAME, TY_CHAR) status = OK iferr { call fpathname (IM_HDRFILE(IM), Memc[path], SZ_PATHNAME) fd = open (Memc[path], NEW_FILE, BINARY_FILE) } then { call sfree (sp) status = ERR return } pn = spp call fxf_akwb ("SIMPLE", YES, "FITS STANDARD", pn) call fxf_akwi ("BITPIX", 8, "Character information", pn) call fxf_akwi ("NAXIS", 0, "No image data array present", pn) call fxf_akwb ("EXTEND", YES, "File may contain extensions", pn) call fxf_akwc ("ORIGIN", FITS_ORIGIN, strlen(FITS_ORIGIN), "FITS file originator", pn) # Dates after iso_cutover use ISO format dates. iferr (iso_cutover = envgeti (ENV_ISOCUTOVER)) iso_cutover = DEF_ISOCUTOVER # Encode the DATE keyword. call fxf_encode_date (clktime(long(0)), Memc[path], LEN_CARD, "ISO", 2000) call fxf_akwc ("DATE", Memc[path], strlen(Memc[path]), "Date FITS file was generated", pn) blank[1] = ' ' call amovkc (blank[1], Memc[pn], LEN_CARD) call amovc ("END", Memc[pn], 3) pn = pn + LEN_CARD n = pn - spp size_rec = FITS_BLOCK_CHARS nblanks = FITS_BLOCK_BYTES - n call amovkc (blank[1], Memc[spp+n], nblanks) call miipak (Memc[spp], Memi[mii], size_rec*2, TY_CHAR, MII_BYTE) call write (fd, Memi[mii], size_rec) call close (fd) call sfree (sp) end # FXF_CHECK_DUP_EXTN_VER --- Function to check for a duplicate EXTNAME or # EXTVER in the FITS file open with NEW_COPY mode. The filename specification # does not have EXTNAME nor EXTVER in the ksection. # Returns YES if there are duplicates. int procedure fxf_check_dup_extnv (im, group) pointer im #I image descriptor int group #O extension number where there is a duplicate int cindx pointer extn, extv, sp, hdrfile, fit, poff int fxf_extnv_error() bool streq() include "fxfcache.com" begin call smark (sp) call salloc (hdrfile, SZ_PATHNAME, TY_CHAR) call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME) fit = IM_KDES(im) do cindx=1, rf_cachesize { if (rf_fit[cindx] == NULL) next if (streq (Memc[hdrfile], rf_fname[1,cindx])) { extn = rf_pextn[cindx] extv = rf_pextv[cindx] poff = rf_pixp[cindx] # pixel offset -1 if EOF group = 1 # Now compare the input image FIT_EXT(NAME,VER) with # the cache values of the NEW_COPY images. while (Memc[extn+LEN_CARD*group] != EOS || !IS_INDEFL(Memi[extv+group]) || Memi[poff+group] != -1) { if (fxf_extnv_error (fit, group, extn, extv) == YES) { call sfree (sp) if (FKS_OVERWRITE(fit) == YES) return (NO) else return (YES) } else group = group + 1 } } } call sfree (sp) return (NO) end # FXF_CHECK_OLD_NAME -- Check is the filename is already in cache for a # NEWIMAGE == YES mode; if so, make the entry obsolete. procedure fxf_check_old_name (im) pointer im #I image descriptor int cindx pointer sp, hdrfile, fit bool streq() include "fxfcache.com" begin call smark (sp) call salloc (hdrfile, SZ_PATHNAME, TY_CHAR) call fpathname (IM_HDRFILE(im), Memc[hdrfile], SZ_PATHNAME) fit = IM_KDES(im) do cindx=1, rf_cachesize { if (rf_fit[cindx] == NULL) next # Verify that we have the correct file. if (streq (Memc[hdrfile], rf_fname[1,cindx])) { call mfree (rf_pextv[cindx], TY_INT) call mfree (rf_pextn[cindx], TY_CHAR) call mfree (rf_pixp[cindx], TY_INT) call mfree (rf_hdrp[cindx], TY_INT) call mfree (rf_fit[cindx], TY_STRUCT) call mfree (rf_hdr[cindx], TY_CHAR) rf_fit[cindx] = NULL rf_mtime[cindx] = 0 # invalidate cache entry rf_fname[1,cindx] = EOS break } } call sfree (sp) end # FXF_REBLOCK -- If the user area is not blocked to fixed length records, e.g., # as is possible in a new copy image, reblock it fixed length. procedure fxf_reblock (im) pointer im #I image descriptor pointer sp, lbuf, op, ua int fd, spool, nlines, nchars, sz_userarea, len_hdrmem errchk stropen, open, getline, putline, realloc, seek, fcopyo int open(), stropen(), getline() begin call smark (sp) call salloc (lbuf, SZ_LINE, TY_CHAR) ua = IM_USERAREA(im) fd = stropen (Memc[ua], ARB, READ_ONLY) spool = open ("rb_spool", READ_WRITE, SPOOL_FILE) # Reblock into a spool file, counting the lines. for (nlines=0; ; nlines=nlines+1) { nchars = getline (fd, Memc[lbuf]) if (nchars <= 0) break for (op=nchars; op <= LEN_CARD; op=op+1) Memc[lbuf+op-1] = ' ' Memc[lbuf+LEN_CARD] = '\n' Memc[lbuf+LEN_CARD+1] = EOS call putline (spool, Memc[lbuf]) } call close (fd) # Reallocate header the right size. sz_userarea = nlines * (LEN_CARD+1) + SZ_EXTRASPACE IM_HDRLEN(im) = LEN_IMHDR + (sz_userarea - SZ_EXTRASPACE + SZ_MII_INT-1) / SZ_MII_INT len_hdrmem = LEN_IMHDR + (sz_userarea+1 + SZ_MII_INT-1) / SZ_MII_INT if (IM_LENHDRMEM(im) < len_hdrmem) { IM_LENHDRMEM(im) = len_hdrmem call realloc (im, IM_LENHDRMEM(im) + LEN_IMDES, TY_STRUCT) } # Move spooled data back to user area. ua = IM_USERAREA(im) fd = stropen (Memc[ua], sz_userarea, NEW_FILE) call seek (spool, BOFL) call fcopyo (spool, fd) IM_UABLOCKED(im) = YES call close (fd) call close (spool) call sfree (sp) end # FXF_FCLOBBER -- Clobber an existing FITS file. We use the environment # variable 'clobber' rather than 'imclobber' because is a file and not # an image. procedure fxf_fclobber (file) char file #I input filename to delete int cindx bool streq() include "fxfcache.com" begin iferr (call delete (file)) call filerr (file, SYS_FCANTCLOB) # Remove the name from the cache. do cindx=1, rf_cachesize { if (rf_fit[cindx] == NULL) next # Verify that we have the correct file. if (streq (file, rf_fname[1,cindx])) { if (rf_fit[cindx] != NULL) { call mfree (rf_pextv[cindx], TY_INT) call mfree (rf_pextn[cindx], TY_CHAR) call mfree (rf_pixp[cindx], TY_INT) call mfree (rf_hdrp[cindx], TY_INT) call mfree (rf_fit[cindx], TY_STRUCT) call mfree (rf_hdr[cindx], TY_CHAR) rf_fit[cindx] = NULL } } } end # FXF_ACCESS -- Check if a file section is necessary to access any # particular extension. procedure fxf_gaccess (im, fsec) pointer im #I image descriptor bool fsec #I true if extname,extver or group have values bool mef int acmode, fit, newimage, group bool envgetb(), fnullfile() errchk syserr, syserrs, fxf_fclobber begin fit = IM_KDES(im) acmode = FIT_ACMODE(fit) newimage = FIT_NEWIMAGE(fit) if (acmode == READ_ONLY || acmode == READ_WRITE) { # If no file section then see if it is a MEF by prereading an # extension. if (!fsec) { group = 1 mef = false ifnoerr (call fxf_prhdr (im, group)) mef = true else { # Flag error if the group does not exist and overwrite+. if (FKS_OVERWRITE(fit) == YES) call syserrs (SYS_FXFEXTNF, IM_NAME(im)) } # Multi-extension file but no extension was specified. if (mef) call syserrs (SYS_FXFOPNOEXTNV, IM_NAME(im)) FIT_GROUP(fit) = 0 FIT_XTENSION(fit) = NO } } switch (acmode) { case NEW_COPY, NEW_IMAGE, APPEND: if (envgetb ("imclobber")) { if (newimage == NO) { if (FKS_APPEND(fit) != YES && FKS_OVERWRITE(fit) != YES) { # Clobber the file. call fxf_fclobber (IM_HDRFILE(im)) FIT_NEWIMAGE(fit) = YES } } } else { if (newimage == NO) if (FKS_APPEND(fit) != YES && FKS_OVERWRITE(fit) != YES) { if (!fnullfile (IM_HDRFILE(im))) call syserrs (SYS_IKICLOB, IM_HDRFILE(im)) } } default: ; } end # FXF_CHECK_GROUP -- Check for group specification from fkinit, ksection # and cluster index are equal when specifified and they are also compatible # when (extname,extver) is in the kernel sections. procedure fxf_check_group (im, ksection, acmode, group, ksinh) pointer im #I imio descriptor char ksection[ARB] #I kernel section int acmode #I fits unit extension mode int group #U extension number in the image section int ksinh #O INHERIT value from the filename ksection pointer sp, ks, fit bool fks_extn_or_ver, inherit_override int igroup, kgroup, fgroup, tgroup, sv_inherit, newimage, append bool fnullfile() int envgets() errchk syserrs, fxf_ks_error begin call smark (sp) call salloc (ks, SZ_LINE, TY_CHAR) fit = IM_KDES(im) newimage = FIT_NEWIMAGE(fit) # Set the FKINIT defaults; these override the builtin defaults. fgroup = -1 igroup = -1 FKS_APPEND(fit) = NO_KEYW if (envgets (ENV_FKINIT, Memc[ks], SZ_LINE) != 0) call fxf_ksection (Memc[ks], fit, igroup) append = FKS_APPEND(fit) sv_inherit = FKS_INHERIT(fit) FKS_INHERIT(fit) = NO_KEYW FKS_APPEND(fit) = NO_KEYW # Parse the kernel section. call fxf_ksection (ksection, fit, kgroup) ksinh = FKS_INHERIT(fit) # Check for various error conditions. if (FKS_OVERWRITE(fit) == YES && FKS_APPEND(fit) == YES) call syserrs (SYS_FXFKSNOVR, "append") if (append == NO_KEYW && FKS_APPEND(fit) == NO_KEYW) FKS_APPEND(fit) = NO else if (append != NO_KEYW) FKS_APPEND(fit) = append if (append == YES && FKS_OVERWRITE(fit) == YES) FKS_APPEND(fit) = NO if (group != -1) { if (kgroup != -1 && group != kgroup) call syserrs (SYS_FXFKSBADGR, IM_NAME(im)) else if (igroup != -1 && group != igroup) call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im)) fgroup = group } else if (kgroup != -1) { if (group != -1 && group != kgroup) call syserrs (SYS_FXFKSBADGR, IM_NAME(im)) else if (igroup != -1 && group != igroup) call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im)) fgroup = kgroup } else if (igroup != -1) { if ((group != -1 && group != igroup) || (kgroup != -1 && kgroup != igroup)) call syserrs (SYS_FXFKSBADFKIG, IM_NAME(im)) fgroup = igroup } group = fgroup # Pre-read the data header. This is done after processing the user # ksection as we need to get the extname/extver if any. # EXTNAME or EXTVER has priority when defined over group. fks_extn_or_ver = (FKS_EXTNAME(fit) != EOS || !IS_INDEFL(FKS_EXTVER(fit))) tgroup = fgroup if (fks_extn_or_ver) tgroup = -1 if (newimage == NO && !fnullfile (IM_HDRFILE(im))) { iferr (call fxf_prhdr (im, tgroup)) { # If group does not exist and over+, it is an error. if (FKS_OVERWRITE(fit) == YES) call syserrs (SYS_FXFEXTNF, IM_NAME(im)) else call erract (EA_ERROR) } } if (fgroup != -1 && tgroup != fgroup && fks_extn_or_ver) call syserrs (SYS_FXFKSBADEXN, IM_NAME(im)) if (fgroup == -1 && fks_extn_or_ver) group = tgroup FIT_EXPAND(fit) = FKS_EXPAND(fit) # For overwrite we need to force group to be the kernel section # extension number. if (FKS_OVERWRITE(fit) == YES) FIT_GROUP(fit) = max(kgroup,group) else FIT_GROUP(fit) = group if (FKS_APPEND(fit) == YES) FIT_GROUP(fit) = -1 # See if there are some error conditions with the ksection. call fxf_ks_errors (fit, acmode) # Check to see if the user ksection sets the inherit flag. If so # this overrides all the defaults, including the data header. inherit_override = (FKS_INHERIT(fit) != NO_KEYW) if (!inherit_override) FKS_INHERIT(fit) = sv_inherit # A data header has precedence over the more global fkinit. # If inherit is disabled in the data header don't enable it here. if (!inherit_override && FIT_INHERIT(fit) == NO) FKS_INHERIT(fit) = NO call sfree (sp) end # FXF_CLEAN_PL -- Filter PLIO keywords from the UA. procedure fxf_clean_pl (im) pointer im #I image descriptor begin #### (This is incredibly inefficient...) call fxf_filter_keyw (im, "TFORM1") call fxf_filter_keyw (im, "TFIELDS") call fxf_filter_keyw (im, "ZIMAGE") call fxf_filter_keyw (im, "ZCMPTYPE") call fxf_filter_keyw (im, "ZBITPIX") call fxf_filter_keyw (im, "ZNAXIS") call fxf_filter_keyw (im, "ZNAXIS1") call fxf_filter_keyw (im, "ZNAXIS2") call fxf_filter_keyw (im, "ZTILE1") call fxf_filter_keyw (im, "ZTILE2") call fxf_filter_keyw (im, "ZNAME1") call fxf_filter_keyw (im, "ZVAL1") end