diff options
Diffstat (limited to 'pkg/tbtables/fitsio/fitssppb')
254 files changed, 5737 insertions, 0 deletions
diff --git a/pkg/tbtables/fitsio/fitssppb/README b/pkg/tbtables/fitsio/fitssppb/README new file mode 100644 index 00000000..a0207701 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/README @@ -0,0 +1,14 @@ +# These routines are part of the FITSIO library and are designed to run in +# the IRAF/SPP environment. +#------------------------------------------------------------------------------ +# This software was prepared by High Energy Astrophysics Science Archive +# Research Center (HEASARC) at the NASA Goddard Space Flight Center. Users +# shall not, without prior written permission of the U.S. Government, +# establish a claim to statutory copyright. The Government and others acting +# on its behalf shall have a royalty-free, non-exclusive, irrevocable, +# worldwide license for Government purposes to publish, distribute, +# translate, copy, exhibit, and perform such material. +#------------------------------------------------------------------------------ +# +# In the standard FITSIO distribution, the SPP source files in this +# directory are contained in a single file, fitssppb.x. diff --git a/pkg/tbtables/fitsio/fitssppb/fitsio.h b/pkg/tbtables/fitsio/fitssppb/fitsio.h new file mode 100644 index 00000000..1bb75ded --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fitsio.h @@ -0,0 +1,15 @@ +# This file contains the global defines for the IRAF/SPP version of FITSIO. +# (This is not a C header file) +# SZ_FTTYPE, SZ_FTFORM, and SZ_FTUNIT were changed on 1999 Mar 10 by PEH + +define SZ_FERRTXT 30 # length of FITSIO error message +define SZ_FKEYWORD 8 # length of keyword name string +define SZ_FSTRVAL 70 # length of keyword value string +define SZ_FCOMMENT 48 # length of keyword comment string +define SZ_FLONGCOMM 72 # length of long keyword comment +define SZ_FCARD 80 # length of 'card' record +define SZ_FTTYPE 70 # length of column name string +define SZ_FTFORM 70 # len of col datatype and display format strings +define SZ_FTUNIT 70 # length of column units string +define SZ_FEXTNAME 24 # length of extension name string +define SZ_FTNULL 16 # length of null value string diff --git a/pkg/tbtables/fitsio/fitssppb/fsadef.x b/pkg/tbtables/fitsio/fitssppb/fsadef.x new file mode 100644 index 00000000..c3b4ea82 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsadef.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsadef(ounit,lenrow,nfield,tbcol,tform,nrows,status) + +# Ascii table data DEFinition +# define the structure of the ASCII table data unit + +int ounit # i output file pointer +int lenrow # o length of a table row +int nfield # i number of fields +int tbcol[ARB] # i beginning volumn +char tform[SZ_FTFORM,ARB] # i column datatype +% character*16 ftform(512) +int nrows # i number of rows +int status # o error status +int i + +begin + +do i=1,nfield + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + +call ftadef(ounit,lenrow,nfield,tbcol,ftform,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsarch.x b/pkg/tbtables/fitsio/fitssppb/fsarch.x new file mode 100644 index 00000000..f5fe6c60 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsarch.x @@ -0,0 +1,9 @@ +include "fitsio.h" + +procedure fsarch(machid) + +int machid # machine ID code + +begin +call ftarch(machid) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsasfm.x b/pkg/tbtables/fitsio/fitssppb/fsasfm.x new file mode 100644 index 00000000..02d00fab --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsasfm.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsasfm(tform,code,width,decims,status) + +char tform[SZ_FTTYPE] +% character ftform*24 +int code,width,decims +int status # o error status + +begin + +call f77pak(tform,ftform,4) +call ftasfm(ftform,code,width,decims,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsbdef.x b/pkg/tbtables/fitsio/fitssppb/fsbdef.x new file mode 100644 index 00000000..ba99ad1e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsbdef.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsbdef(ounit,nfield,tform,pcount,nrows,status) + +# Binary table data DEFinition +# define the structure of the binary table data unit + +int ounit # i output file pointer +int nfield # i number of fields +char tform[SZ_FTFORM,ARB] # i column datatype +% character*16 ftform(512) +int pcount # i number of group parame +int nrows # i number of rows +int status # o error status +int i + +begin + +do i=1,nfield + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + +call ftbdef(ounit,nfield,ftform,pcount,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsbnfm.x b/pkg/tbtables/fitsio/fitssppb/fsbnfm.x new file mode 100644 index 00000000..37ddb13f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsbnfm.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsbnfm(tform,dtype,rcount,width,status) + +# 'Binary Format' +# parse the binary table column format to determine the data +# type and the repeat count (and string width, if it is an ASCII field) + +char tform[SZ_FTFORM] # i column format +% character*16 ftform +int dtype # o datatype code +int rcount # o vector column repeat count +int width # o width of character string +int status # o error status + +begin + +call f77pak(tform ,ftform ,SZ_FTFORM) + +call ftbnfm(ftform,dtype,rcount,width,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsclos.x b/pkg/tbtables/fitsio/fitssppb/fsclos.x new file mode 100644 index 00000000..ddd39b2a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsclos.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsclos(iunit,status) + +# close a FITS file that was previously opened with ftopen or ftinit + +int iunit # i input file pointer +int status # o error status + +begin + +call ftclos(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscmps.x b/pkg/tbtables/fitsio/fitssppb/fscmps.x new file mode 100644 index 00000000..a3261a41 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscmps.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fscmps(templ,strng,casesn,match,exact) + +char templ[SZ_FTTYPE] # i column name template +% character ftemp*24 +char strng[SZ_FTTYPE] # i column name +% character fstrng*24 +bool casesn # i require same case? +bool match # o do the strings match? +bool exact # o is it an exact match? + +begin + +call f77pak(templ,ftemp,SZ_FTTYPE) +call f77pak(strng,fstrng,SZ_FTTYPE) +call ftcmps(ftemp,fstrng,casesn,match,exact) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscmsg.x b/pkg/tbtables/fitsio/fitssppb/fscmsg.x new file mode 100644 index 00000000..d6f0c292 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscmsg.x @@ -0,0 +1,11 @@ +include "fitsio.h" + +procedure fscmsg + +# clear the FITSIO error stack + +begin + + +call ftcmsg +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscopy.x b/pkg/tbtables/fitsio/fitssppb/fscopy.x new file mode 100644 index 00000000..aa508f34 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscopy.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fscopy(iunit,ounit,moreky,status) + +# copies the CHDU from IUNIT to the CHDU of OUNIT. +# This will also reserve space in the header for MOREKY keywords +# if MOREKY > 0. + +int iunit # i input file pointer +int ounit # i output file pointer +int moreky # i how many more keywords +int status # o error status + +begin + +call ftcopy(iunit,ounit,moreky,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscpdt.x b/pkg/tbtables/fitsio/fitssppb/fscpdt.x new file mode 100644 index 00000000..2da715ff --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscpdt.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fscpdt(iunit,ounit,status) + +# copies the data from IUNIT to the CHDU of OUNIT. + + +int iunit # i input file pointer +int ounit # i output file pointer +int status # o error status + +begin + +call ftcpdt(iunit,ounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fscrhd.x b/pkg/tbtables/fitsio/fitssppb/fscrhd.x new file mode 100644 index 00000000..69ae8b9d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fscrhd.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fscrhd(iunit,status) + +# 'CReate Header Data unit' +# create, initialize, and move the i/o pointer to a new extension at +# the end of the FITS file. + +int iunit # i input file pointer +int status # o error status + +begin + +call ftcrhd(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdcol.x b/pkg/tbtables/fitsio/fitssppb/fsdcol.x new file mode 100644 index 00000000..25aa36f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdcol.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdcol(ounit,colnum,status) + +# delete column in a table + +int ounit # i output file pointer +int colnum # i column to be deleted +int status # o error status + +begin + +call ftdcol(ounit,colnum,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsddef.x b/pkg/tbtables/fitsio/fitssppb/fsddef.x new file mode 100644 index 00000000..c07bb65a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsddef.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsddef(ounit,bytlen,status) + +# Data DEFinition +# re-define the length of the data unit +# this simply redefines the start of the next HDU + +int ounit # i output file pointer +int bytlen # i length in bytes +int status # o error status + +begin + +call ftddef(ounit,bytlen,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdelt.x b/pkg/tbtables/fitsio/fitssppb/fsdelt.x new file mode 100644 index 00000000..eae6e2f5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdelt.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsdelt(iunit,status) + +# close and delete a FITS file that was previously opened with ftopen or ftinit + +int iunit # i input file pointer +int status # o error status + +begin + +call ftdelt(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdhdu.x b/pkg/tbtables/fitsio/fitssppb/fsdhdu.x new file mode 100644 index 00000000..cb62ad45 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdhdu.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdhdu(iunit,hdutyp,status) + +# delete the CHDU + +int iunit # i input file pointer +int hdutyp # o type of the new CHDU +int status # o error status + +begin + +call ftdhdu(iunit,hdutyp,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdkey.x b/pkg/tbtables/fitsio/fitssppb/fsdkey.x new file mode 100644 index 00000000..5b7dc487 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdkey.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsdkey(iunit,keywrd,status) + +# delete a header keyword + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftdkey(iunit,fkeywr,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdrec.x b/pkg/tbtables/fitsio/fitssppb/fsdrec.x new file mode 100644 index 00000000..fc535fc8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdrec.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdrec(iunit,pos,status) + +# delete a header keyword + +int iunit # i input file pointer +int pos # i position of the keyword to be deleted +int status # o error status + +begin + +call ftdrec(iunit,pos,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdrow.x b/pkg/tbtables/fitsio/fitssppb/fsdrow.x new file mode 100644 index 00000000..dd926469 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdrow.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsdrow(ounit,frow,nrows,status) + +# delete rows in a table + +int ounit # i output file pointer +int frow # first row to delete +int nrows # number of rows +int status # o error status + +begin + +call ftdrow(ounit,frow,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdsum.x b/pkg/tbtables/fitsio/fitssppb/fsdsum.x new file mode 100644 index 00000000..10f43f2e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdsum.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsdsum(chksum,comp,sum) + +char chksum[16] +bool comp +double sum +% character fsum*16 + +begin + +call f77pak(chksum,fsum,16) +call ftdsum(fsum,comp,sum) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsdtyp.x b/pkg/tbtables/fitsio/fitssppb/fsdtyp.x new file mode 100644 index 00000000..da2ee7f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsdtyp.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsdtyp(value,dtype,status) + +# determine datatype of a FITS value field +# This assumes value field conforms to FITS standards and may not +# detect all invalid formats. +# value c input value field from FITS header record only, +# (usually the value field is in columns 11-30 of record) +# The value string is left justified. +# dtype c output type (C,L,I,F) for Character string, Logical, +# Integer, Floating point, respectively + +char value[SZ_FSTRVAL] # i data value +% character*70 fvalue +char dtype # o datatype code +% character*1 fdtype +int status # o error status +char sdtype[1] +begin + +call f77pak(value,fvalue,SZ_FSTRVAL) +call ftdtyp(fvalue,fdtype,status) +call f77upk(fdtype,sdtype,1) +dtype=sdtype[1] +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsesum.x b/pkg/tbtables/fitsio/fitssppb/fsesum.x new file mode 100644 index 00000000..4ed10305 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsesum.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsesum(sum,comp,chksum) + +double sum +bool comp +char chksum[16] +% character fsum*16 + +begin + +call ftesum(sum,comp,fsum) +call f77upk(fsum,chksum,16) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsfiou.x b/pkg/tbtables/fitsio/fitssppb/fsfiou.x new file mode 100644 index 00000000..e87cbf50 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsfiou.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsfiou(iounit,status) + +# Returns an unused I/O unit number which may then be used as input +# to the fsinit or fsopen procedures. + +int iounit # i I/O unit number +int status # o error status + +begin +call ftfiou(iounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2db.x b/pkg/tbtables/fitsio/fitssppb/fsg2db.x new file mode 100644 index 00000000..ee4636eb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2db.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2db(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2db(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2dd.x b/pkg/tbtables/fitsio/fitssppb/fsg2dd.x new file mode 100644 index 00000000..989831c9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2dd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2dd(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of r*8 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +double nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +double array[ARB] # i array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2dd(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2de.x b/pkg/tbtables/fitsio/fitssppb/fsg2de.x new file mode 100644 index 00000000..a8ec666e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2de.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2de(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of real values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +real nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +real array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2de(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2di.x b/pkg/tbtables/fitsio/fitssppb/fsg2di.x new file mode 100644 index 00000000..5f47a303 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2di.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2di(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of i*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +short nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +short array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2di(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg2dj.x b/pkg/tbtables/fitsio/fitssppb/fsg2dj.x new file mode 100644 index 00000000..29d7ce3f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg2dj.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsg2dj(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) + +# Read a 2-d image of i*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg2dj(ounit,group,nulval,dim1,nx,ny,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3db.x b/pkg/tbtables/fitsio/fitssppb/fsg3db.x new file mode 100644 index 00000000..be6562a6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3db.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3db(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3db(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3dd.x b/pkg/tbtables/fitsio/fitssppb/fsg3dd.x new file mode 100644 index 00000000..b08eb765 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3dd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3dd(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +double nulval # i value for undefined pi +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +double array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3dd(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3de.x b/pkg/tbtables/fitsio/fitssppb/fsg3de.x new file mode 100644 index 00000000..af302158 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3de.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3de(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of real values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +real nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +real array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3de(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3di.x b/pkg/tbtables/fitsio/fitssppb/fsg3di.x new file mode 100644 index 00000000..3e2fc780 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3di.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3di(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of i*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +short nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +short array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3di(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsg3dj.x b/pkg/tbtables/fitsio/fitssppb/fsg3dj.x new file mode 100644 index 00000000..857a7a8e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsg3dj.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsg3dj(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) + +# Read a 3-d cube of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int ounit # i output file pointer +int group # i group number +int nulval # i value for undefined pixels +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftg3dj(ounit,group,nulval,dim1,dim2,nx,ny,nz, + array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgabc.x b/pkg/tbtables/fitsio/fitssppb/fsgabc.x new file mode 100644 index 00000000..430fed56 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgabc.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgabc(nfield,tform,space,rowlen,tbcol,status) + +# Get ASCII table Beginning Columns +# determine the byte offset of the beginning of each field of a +# ASCII table, and the total width of the table + +int nfield # i number of fields +char tform[SZ_FTFORM,ARB] # i column datatypes +% character*16 ftform(512) +int space # i no. spaces between col +int rowlen # o length of a table row +int tbcol[ARB] # o starting column positions +int status # o error status +int i + +begin + +do i=1,nfield + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + +call ftgabc(nfield,ftform,space,rowlen,tbcol,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgacl.x b/pkg/tbtables/fitsio/fitssppb/fsgacl.x new file mode 100644 index 00000000..09db30a0 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgacl.x @@ -0,0 +1,33 @@ +include "fitsio.h" + +procedure fsgacl(iunit,colnum,ttype,tbcol,tunit,tform, + tscal,tzero,tnull,tdisp,status) + +# Get information about an Ascii table CoLumn +# returns the parameters which define the column + +int iunit # i input file pointer +int colnum # i column number +char ttype[SZ_FTTYPE] # o column name +int tbcol # o starting column position in the row +char tunit[SZ_FTUNIT] # o physical units of the column +char tform[SZ_FTFORM] # o FITS data format of the column +double tscal # o scaling factor +double tzero # o scaling zero point +char tnull[SZ_FTNULL] # o string used to represent null values +char tdisp[SZ_FTFORM] # o Fortran display format +int status # o error status +% character fttype*24, ftunit*24,ftform*16,ftnull*16,ftdisp*16 + +begin + +call ftgacl(iunit,colnum,fttype,tbcol,ftunit,ftform, + tscal,tzero,ftnull,ftdisp,status) + +call f77upk(fttype,ttype,SZ_FTTYPE) +call f77upk(ftunit,tunit,SZ_FTUNIT) +call f77upk(ftform,tform,SZ_FTFORM) +call f77upk(ftnull,tnull,SZ_FTNULL) +call f77upk(ftdisp,tdisp,SZ_FTFORM) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgbcl.x b/pkg/tbtables/fitsio/fitssppb/fsgbcl.x new file mode 100644 index 00000000..b6281f49 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgbcl.x @@ -0,0 +1,32 @@ +include "fitsio.h" + +procedure fsgbcl(iunit,colnum,ttype,tunit,dtype,rcount, + tscal,tzero,tnull,tdisp,status) + +# Get information about a Binary table CoLumn +# returns the parameters which define the column + +int iunit # i input file pointer +int colnum # i column number +char ttype[SZ_FTTYPE] # o column name +char tunit[SZ_FTUNIT] # o physical units of the column +char dtype[SZ_FTFORM] # o datatype code +int rcount # o repeat count for vector column +double tscal # o scaling factor +double tzero # o scaling zero point +int tnull # o integer used to represent null values +char tdisp[SZ_FTFORM] # o Fortran display format +int status # o error status +% character fttype*24, ftunit*24, ftdisp*16, fdtype*16 + +begin + +call ftgbcl(iunit,colnum,fttype,ftunit,fdtype,rcount, + tscal,tzero,tnull,ftdisp,status) + +call f77upk(fttype,ttype,SZ_FTTYPE) +call f77upk(ftunit,tunit,SZ_FTUNIT) +call f77upk(ftdisp,tdisp,SZ_FTFORM) +call f77upk(fdtype,dtype,SZ_FTFORM) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfb.x b/pkg/tbtables/fitsio/fitssppb/fsgcfb.x new file mode 100644 index 00000000..d61d749a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfb.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfb(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of byte values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfb(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfc.x b/pkg/tbtables/fitsio/fitssppb/fsgcfc.x new file mode 100644 index 00000000..9bf07063 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfc.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfc(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of complex values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfc(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfd.x b/pkg/tbtables/fitsio/fitssppb/fsgcfd.x new file mode 100644 index 00000000..3c2b846e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfd(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of r*8 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfd(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfe.x b/pkg/tbtables/fitsio/fitssppb/fsgcfe.x new file mode 100644 index 00000000..8e24508b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfe.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfe(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of R*4 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfe(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfi.x b/pkg/tbtables/fitsio/fitssppb/fsgcfi.x new file mode 100644 index 00000000..566a60d8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfi.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfi(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of I*2 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfi(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfj.x b/pkg/tbtables/fitsio/fitssppb/fsgcfj.x new file mode 100644 index 00000000..cfc7da3f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfj.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcfj(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of I*4 values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfj(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfl.x b/pkg/tbtables/fitsio/fitssppb/fsgcfl.x new file mode 100644 index 00000000..ce8384ef --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfl.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgcfl(iunit,colnum,frow,felem,nelem,lray, + flgval,anynul,status) + +# read an array of logical values from a specified column of the table. +# The binary table column being read from must have datatype 'L' +# and no datatype conversion will be perform if it is not. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +bool lray[ARB] # o logical array +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfl(iunit,colnum,frow,felem,nelem,lray, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfm.x b/pkg/tbtables/fitsio/fitssppb/fsgcfm.x new file mode 100644 index 00000000..25447f55 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfm.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsgcfm(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) + +# read an array of double precision complex values from a specified +# column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcfm(iunit,colnum,frow,felem,nelem,array, + flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcfs.x b/pkg/tbtables/fitsio/fitssppb/fsgcfs.x new file mode 100644 index 00000000..a9f81e22 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcfs.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsgcfs(iunit,colnum,frow,felem,nelem,array,dim1, + flgval,anynul,status) + +# read an array of string values from a specified column of the table. +# Any undefined pixels will be have the corresponding value of FLGVAL +# set equal to .true., and ANYNUL will be set equal to .true. if +# any pixels are undefined. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +char array[dim1,ARB] # o array of values +% character farray*256 +int dim1 # i size of 1st dimension of 2D character string array +bool flgval[ARB] # o is corresponding value undefined? +bool anynul # o any null values? +int status # o error status +int i +int elem +bool null + +begin + +anynul=false +elem=felem +do i=1,nelem { + call ftgcfs(iunit,colnum,frow,elem,1,farray,flgval(i),null,status) + if (null) + anynul=true + + call f77upk(farray,array(1,i),dim1) + elem=elem+1 + } +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcks.x b/pkg/tbtables/fitsio/fitssppb/fsgcks.x new file mode 100644 index 00000000..3085ce58 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcks.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsgcks(iunit,datasum,hdusum,status) + +int iunit +double datasum +double hdusum +int status # o error status + +begin + +call ftgcks(iunit,datasum,hdusum,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcl.x b/pkg/tbtables/fitsio/fitssppb/fsgcl.x new file mode 100644 index 00000000..3d3132c2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgcl(iunit,colnum,frow,felem,nelem,lray,status) + +# read an array of logical values from a specified column of the table. +# The binary table column being read from must have datatype 'L' +# and no datatype conversion will be perform if it is not. +# This routine ignores any undefined values in the logical array. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +bool lray[ARB] # o logical array +int status # o error status + +begin + +call ftgcl(iunit,colnum,frow,felem,nelem,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcnn.x b/pkg/tbtables/fitsio/fitssppb/fsgcnn.x new file mode 100644 index 00000000..bd31a11a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcnn.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgcnn(iunit,exact,colnam,realnm,colnum,status) + +# determine the column number corresponding to an input column name. + +int iunit # i input file pointer +bool exact # i require same case? +char colnam[SZ_FTTYPE] # i column name template +% character fcolna*24 +char realnm[SZ_FTTYPE] # o column name +% character frealn*24 +int colnum # o column number +int status # o error status + +begin + +call f77pak(colnam,fcolna,SZ_FTTYPE) +call ftgcnn(iunit,exact,fcolna,frealn,colnum,status) +call f77upk(frealn,realnm,SZ_FTTYPE) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcno.x b/pkg/tbtables/fitsio/fitssppb/fsgcno.x new file mode 100644 index 00000000..a69e0ef1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcno.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsgcno(iunit,exact,colnam,colnum,status) + +# determine the column number corresponding to an input column name. +# this assumes that the first 16 characters uniquely define the name + +int iunit # i input file pointer +bool exact # i require same case? +char colnam[SZ_FTTYPE] # column name +% character fcolna*24 +int colnum # o column number +int status # o error status + +begin + +call f77pak(colnam,fcolna,SZ_FTTYPE) + +call ftgcno(iunit,exact,fcolna,colnum,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcrd.x b/pkg/tbtables/fitsio/fitssppb/fsgcrd.x new file mode 100644 index 00000000..e2ceb9e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcrd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgcrd(iunit,keywrd,card,status) + +# Read the 80 character card image of a specified header keyword record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char card[SZ_FCARD] # o 80-char header record +% character fcard*80 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgcrd(iunit,fkeywr,fcard,status) + +call f77upk(fcard ,card ,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvb.x b/pkg/tbtables/fitsio/fitssppb/fsgcvb.x new file mode 100644 index 00000000..21297842 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvb.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvb(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of byte values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixels +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvb(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvc.x b/pkg/tbtables/fitsio/fitssppb/fsgcvc.x new file mode 100644 index 00000000..1a804e49 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvc.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvc(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of complex values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real nulval[2] # i value for undefined pixels +real array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvc(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvd.x b/pkg/tbtables/fitsio/fitssppb/fsgcvd.x new file mode 100644 index 00000000..860363d7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvd(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of r*8 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double nulval # i value for undefined pixels +double array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvd(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcve.x b/pkg/tbtables/fitsio/fitssppb/fsgcve.x new file mode 100644 index 00000000..3753b0f1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcve.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcve(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of R*4 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real nulval # i value for undefined pixels +real array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcve(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvi.x b/pkg/tbtables/fitsio/fitssppb/fsgcvi.x new file mode 100644 index 00000000..66fd4bf8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvi.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvi(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of I*2 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short nulval # i value for undefined pixels +short array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvi(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvj.x b/pkg/tbtables/fitsio/fitssppb/fsgcvj.x new file mode 100644 index 00000000..8cab67a2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvj.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgcvj(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of I*4 values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixels +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvj(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvm.x b/pkg/tbtables/fitsio/fitssppb/fsgcvm.x new file mode 100644 index 00000000..a787faf0 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvm.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsgcvm(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) + +# read an array of double precision complex values from a specified +# column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=0, in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double nulval[2] # i value for undefined pixels +double array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgcvm(iunit,colnum,frow,felem,nelem,nulval,array, + anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcvs.x b/pkg/tbtables/fitsio/fitssppb/fsgcvs.x new file mode 100644 index 00000000..b5bd9c05 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcvs.x @@ -0,0 +1,41 @@ +include "fitsio.h" + +procedure fsgcvs(iunit,colnum,frow,felem,nelem,nulval,array,dim1,anynul, + status) + +# read an array of string values from a specified column of the table. +# Any undefined pixels will be set equal to the value of NULVAL, +# unless NULVAL=' ', in which case no checks for undefined pixels +# will be made. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +char nulval[SZ_FTNULL] # i value for undefined pixels +% character fnulva*16 +char array[dim1,ARB] # o array of values +% character farray*256 +int dim1 # i size of 1st dimension of 2D character string array +bool anynul # o any null values returned? +int status # o error status +int i +int elem +bool null + +begin + +call f77pak(nulval,fnulva,SZ_FTNULL) + +anynul=false +elem=felem +do i=1,nelem { + call ftgcvs(iunit,colnum,frow,elem,1,fnulva,farray,null,status) + if (null) + anynul=true + + call f77upk(farray,array(1,i),dim1) + elem=elem+1 + } +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcx.x b/pkg/tbtables/fitsio/fitssppb/fsgcx.x new file mode 100644 index 00000000..8cedb3f3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcx.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgcx(iunit,colnum,frow,fbit,nbit,lray,status) + +# read an array of logical values from a specified bit or byte +# column of the binary table. A logical .true. value is returned +# if the corresponding bit is 1, and a logical .false. value is +# returned if the bit is 0. +# The binary table column being read from must have datatype 'B' +# or 'X'. This routine ignores any undefined values in the 'B' array. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int fbit # i first bit +int nbit # i number of bits +bool lray[ARB] # o logical array +int status # o error status + +begin + +call ftgcx(iunit,colnum,frow,fbit,nbit,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcxd.x b/pkg/tbtables/fitsio/fitssppb/fsgcxd.x new file mode 100644 index 00000000..624143d4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcxd.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgcxd(iunit,colnum,frow,nrow,fbit,nbit,dvalue,status) + +# read consecutive bits from 'X' or 'B' column as an unsigned integer + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int nrow # i number of rows +int fbit # i first bit +int nbit # i number of bits +double dvalue[ARB] # o double integer array +int status # o error status + +begin + +call ftgcxd(iunit,colnum,frow,nrow,fbit,nbit,dvalue,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcxi.x b/pkg/tbtables/fitsio/fitssppb/fsgcxi.x new file mode 100644 index 00000000..319146f1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcxi.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgcxi(iunit,colnum,frow,nrow,fbit,nbit,ivalue,status) + +# read consecutive bits from 'X' or 'B' column as an unsigned integer + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int nrow # i number of rows +int fbit # i first bit +int nbit # i number of bits +short ivalue[ARB] # o short integer array +int status # o error status + +begin + +call ftgcxi(iunit,colnum,frow,nrow,fbit,nbit,ivalue,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgcxj.x b/pkg/tbtables/fitsio/fitssppb/fsgcxj.x new file mode 100644 index 00000000..a38400bf --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgcxj.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgcxj(iunit,colnum,frow,nrow,fbit,nbit,jvalue,status) + +# read consecutive bits from 'X' or 'B' column as an unsigned integer + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int nrow # i number of rows +int fbit # i first bit +int nbit # i number of bits +int jvalue[ARB] # o integer array +int status # o error status + +begin + +call ftgcxj(iunit,colnum,frow,nrow,fbit,nbit,jvalue,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgdes.x b/pkg/tbtables/fitsio/fitssppb/fsgdes.x new file mode 100644 index 00000000..c180304d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgdes.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgdes(iunit,colnum,rownum,nelem,offset,status) + +# read the descriptor values from a binary table. This is only +# used for column which have TFORMn = 'P', i.e., for variable +# length arrays. + +int iunit # i input file pointer +int colnum # i column number +int rownum # i row number +int nelem # o number of elements +int offset # o offset +int status # o error status + +begin + +call ftgdes(iunit,colnum,rownum,nelem,offset,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgerr.x b/pkg/tbtables/fitsio/fitssppb/fsgerr.x new file mode 100644 index 00000000..039454c8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgerr.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsgerr(errnum,text) + +# Return a descriptive error message corresponding to the error number + +int errnum # i error number +char text[SZ_FERRTXT] # i text string +% character ftext*30 + +begin + +call ftgerr(errnum,ftext) + +call f77upk(ftext ,text ,SZ_FERRTXT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpb.x b/pkg/tbtables/fitsio/fitssppb/fsggpb.x new file mode 100644 index 00000000..763d2533 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpb(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # o array of values +int status # o error status + +begin + +call ftggpb(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpd.x b/pkg/tbtables/fitsio/fitssppb/fsggpd.x new file mode 100644 index 00000000..fea28527 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpd(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +double array[ARB] # i array of values +int status # o error status + +begin + +call ftggpd(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpe.x b/pkg/tbtables/fitsio/fitssppb/fsggpe.x new file mode 100644 index 00000000..9ca8b786 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpe.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpe(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +real array[ARB] # i array of values +int status # o error status + +begin + +call ftggpe(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpi.x b/pkg/tbtables/fitsio/fitssppb/fsggpi.x new file mode 100644 index 00000000..4ac34cdf --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpi.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpi(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +short array[ARB] # o array of values +int status # o error status + +begin + +call ftggpi(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsggpj.x b/pkg/tbtables/fitsio/fitssppb/fsggpj.x new file mode 100644 index 00000000..f5e91a34 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsggpj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsggpj(iunit,group,fparm,nparm,array,status) + +# Read an array of group parameter values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # i array of values +int status # o error status + +begin + +call ftggpj(iunit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghad.x b/pkg/tbtables/fitsio/fitssppb/fsghad.x new file mode 100644 index 00000000..5511af26 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghad.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsghad(iunit,curadd,nxtadd) + +# delete the CHDU + +int iunit # i input file pointer +int curadd # o starting byte address of the CHDU +int nxtadd # o starting byte address of the next HDU + +begin + +call ftghad(iunit,curadd,nxtadd) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghbn.x b/pkg/tbtables/fitsio/fitssppb/fsghbn.x new file mode 100644 index 00000000..b5122129 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghbn.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsghbn(iunit,maxfld,nrows,nfield,ttype,tform, + tunit,extnam,pcount,status) + +# read required standard header keywords from a binary table extension + +int iunit # i input file pointer +int maxfld # i max. number of fields +int nrows # o number of rows +int nfield # o number of fields +char ttype[SZ_FTTYPE,ARB] # o column name +% character*24 fttype(512) +char tform[SZ_FTFORM,ARB] # o column datatype +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # o column units +% character*16 ftunit(512) +char extnam +% character fextna*48 +int pcount # o size of 'heap' +int status # o error status +int i +int n + +begin + +call ftghbn(iunit,maxfld,nrows,nfield,fttype,ftform, + ftunit,fextna,pcount,status) +n=min(maxfld,nfield) +do i = 1, n + { call f77upk(fttype(i) ,ttype(1,i),SZ_FTTYPE) + call f77upk(ftform(i) ,tform(1,i),SZ_FTFORM) + call f77upk(ftunit(i) ,tunit(1,i),SZ_FTUNIT) + } + +call f77upk(fextna ,extnam,SZ_FEXTNAME) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghdn.x b/pkg/tbtables/fitsio/fitssppb/fsghdn.x new file mode 100644 index 00000000..9748b924 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghdn.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsghdn(iunit,hdunum) + +# return the number of the current header data unit. The +# first HDU (the primary array) is number 1. + +int iunit # i input file pointer +int hdunum # o returned number of the current HDU + +begin + +call ftghdn(iunit,hdunum) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghpr.x b/pkg/tbtables/fitsio/fitssppb/fsghpr.x new file mode 100644 index 00000000..ed0bf343 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghpr.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsghpr(iunit,maxdim,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) + +# get the required primary header or image extension keywords + +int iunit # i input file pointer +int maxdim # i max. number of dimensions +bool simple # o simple FITS file? +int bitpix # o bits per pixel +int naxis # o number of axes +int naxes[ARB] # o dimension of each axis +int pcount # o no. of group parameters +int gcount # o no. of groups +bool extend # o EXTEND keyword = TRUE? +int status # o error status + +begin + +call ftghpr(iunit,maxdim,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghps.x b/pkg/tbtables/fitsio/fitssppb/fsghps.x new file mode 100644 index 00000000..1d431117 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghps.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsghps(ounit,nexist,keyno,status) + +# return the current position in the header + +int ounit # i output file pointer +int nexist # o how many exist? +int keyno # o position of the last keyword that was read + 1 +int status # o error status + +begin + +call ftghps(ounit,nexist,keyno,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghsp.x b/pkg/tbtables/fitsio/fitssppb/fsghsp.x new file mode 100644 index 00000000..916efd3c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghsp.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsghsp(ounit,nexist,nmore,status) + +# Get Header SPace +# return the number of additional keywords that will fit in the header + +int ounit # i output file pointer +int nexist # o how many exist? +int nmore # o this many more will fit +int status # o error status + +begin + +call ftghsp(ounit,nexist,nmore,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsghtb.x b/pkg/tbtables/fitsio/fitssppb/fsghtb.x new file mode 100644 index 00000000..3d769a12 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsghtb.x @@ -0,0 +1,40 @@ +include "fitsio.h" + +procedure fsghtb(iunit,maxfld,ncols,nrows,nfield,ttype, + tbcol,tform,tunit,extnam,status) + +# read required standard header keywords from an ASCII table extension + +int iunit # i input file pointer +int maxfld # i max. number of fields to return +int ncols # o number of columns +int nrows # o number of rows +int nfield # o number of fields +char ttype[SZ_FTTYPE,ARB] # o column name +% character*24 fttype(512) +int tbcol[ARB] # o starting column position +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int status # o error status +int i +int n + +begin + +call ftghtb(iunit,maxfld,ncols,nrows,nfield,fttype, + tbcol,ftform,ftunit,fextna,status) + +n=min(maxfld,nfield) +do i = 1, n + { call f77upk(fttype(i) ,ttype(1,i),SZ_FTTYPE) + call f77upk(ftform(i) ,tform(1,i),SZ_FTFORM) + call f77upk(ftunit(i) ,tunit(1,i),SZ_FTUNIT) + } + +call f77upk(fextna ,extnam,SZ_FEXTNAME) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgics.x b/pkg/tbtables/fitsio/fitssppb/fsgics.x new file mode 100644 index 00000000..1453e054 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgics.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsgics(iunit,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coord,status) + +int iunit +double xrval,yrval,xrpix,yrpix,xinc,yinc,rot +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call ftgics(iunit,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,fcoord,status) +call f77upk(fcoord,coord,4) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgiou.x b/pkg/tbtables/fitsio/fitssppb/fsgiou.x new file mode 100644 index 00000000..eee38391 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgiou.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsgiou(iounit,status) + +# Returns an unused I/O unit number which may then be used as input +# to the fsinit or fsopen procedures. + +int iounit # o unused I/O unit number +int status # o error status + +begin +call ftgiou(iounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkey.x b/pkg/tbtables/fitsio/fitssppb/fsgkey.x new file mode 100644 index 00000000..a5f2cd52 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkey.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgkey(iunit,keywrd,value,comm,status) + +# Read value and comment of a header keyword from the keyword buffer + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char value[SZ_FSTRVAL] # o keyword value +% character fvalue*70 +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkey(iunit,fkeywr,fvalue,fcomm,status) + +call f77upk(fvalue ,value ,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FCOMMENT) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgknd.x b/pkg/tbtables/fitsio/fitssppb/fsgknd.x new file mode 100644 index 00000000..8a34bb21 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgknd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgknd(iunit,keywrd,nstart,nmax,dval,nfound,status) + +# read an array of real*8 values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +double dval[ARB] # o real*8 value +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgknd(iunit,fkeywr,nstart,nmax,dval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkne.x b/pkg/tbtables/fitsio/fitssppb/fsgkne.x new file mode 100644 index 00000000..b71ba65b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkne.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgkne(iunit,keywrd,nstart,nmax,rval,nfound,status) + +# read an array of real*4 values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +real rval[ARB] # o real*4 values +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkne(iunit,fkeywr,nstart,nmax,rval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgknj.x b/pkg/tbtables/fitsio/fitssppb/fsgknj.x new file mode 100644 index 00000000..7f95bc07 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgknj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgknj(iunit,keywrd,nstart,nmax,intval,nfound,status) + +# read an array of integer values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +int intval[ARB] # o integer values +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgknj(iunit,fkeywr,nstart,nmax,intval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgknl.x b/pkg/tbtables/fitsio/fitssppb/fsgknl.x new file mode 100644 index 00000000..929c1173 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgknl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsgknl(iunit,keywrd,nstart,nmax,logval,nfound,status) + +# read an array of logical values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +bool logval[ARB] # o logical values +int nfound # o no. of keywords found +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgknl(iunit,fkeywr,nstart,nmax,logval,nfound,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkns.x b/pkg/tbtables/fitsio/fitssppb/fsgkns.x new file mode 100644 index 00000000..b2ad098a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkns.x @@ -0,0 +1,49 @@ +include "fitsio.h" + +procedure fsgkns(iunit,keywrd,nstart,nmax,strval,nfound,status) + +# read an array of character string values from header records + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nmax # i max. number of keyword +char strval[SZ_FSTRVAL,ARB] # o string value +% character*70 fstrva +% character*48 comm +% character*8 keynam + +int nfound # o no. of keywords found +int status # o error status +int i +int j + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +nfound=0 +j=nstart + +do i=1,nmax { + call ftkeyn(fkeywr,j,keynam,status) + if (status > 0) + go to 10 + + call ftgkys(iunit,keynam,fstrva,comm,status) + + if (status <= 0) { + nfound=i + call f77upk(fstrva,strval(1,i),SZ_FSTRVAL) + + } else if (status == 202) { +# ignore keyword not found error + status=0 + } + j=j+1 + } + +10 + j=0 +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyd.x b/pkg/tbtables/fitsio/fitssppb/fsgkyd.x new file mode 100644 index 00000000..96ae59a3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyd.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkyd(iunit,keywrd,dval,comm,status) + +# read a double precision value and comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # o real*8 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyd(iunit,fkeywr,dval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkye.x b/pkg/tbtables/fitsio/fitssppb/fsgkye.x new file mode 100644 index 00000000..8442e96b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkye(iunit,keywrd,rval,comm,status) + +# read a real*4 value and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # o real*4 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkye(iunit,fkeywr,rval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyj.x b/pkg/tbtables/fitsio/fitssppb/fsgkyj.x new file mode 100644 index 00000000..2260b3d5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyj.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkyj(iunit,keywrd,intval,comm,status) + +# read an integer value and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # o integer value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyj(iunit,fkeywr,intval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyl.x b/pkg/tbtables/fitsio/fitssppb/fsgkyl.x new file mode 100644 index 00000000..9ba9aea4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyl.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsgkyl(iunit,keywrd,logval,comm,status) + +# read a logical value and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # o logical value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyl(iunit,fkeywr,logval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyn.x b/pkg/tbtables/fitsio/fitssppb/fsgkyn.x new file mode 100644 index 00000000..7f52b7e4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyn.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fsgkyn(iunit,nkey,keywrd,value,comm,status) + +# Read the name, value, and comment of the NKEYth header record +# This routine is useful for reading the entire header, one +# record at a time. + +int iunit # i input file pointer +int nkey # i number of keywords +char keywrd[SZ_FKEYWORD] # o keyword name +% character fkeywr*8 +char value[SZ_FSTRVAL] # o data value +% character fvalue*70 +char comm[SZ_FLONGCOMM] # o keyword comment +% character fcomm*72 +int status # o error status + +begin + +call ftgkyn(iunit,nkey,fkeywr,fvalue,fcomm,status) + +call f77upk(fkeywr ,keywrd ,SZ_FKEYWORD) +call f77upk(fvalue ,value ,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FLONGCOMM) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkys.x b/pkg/tbtables/fitsio/fitssppb/fsgkys.x new file mode 100644 index 00000000..a93a8bcf --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkys.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsgkys(iunit,keywrd,strval,comm,status) + +# read a character string value and comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # o string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkys(iunit,fkeywr,fstrva,fcomm,status) + +call f77upk(fstrva,strval,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FCOMMENT) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgkyt.x b/pkg/tbtables/fitsio/fitssppb/fsgkyt.x new file mode 100644 index 00000000..c3db4645 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgkyt.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgkyt(iunit,keywrd,intval,dval,comm,status) + +# read an integer value and fractional parts of a keyword value +# and the comment string from a header record + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # o integer value +double dval # o real*8 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftgkyt(iunit,fkeywr,intval,dval,fcomm,status) + +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgmsg.x b/pkg/tbtables/fitsio/fitssppb/fsgmsg.x new file mode 100644 index 00000000..7c6f6a2e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgmsg.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsgmsg(text) + +# Return oldest error message from the FITSIO error stack + +char text[SZ_FCARD] # o text string +% character ftext*80 + +begin + +call ftgmsg(ftext) + +call f77upk(ftext ,text ,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfb.x b/pkg/tbtables/fitsio/fitssppb/fsgpfb.x new file mode 100644 index 00000000..941123cb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfb.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfb(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfb(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfd.x b/pkg/tbtables/fitsio/fitssppb/fsgpfd.x new file mode 100644 index 00000000..b222425e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfd(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of r*8 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfd(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfe.x b/pkg/tbtables/fitsio/fitssppb/fsgpfe.x new file mode 100644 index 00000000..91f63dff --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfe.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfe(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of r*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfe(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfi.x b/pkg/tbtables/fitsio/fitssppb/fsgpfi.x new file mode 100644 index 00000000..33ec211c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfi.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfi(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of I*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfi(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpfj.x b/pkg/tbtables/fitsio/fitssppb/fsgpfj.x new file mode 100644 index 00000000..2cef04ea --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpfj.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpfj(iunit,group,felem,nelem, + array,flgval,anynul,status) + +# Read an array of I*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will have the corresponding element of +# FLGVAL set equal to .true. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding element undefined? +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpfj(iunit,group,felem,nelem, + array,flgval,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvb.x b/pkg/tbtables/fitsio/fitssppb/fsgpvb.x new file mode 100644 index 00000000..f1a8f79d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvb.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvb(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of byte values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixel +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvb(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvd.x b/pkg/tbtables/fitsio/fitssppb/fsgpvd.x new file mode 100644 index 00000000..d3e9bd9b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvd(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of r*8 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double nulval # i value for undefined pixels +double array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvd(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpve.x b/pkg/tbtables/fitsio/fitssppb/fsgpve.x new file mode 100644 index 00000000..ac7f6e79 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpve.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpve(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of r*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real nulval # i value for undefined pixels +real array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpve(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvi.x b/pkg/tbtables/fitsio/fitssppb/fsgpvi.x new file mode 100644 index 00000000..e68c1625 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvi.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvi(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of i*2 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short nulval # i value for undefined pixels +short array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvi(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgpvj.x b/pkg/tbtables/fitsio/fitssppb/fsgpvj.x new file mode 100644 index 00000000..45e55099 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgpvj.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fsgpvj(iunit,group,felem,nelem,nulval, + array,anynul,status) + +# Read an array of i*4 values from the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). +# Undefined elements will be set equal to NULVAL, unless NULVAL=0 +# in which case no checking for undefined values will be performed. +# ANYNUL is return with a value of .true. if any pixels were undefined. + +int iunit # i input file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int nulval # i value for undefined pixels +int array[ARB] # o array of values +bool anynul # o any null values? +int status # o error status + +begin + +call ftgpvj(iunit,group,felem,nelem,nulval, + array,anynul,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgrec.x b/pkg/tbtables/fitsio/fitssppb/fsgrec.x new file mode 100644 index 00000000..440c8bdb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgrec.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsgrec(iunit,nrec,record,status) + +# Read the Nth 80-byte header record +# This routine is useful for reading the entire header, one +# record at a time. + +int iunit # i input file pointer +int nrec # i number of keywords +char record[SZ_FCARD] # o 80-char header record +% character frecor*80 +int status # o error status + +begin + +call ftgrec(iunit,nrec,frecor,status) + +call f77upk(frecor,record,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgrsz.x b/pkg/tbtables/fitsio/fitssppb/fsgrsz.x new file mode 100644 index 00000000..83dca679 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgrsz.x @@ -0,0 +1,35 @@ +include <fset.h> +include "fitsio.h" + +# This was added for compatibility with CFITSIO. + +procedure fsgrsz (iunit, maxrows, status) + + +int iunit # i input file pointer +int maxrows # o number of rows that fit in buffer +int status # o error status +#-- +int fd +int bufsize +int naxis1 +char comm[SZ_FCOMMENT] +int fstati() +include "../fitsspp.com" # in order to get fd from iunit + +begin + call fsgkyj (iunit, "NAXIS1", naxis1, comm, status) + if (status != 0) + return + naxis1 = naxis1 / 2 # convert from bytes to SPP char + + fd = bufid[iunit] + + bufsize = fstati (fd, F_BUFSIZE) + if (naxis1 > 0) { + maxrows = bufsize / naxis1 + maxrows = max (1, maxrows) + } else { + maxrows = bufsize + } +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsdt.x b/pkg/tbtables/fitsio/fitssppb/fsgsdt.x new file mode 100644 index 00000000..8a223280 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsdt.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsgsdt(dd,mm,yy,status) + +# get the current date + +int dd #O day of the month (1-31) +int mm #O month of the year (1-12) +int yy #O last 2 digits of the year (1992 = 92, 2001 = 01) +int status # o error status + +begin +call ftgsdt (dd, mm, yy, status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfb.x b/pkg/tbtables/fitsio/fitssppb/fsgsfb.x new file mode 100644 index 00000000..2f5be792 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfb.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsfb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +# Read a subsection of byte values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfd.x b/pkg/tbtables/fitsio/fitssppb/fsgsfd.x new file mode 100644 index 00000000..3f3fa6c9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsfd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of double precision values from the primary array. +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +double array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfe.x b/pkg/tbtables/fitsio/fitssppb/fsgsfe.x new file mode 100644 index 00000000..8360592a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfe.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsfe(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of real values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +real array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfe(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfi.x b/pkg/tbtables/fitsio/fitssppb/fsgsfi.x new file mode 100644 index 00000000..13ff31e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfi.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsfi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of Integer*2 values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +short array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsfj.x b/pkg/tbtables/fitsio/fitssppb/fsgsfj.x new file mode 100644 index 00000000..255705f2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsfj.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsfj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) + +# Read a subsection of integer values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int array[ARB] # o array of values +bool flgval[ARB] # o is corresponding value undefined? +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsfj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + array,flgval,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvb.x b/pkg/tbtables/fitsio/fitssppb/fsgsvb.x new file mode 100644 index 00000000..4fa8556b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvb.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsvb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +# Read a subsection of byte values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int nulval # i value for undefined pi +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvb(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvd.x b/pkg/tbtables/fitsio/fitssppb/fsgsvd.x new file mode 100644 index 00000000..c66993a6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgsvd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of double precision values from the primary array. +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +double nulval # i value for undefined pi +double array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvd(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsve.x b/pkg/tbtables/fitsio/fitssppb/fsgsve.x new file mode 100644 index 00000000..b65e565f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsve.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsve(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of real values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +real nulval # i value for undefined pi +real array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsve(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvi.x b/pkg/tbtables/fitsio/fitssppb/fsgsvi.x new file mode 100644 index 00000000..37276fd8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvi.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsvi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of Integer*2 values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +short nulval # i value for undefined pi +short array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvi(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgsvj.x b/pkg/tbtables/fitsio/fitssppb/fsgsvj.x new file mode 100644 index 00000000..7c2144f8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgsvj.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fsgsvj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) + +# Read a subsection of integer values from the primary array. + +int iunit # i input file pointer +int colnum # i colnum number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int inc[ARB] # i increment +int nulval # i value for undefined pi +int array[ARB] # o array of values +bool anyflg # o any null values? +int status # o error status + +begin + +call ftgsvj(iunit,colnum,naxis,naxes,fpixel,lpixel,inc, + nulval,array,anyflg,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtbb.x b/pkg/tbtables/fitsio/fitssppb/fsgtbb.x new file mode 100644 index 00000000..423300c3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtbb.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsgtbb(iunit,frow,fchar,nchars,value,status) + +# read a consecutive string of bytes from an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of bytes +int value[ARB] # o data value +int status # o error status + +begin + +call ftgtbb(iunit,frow,fchar,nchars,value,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtbs.x b/pkg/tbtables/fitsio/fitssppb/fsgtbs.x new file mode 100644 index 00000000..63f13469 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtbs.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsgtbs(iunit,frow,fchar,nchars,svalue,status) + +# read a consecutive string of characters from an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of characters +char svalue[ARB] # o string value +% character fsvalu*256 +int status # o error status +int readfirst +int writefirst +int ntodo +int itodo + +begin + +# since the string may be arbitrarily long, read it in pieces +readfirst=fchar +writefirst=1 +ntodo=nchars +itodo=min(256,ntodo) + +while (itodo > 0) { + call ftgtbs(iunit,frow,readfirst,itodo,fsvalu,status) + call fsupk(fsvalu,svalue[writefirst],itodo) + writefirst=writefirst+itodo + readfirst=readfirst+itodo + ntodo=ntodo-itodo + itodo=min(256,ntodo) + } + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtcl.x b/pkg/tbtables/fitsio/fitssppb/fsgtcl.x new file mode 100644 index 00000000..43dcbd8d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtcl.x @@ -0,0 +1,12 @@ +include "fitsio.h" + +procedure fsgtcl(iunit,colnum,tcode,rpeat,wdth,status) + +int iunit,colnum,tcode,rpeat,wdth +int status # o error status + +begin + +call ftgtcl(iunit,colnum,tcode,rpeat,wdth,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtcs.x b/pkg/tbtables/fitsio/fitssppb/fsgtcs.x new file mode 100644 index 00000000..5ef0818e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtcs.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fsgtcs(iunit,xcol,ycol,xrval,yrval,xrpix,yrpix,xinc,yinc, + rot,coord,status) + +int iunit,xcol,ycol +double xrval,yrval,xrpix,yrpix,xinc,yinc,rot +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call ftgtcs(iunit,xcol,ycol,xrval,yrval,xrpix,yrpix,xinc,yinc,rot, + fcoord,status) +call f77upk(fcoord,coord,4) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgtdm.x b/pkg/tbtables/fitsio/fitssppb/fsgtdm.x new file mode 100644 index 00000000..d2482b08 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgtdm.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsgtdm(iunit,colnum,maxdim,naxis,naxes,status) + +# read the TDIMnnn keyword + +int iunit # i input file pointer +int colnum # i column number +int maxdim # i maximum number of dimensions to return +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int status # o error status + +begin + +call ftgtdm(iunit,colnum,maxdim,naxis,naxes,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsgthd.x b/pkg/tbtables/fitsio/fitssppb/fsgthd.x new file mode 100644 index 00000000..c7ff0e71 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsgthd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsgthd(tmplat,card,hdtype,status) + +# 'Get Template HeaDer' +# parse a template header line and create a formated +# 80-character string which is suitable for appending to a FITS header + +char tmplat[ARB] # i template string +% character ftmpla*100 +char card[SZ_FCARD] # o 80-char header record +% character fcard*80 +int hdtype # o hdu type code +int status # o error status + +begin + +call f77pak(tmplat,ftmpla,100) + +call ftgthd(ftmpla,fcard,hdtype,status) + +call f77upk(fcard ,card ,SZ_FCARD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fshdef.x b/pkg/tbtables/fitsio/fitssppb/fshdef.x new file mode 100644 index 00000000..56ceab74 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fshdef.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fshdef(ounit,moreky,status) + +# Header DEFinition +# define the size of the current header unit; this simply lets +# us determine where the data unit will start + +int ounit # i output file pointer +int moreky # i reserve space for this many more keywords +int status # o error status + +begin + +call fthdef(ounit,moreky,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsibin.x b/pkg/tbtables/fitsio/fitssppb/fsibin.x new file mode 100644 index 00000000..ee585149 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsibin.x @@ -0,0 +1,35 @@ +include "fitsio.h" + +procedure fsibin(ounit,nrows,nfield,ttype,tform,tunit, + extnam,pcount,status) + +# insert a binary table extension + +int ounit # i output file pointer +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int pcount # i size of 'heap' +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftibin(ounit,nrows,nfield,fttype,ftform,ftunit, + fextna,pcount,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsicol.x b/pkg/tbtables/fitsio/fitssppb/fsicol.x new file mode 100644 index 00000000..500aeb62 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsicol.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsicol(ounit,colnum,ttype,tform,status) + +# insert column in a table + +int ounit # i output file pointer +int colnum # i column to be inserted +char ttype[SZ_FTTYPE] # i column name +% character*24 ftype +char tform[SZ_FTFORM] # i column data format +% character*16 fform +int status # o error status + +begin + +call f77pak(ttype ,ftype,SZ_FTTYPE) +call f77pak(tform ,fform,SZ_FTFORM) + +call fticol(ounit,colnum,ftype,fform,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsiimg.x b/pkg/tbtables/fitsio/fitssppb/fsiimg.x new file mode 100644 index 00000000..78d224fb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsiimg.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsiimg(ounit,bitpix,naxis,naxes,status) + +# insert an IMAGE extension + +int ounit # i output file pointer +int bitpix # i bits per pixel +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int status # o error status + +begin + +call ftiimg(ounit,bitpix,naxis,naxes,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyd.x b/pkg/tbtables/fitsio/fitssppb/fsikyd.x new file mode 100644 index 00000000..be4af4f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsikyd(ounit,keywrd,dval,decim,comm,status) + +# insert a double precision value to a header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikye.x b/pkg/tbtables/fitsio/fitssppb/fsikye.x new file mode 100644 index 00000000..a43a1a74 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsikye(ounit,keywrd,rval,decim,comm,status) + +# insert a real*4 value to a header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyf.x b/pkg/tbtables/fitsio/fitssppb/fsikyf.x new file mode 100644 index 00000000..5806ae6d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsikyf(ounit,keywrd,rval,decim,comm,status) + +# insert a real*4 value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyg.x b/pkg/tbtables/fitsio/fitssppb/fsikyg.x new file mode 100644 index 00000000..c5d877e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsikyg(ounit,keywrd,dval,decim,comm,status) + +# insert a double precision value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyj.x b/pkg/tbtables/fitsio/fitssppb/fsikyj.x new file mode 100644 index 00000000..cf8e89f7 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsikyj(ounit,keywrd,intval,comm,status) + +# insert an integer value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikyl.x b/pkg/tbtables/fitsio/fitssppb/fsikyl.x new file mode 100644 index 00000000..f63fd370 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsikyl(ounit,keywrd,logval,comm,status) + +# insert a logical value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsikys.x b/pkg/tbtables/fitsio/fitssppb/fsikys.x new file mode 100644 index 00000000..0ad5821e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsikys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsikys(ounit,keywrd,strval,comm,status) + +# insert a character string value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftikys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsinit.x b/pkg/tbtables/fitsio/fitssppb/fsinit.x new file mode 100644 index 00000000..85cd96de --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsinit.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fsinit(funit,fname,block,status) + +# open a new FITS file with write access + +int funit # i file I/O pointer +char fname[ARB] # i file name +% character ffname*255 +int block # i FITS blocking factor +int status # o error status + +begin + +call f77pak(fname ,ffname,255) + +call ftinit(funit,ffname,block,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsirec.x b/pkg/tbtables/fitsio/fitssppb/fsirec.x new file mode 100644 index 00000000..35f0190c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsirec.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fsirec(ounit,keyno,record,status) + +# insert a character string card record to a header + +int ounit # i output file pointer +int keyno # i number of the keyword to insert before +char record[SZ_FCARD] # i 80-char header record +% character frecor*80 +int status # o error status + +begin + +call f77pak(record,frecor,SZ_FCARD) + +call ftirec(ounit,keyno,frecor,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsirow.x b/pkg/tbtables/fitsio/fitssppb/fsirow.x new file mode 100644 index 00000000..7d735c2c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsirow.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsirow(ounit,frow,nrows,status) + +# insert rows in a table + +int ounit # i output file pointer +int frow # insert rows after this row +int nrows # number of rows +int status # o error status + +begin + +call ftirow(ounit,frow,nrows,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsitab.x b/pkg/tbtables/fitsio/fitssppb/fsitab.x new file mode 100644 index 00000000..cf8b852e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsitab.x @@ -0,0 +1,36 @@ +include "fitsio.h" + +procedure fsitab(ounit,ncols,nrows,nfield,ttype,tbcol, + tform,tunit,extnam,status) + +# insert an ASCII table extension + +int ounit # i output file pointer +int ncols # i number of columns +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +int tbcol[ARB] # i starting column position +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftitab(ounit,ncols,nrows,nfield,fttype,tbcol, + ftform,ftunit,fextna,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fskeyn.x b/pkg/tbtables/fitsio/fitssppb/fskeyn.x new file mode 100644 index 00000000..1ce2ff8f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fskeyn.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fskeyn(keywrd,nseq,keyout,status) + +# Make a keyword name by concatinating the root name and a +# sequence number + +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nseq # i keyword sequence no. +char keyout[SZ_FKEYWORD] # o output keyword +% character fkeyou*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftkeyn(fkeywr,nseq,fkeyou,status) + +call f77upk(fkeyou,keyout,SZ_FKEYWORD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmahd.x b/pkg/tbtables/fitsio/fitssppb/fsmahd.x new file mode 100644 index 00000000..61479f04 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmahd.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsmahd(iunit,extno,xtend,status) + +# Move to Absolute Header Data unit +# move the i/o pointer to the specified HDU and initialize all +# the common block parameters which describe the extension + +int iunit # i input file pointer +int extno # i extension number +int xtend # o type of extension +int status # o error status + +begin + +call ftmahd(iunit,extno,xtend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmcom.x b/pkg/tbtables/fitsio/fitssppb/fsmcom.x new file mode 100644 index 00000000..7c762ecd --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmcom.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsmcom(ounit,keywrd,comm,status) + +# modify the comment string in a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char comm[SZ_FLONGCOMM] # i keyword comment +% character fcomm*72 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FLONGCOMM) + +call ftmcom(ounit,fkeywr,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmcrd.x b/pkg/tbtables/fitsio/fitssppb/fsmcrd.x new file mode 100644 index 00000000..a4e3be3f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmcrd.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmcrd(ounit,keywrd,card,status) + +# modify (overwrite) a given header record specified by keyword name. +# This can be used to overwrite the name of the keyword as well as +# the value and comment fields. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char card[SZ_FCARD] # i 80-char header record +% character fcard*80 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(card ,fcard, SZ_FCARD) + +call ftmcrd(ounit,fkeywr,fcard,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyd.x b/pkg/tbtables/fitsio/fitssppb/fsmkyd.x new file mode 100644 index 00000000..3715c59d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsmkyd(ounit,keywrd,dval,decim,comm,status) + +# modify a double precision value header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkye.x b/pkg/tbtables/fitsio/fitssppb/fsmkye.x new file mode 100644 index 00000000..7b6fdeb6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmkye(ounit,keywrd,rval,decim,comm,status) + +# modify a real*4 value header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyf.x b/pkg/tbtables/fitsio/fitssppb/fsmkyf.x new file mode 100644 index 00000000..7b4deb8a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmkyf(ounit,keywrd,rval,decim,comm,status) + +# modify a real*4 value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyg.x b/pkg/tbtables/fitsio/fitssppb/fsmkyg.x new file mode 100644 index 00000000..928e69e1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsmkyg(ounit,keywrd,dval,decim,comm,status) + +# modify a double precision value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyj.x b/pkg/tbtables/fitsio/fitssppb/fsmkyj.x new file mode 100644 index 00000000..66ab5bbe --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsmkyj(ounit,keywrd,intval,comm,status) + +# modify an integer value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkyl.x b/pkg/tbtables/fitsio/fitssppb/fsmkyl.x new file mode 100644 index 00000000..ba902380 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsmkyl(ounit,keywrd,logval,comm,status) + +# modify a logical value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmkys.x b/pkg/tbtables/fitsio/fitssppb/fsmkys.x new file mode 100644 index 00000000..e0417e72 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmkys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsmkys(ounit,keywrd,strval,comm,status) + +# modify a character string value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftmkys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmnam.x b/pkg/tbtables/fitsio/fitssppb/fsmnam.x new file mode 100644 index 00000000..8c7d4e82 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmnam.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsmnam(ounit,oldkey,newkey,status) + +# modify the name of a header keyword + +int ounit # i output file pointer +char oldkey[SZ_FKEYWORD] # i keyword name +% character fokey*8 +char newkey[SZ_FKEYWORD] # i keyword name +% character fnkey*8 +int status # o error status + +begin + +call f77pak(oldkey,fokey,SZ_FKEYWORD) +call f77pak(newkey,fnkey,SZ_FKEYWORD) + +call ftmnam(ounit,fokey,fnkey,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmrec.x b/pkg/tbtables/fitsio/fitssppb/fsmrec.x new file mode 100644 index 00000000..5951427b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmrec.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsmrec(ounit,nkey,record,status) + +# modify the nth keyword in the CHU, by replacing it with the +# input 80 character string. + +int ounit # i output file pointer +int nkey # i number of keyword to be modified +char record[SZ_FCARD] # i 80-char header record +% character frecor*80 +int status # o error status + +begin + +call f77pak(record,frecor,SZ_FCARD) + +call ftmrec(ounit,nkey,frecor,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsmrhd.x b/pkg/tbtables/fitsio/fitssppb/fsmrhd.x new file mode 100644 index 00000000..d253bc5b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsmrhd.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsmrhd(iunit,extmov,xtend,status) + +# Move Relative Header Data unit +# move the i/o pointer to the specified HDU and initialize all +# the common block parameters which describe the extension + +int iunit # i input file pointer +int extmov # i relative extension number +int xtend # o type of extension +int status # o error status + +begin + +call ftmrhd(iunit,extmov,xtend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsnkey.x b/pkg/tbtables/fitsio/fitssppb/fsnkey.x new file mode 100644 index 00000000..92f7d8fb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsnkey.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsnkey(nseq,keywrd,keyout,status) + +# Make a keyword name by concatinating the root name and a +# sequence number + +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nseq # i keyword sequence no. +char keyout[SZ_FKEYWORD] # o output keyword +% character fkeyou*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call ftnkey(nseq,fkeywr,fkeyou,status) + +call f77upk(fkeyou,keyout,SZ_FKEYWORD) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsopen.x b/pkg/tbtables/fitsio/fitssppb/fsopen.x new file mode 100644 index 00000000..c31f832b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsopen.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsopen(funit,fname,rwmode,block,status) + +# open an existing FITS file with readonly or read/write access + +int funit # i file I/O pointer +char fname[ARB] # i file name +% character ffname*255 +int rwmode # i file read/write mode +int block # i FITS blocking factor +int status # o error status + +begin + +call f77pak(fname ,ffname,255) + +call ftopen(funit,ffname,rwmode,block,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2db.x b/pkg/tbtables/fitsio/fitssppb/fsp2db.x new file mode 100644 index 00000000..5f02278c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2db.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2db(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp2db(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2dd.x b/pkg/tbtables/fitsio/fitssppb/fsp2dd.x new file mode 100644 index 00000000..1ae13748 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2dd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2dd(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +double array[ARB] # i array of values +int status # o error status + +begin + +call ftp2dd(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2de.x b/pkg/tbtables/fitsio/fitssppb/fsp2de.x new file mode 100644 index 00000000..3449af47 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2de.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2de(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +real array[ARB] # i array of values +int status # o error status + +begin + +call ftp2de(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2di.x b/pkg/tbtables/fitsio/fitssppb/fsp2di.x new file mode 100644 index 00000000..7678af53 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2di.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2di(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +short array[ARB] # i array of values +int status # o error status + +begin + +call ftp2di(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp2dj.x b/pkg/tbtables/fitsio/fitssppb/fsp2dj.x new file mode 100644 index 00000000..444e4ee4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp2dj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsp2dj(ounit,group,dim1,nx,ny,array,status) + +# Write a 2-d image of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int nx # i size of x axis +int ny # i size of y axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp2dj(ounit,group,dim1,nx,ny,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3db.x b/pkg/tbtables/fitsio/fitssppb/fsp3db.x new file mode 100644 index 00000000..04152f97 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3db.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3db(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp3db(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3dd.x b/pkg/tbtables/fitsio/fitssppb/fsp3dd.x new file mode 100644 index 00000000..35db8e93 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3dd.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3dd(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +double array[ARB] # i array of values +int status # o error status + +begin + +call ftp3dd(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3de.x b/pkg/tbtables/fitsio/fitssppb/fsp3de.x new file mode 100644 index 00000000..806f7b02 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3de.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3de(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +real array[ARB] # i array of values +int status # o error status + +begin + +call ftp3de(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3di.x b/pkg/tbtables/fitsio/fitssppb/fsp3di.x new file mode 100644 index 00000000..9f4ac32c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3di.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3di(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +short array[ARB] # i array of values +int status # o error status + +begin + +call ftp3di(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsp3dj.x b/pkg/tbtables/fitsio/fitssppb/fsp3dj.x new file mode 100644 index 00000000..fc1967e3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsp3dj.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsp3dj(ounit,group,dim1,dim2,nx,ny,nz,array,status) + +# Write a 3-d cube of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int dim1 # i size of 1st dimension +int dim2 # i size of 2nd dimension +int nx # i size of x axis +int ny # i size of y axis +int nz # i size of z axis +int array[ARB] # i array of values +int status # o error status + +begin + +call ftp3dj(ounit,group,dim1,dim2,nx,ny,nz,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcks.x b/pkg/tbtables/fitsio/fitssppb/fspcks.x new file mode 100644 index 00000000..a5b9039a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcks.x @@ -0,0 +1,11 @@ +include "fitsio.h" + +procedure fspcks(iunit,status) + +int iunit +int status # o error status + +begin + +call ftpcks(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclb.x b/pkg/tbtables/fitsio/fitssppb/fspclb.x new file mode 100644 index 00000000..5a994710 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclb.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspclb(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of unsigned byte data values to the +# specified column of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpclb(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclc.x b/pkg/tbtables/fitsio/fitssppb/fspclc.x new file mode 100644 index 00000000..ac198fa3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclc.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspclc(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of single precision complex data values to the +# specified column of the table. +# The binary table column being written to must have datatype 'C' +# and no datatype conversion will be perform if it is not. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpclc(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcld.x b/pkg/tbtables/fitsio/fitssppb/fspcld.x new file mode 100644 index 00000000..21d413fa --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcld.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspcld(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of double precision data values to the specified column +# of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpcld(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcle.x b/pkg/tbtables/fitsio/fitssppb/fspcle.x new file mode 100644 index 00000000..9727c8ea --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcle.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspcle(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of real data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpcle(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcli.x b/pkg/tbtables/fitsio/fitssppb/fspcli.x new file mode 100644 index 00000000..c89d2730 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcli.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspcli(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of integer*2 data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +int status # o error status + +begin + +call ftpcli(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclj.x b/pkg/tbtables/fitsio/fitssppb/fspclj.x new file mode 100644 index 00000000..22e5561c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclj.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspclj(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of integer data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpclj(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcll.x b/pkg/tbtables/fitsio/fitssppb/fspcll.x new file mode 100644 index 00000000..6ade3400 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcll.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcll(ounit,colnum,frow,felem,nelem,lray,status) + +# write an array of logical values to the specified column of the table. +# The binary table column being written to must have datatype 'L' +# and no datatype conversion will be perform if it is not. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +bool lray[ARB] # i logical array +int status # o error status + +begin + +call ftpcll(ounit,colnum,frow,felem,nelem,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclm.x b/pkg/tbtables/fitsio/fitssppb/fspclm.x new file mode 100644 index 00000000..4cdef809 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclm.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspclm(ounit,colnum,frow,felem,nelem,array,status) + +# write an array of double precision complex data values to the +# specified column of the table. +# The binary table column being written to must have datatype 'M' +# and no datatype conversion will be perform if it is not. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpclm(ounit,colnum,frow,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcls.x b/pkg/tbtables/fitsio/fitssppb/fspcls.x new file mode 100644 index 00000000..2d4f4a56 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcls.x @@ -0,0 +1,29 @@ +include "fitsio.h" + +procedure fspcls(ounit,colnum,frow,felem,nelem,sray,dim1,status) + +# write an array of character string values to the specified column of +# the table. +# The binary or ASCII table column being written to must have datatype 'A' + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +char sray[dim1,ARB] # i array of strings +int dim1 # i size of 1st dimension of 2D character string array +% character*256 fsray +int status # o error status +int i +int elem + +begin + +elem=felem +do i=1,nelem { + call f77pak(sray(1,i),fsray,dim1) + call ftpcls(ounit,colnum,frow,elem,1,fsray,status) + elem=elem+1 +} +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclu.x b/pkg/tbtables/fitsio/fitssppb/fspclu.x new file mode 100644 index 00000000..8d341d3c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclu.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fspclu(ounit,colnum,frow,felem,nelem,status) + +# set elements of a table to be undefined + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int status # o error status + +begin + +call ftpclu(ounit,colnum,frow,felem,nelem,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspclx.x b/pkg/tbtables/fitsio/fitssppb/fspclx.x new file mode 100644 index 00000000..140be2b9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspclx.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspclx(iunit,colnum,frow,fbit,nbit,lray,status) + +# write an array of logical values to a specified bit or byte +# column of the binary table. If the LRAY parameter is .true., +# then the corresponding bit is set to 1, otherwise it is set +# to 0. +# The binary table column being written to must have datatype 'B' +# or 'X'. + +int iunit # i input file pointer +int colnum # i column number +int frow # i first row +int fbit # i first bit +int nbit # i number of bits +bool lray[ARB] # i logical array +int status # o error status + +begin + +call ftpclx(iunit,colnum,frow,fbit,nbit,lray,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcnb.x b/pkg/tbtables/fitsio/fitssppb/fspcnb.x new file mode 100644 index 00000000..6e158397 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcnb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcnb(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of unsigned byte data values to the +# specified column of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value representing a null +int status # o error status + +begin + +call ftpcnb(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcnd.x b/pkg/tbtables/fitsio/fitssppb/fspcnd.x new file mode 100644 index 00000000..6fc182be --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcnd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcnd(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of double precision data values to the specified column +# of the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +double nulval # d value representing a null +int status # o error status + +begin + +call ftpcnd(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcne.x b/pkg/tbtables/fitsio/fitssppb/fspcne.x new file mode 100644 index 00000000..413ab23a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcne.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcne(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of real data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # r array of values +real nulval # r value representing a null +int status # o error status + +begin + +call ftpcne(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcni.x b/pkg/tbtables/fitsio/fitssppb/fspcni.x new file mode 100644 index 00000000..1c4bc5bc --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcni.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcni(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of integer*2 data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +short nulval # i value representing a null +int status # o error status + +begin + +call ftpcni(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcnj.x b/pkg/tbtables/fitsio/fitssppb/fspcnj.x new file mode 100644 index 00000000..a64b8e9e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcnj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspcnj(ounit,colnum,frow,felem,nelem,array,nulval,status) + +# write an array of integer data values to the specified column of +# the table. + +int ounit # i output file pointer +int colnum # i column number +int frow # i first row +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value representing a null +int status # o error status + +begin + +call ftpcnj(ounit,colnum,frow,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspcom.x b/pkg/tbtables/fitsio/fitssppb/fspcom.x new file mode 100644 index 00000000..9e9f2f14 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspcom.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fspcom(ounit,commnt,status) + +# write a COMMENT record to the FITS header + +int ounit # i output file pointer +char commnt[SZ_FLONGCOMM] # i comment keyword +% character fcommn*72 +int status # o error status + +begin + +call f77pak(commnt,fcommn,SZ_FLONGCOMM) + +call ftpcom(ounit,fcommn,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspdat.x b/pkg/tbtables/fitsio/fitssppb/fspdat.x new file mode 100644 index 00000000..bfddbe94 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspdat.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fspdat(ounit,status) + +# write the current date to the DATE keyword in the ounit CHU + +int ounit # i output file pointer +int status # o error status + +begin + +call ftpdat(ounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspdef.x b/pkg/tbtables/fitsio/fitssppb/fspdef.x new file mode 100644 index 00000000..f9368e99 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspdef.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspdef(ounit,bitpix,naxis,naxes,pcount,gcount,status) + +# Primary data DEFinition +# define the structure of the primary data unit or an IMAGE extension + +int ounit # i output file pointer +int bitpix # i bits per pixel +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int pcount # i number of group parame +int gcount # i number of groups +int status # o error status + +begin + +call ftpdef(ounit,bitpix,naxis,naxes,pcount,gcount,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspdes.x b/pkg/tbtables/fitsio/fitssppb/fspdes.x new file mode 100644 index 00000000..ca1561f1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspdes.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fspdes(ounit,colnum,rownum,nelem,offset,status) + +# write the descriptor values to a binary table. This is only +# used for column which have TFORMn = 'P', i.e., for variable +# length arrays. + +int ounit # i output file pointer +int colnum # i column number +int rownum # i row number +int nelem # i number of elements +int offset # i offset +int status # o error status + +begin + +call ftpdes(ounit,colnum,rownum,nelem,offset,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpb.x b/pkg/tbtables/fitsio/fitssppb/fspgpb.x new file mode 100644 index 00000000..ee9ae600 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpb(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpb(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpd.x b/pkg/tbtables/fitsio/fitssppb/fspgpd.x new file mode 100644 index 00000000..d7b53ef2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpd(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpd(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpe.x b/pkg/tbtables/fitsio/fitssppb/fspgpe.x new file mode 100644 index 00000000..ff117afe --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpe.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpe(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpe(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpi.x b/pkg/tbtables/fitsio/fitssppb/fspgpi.x new file mode 100644 index 00000000..455ec26d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpi.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpi(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +short array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpi(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspgpj.x b/pkg/tbtables/fitsio/fitssppb/fspgpj.x new file mode 100644 index 00000000..3f3cbd66 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspgpj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspgpj(ounit,group,fparm,nparm,array,status) + +# Write an array of group parmeters into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int fparm # i first parameter +int nparm # i number of parameters +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpgpj(ounit,group,fparm,nparm,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphbn.x b/pkg/tbtables/fitsio/fitssppb/fsphbn.x new file mode 100644 index 00000000..d9e8af02 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphbn.x @@ -0,0 +1,35 @@ +include "fitsio.h" + +procedure fsphbn(ounit,nrows,nfield,ttype,tform,tunit, + extnam,pcount,status) + +# write required standard header keywords for a binary table extension + +int ounit # i output file pointer +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int pcount # i size of 'heap' +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftphbn(ounit,nrows,nfield,fttype,ftform,ftunit, + fextna,pcount,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphis.x b/pkg/tbtables/fitsio/fitssppb/fsphis.x new file mode 100644 index 00000000..a83669ed --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphis.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsphis(ounit,histry,status) + +# write a HISTORY record to the FITS header + +int ounit # i output file pointer +char histry[SZ_FLONGCOMM] # i history keyword +% character fhistr*72 +int status # o error status + +begin + +call f77pak(histry,fhistr,SZ_FLONGCOMM) + +call ftphis(ounit,fhistr,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphpr.x b/pkg/tbtables/fitsio/fitssppb/fsphpr.x new file mode 100644 index 00000000..28977af1 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphpr.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsphpr(ounit,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) + +# write required primary header keywords + +int ounit # i output file pointer +bool simple # i simple FITS file? +int bitpix # i bits per pixel +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int pcount # i no. of group parameters +int gcount # i no. of groups +bool extend # i EXTEND keyword = TRUE? +int status # o error status + +begin + +call ftphpr(ounit,simple,bitpix,naxis,naxes, + pcount,gcount,extend,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsphtb.x b/pkg/tbtables/fitsio/fitssppb/fsphtb.x new file mode 100644 index 00000000..b7bcf953 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsphtb.x @@ -0,0 +1,36 @@ +include "fitsio.h" + +procedure fsphtb(ounit,ncols,nrows,nfield,ttype,tbcol, + tform,tunit,extnam,status) + +# write required standard header keywords for an ASCII table extension + +int ounit # i output file pointer +int ncols # i number of columns +int nrows # i number of rows +int nfield # i number of fields +char ttype[SZ_FTTYPE,ARB] # i column name +% character*24 fttype(512) +int tbcol[ARB] # i starting column position +char tform[SZ_FTFORM,ARB] # i column data format +% character*16 ftform(512) +char tunit[SZ_FTUNIT,ARB] # i column units +% character*24 ftunit(512) +char extnam[SZ_FEXTNAME] # i extension name +% character fextna*24 +int status # o error status +int i + +begin + +do i = 1, nfield + { call f77pak(ttype(1,i) ,fttype(i),SZ_FTTYPE) + call f77pak(tform(1,i) ,ftform(i),SZ_FTFORM) + call f77pak(tunit(1,i) ,ftunit(i),SZ_FTUNIT) + } + +call f77pak(extnam ,fextna,SZ_FEXTNAME) + +call ftphtb(ounit,ncols,nrows,nfield,fttype,tbcol, + ftform,ftunit,fextna,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkls.x b/pkg/tbtables/fitsio/fitssppb/fspkls.x new file mode 100644 index 00000000..f16108cb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkls.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspkls(ounit,keywrd,strval,comm,status) + +# write a character string value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkls(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknd.x b/pkg/tbtables/fitsio/fitssppb/fspknd.x new file mode 100644 index 00000000..c5b384f5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknd.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspknd(ounit,keywrd,nstart,nkey,dval,decim,comm,status) + +# write an array of real*8 values to header records in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknd(ounit,fkeywr,nstart,nkey,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkne.x b/pkg/tbtables/fitsio/fitssppb/fspkne.x new file mode 100644 index 00000000..45a9c4dc --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkne.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspkne(ounit,keywrd,nstart,nkey,rval,decim,comm,status) + +# write an array of real*4 values to header records in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpkne(ounit,fkeywr,nstart,nkey,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknf.x b/pkg/tbtables/fitsio/fitssppb/fspknf.x new file mode 100644 index 00000000..8579d358 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknf.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspknf(ounit,keywrd,nstart,nkey,rval,decim,comm,status) + +# write an array of real*4 values to header records in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknf(ounit,fkeywr,nstart,nkey,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkng.x b/pkg/tbtables/fitsio/fitssppb/fspkng.x new file mode 100644 index 00000000..d4225e4d --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkng.x @@ -0,0 +1,27 @@ +include "fitsio.h" + +procedure fspkng(ounit,keywrd,nstart,nkey,dval,decim,comm,status) + +# write an array of real*8 values to header records in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpkng(ounit,fkeywr,nstart,nkey,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknj.x b/pkg/tbtables/fitsio/fitssppb/fspknj.x new file mode 100644 index 00000000..8d303f1a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknj.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fspknj(ounit,keywrd,nstart,nkey,intval,comm,status) + +# write an array of integer values to header records + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknj(ounit,fkeywr,nstart,nkey,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspknl.x b/pkg/tbtables/fitsio/fitssppb/fspknl.x new file mode 100644 index 00000000..89a9c569 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspknl.x @@ -0,0 +1,26 @@ +include "fitsio.h" + +procedure fspknl(ounit,keywrd,nstart,nkey,logval,comm,status) + +# write an array of logical values to header records + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +bool logval[ARB] # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +call ftpknl(ounit,fkeywr,nstart,nkey,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkns.x b/pkg/tbtables/fitsio/fitssppb/fspkns.x new file mode 100644 index 00000000..1ac5b007 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkns.x @@ -0,0 +1,34 @@ +include "fitsio.h" + +procedure fspkns(ounit,keywrd,nstart,nkey,strval,comm,status) + +# write an array of character string values to header records + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int nstart # i first sequence number +int nkey # i number of keywords +char strval[SZ_FSTRVAL,ARB] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status +int i +int n1 + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) +# only support a single comment string for all the keywords in the SPP version +% fcomm(48:48)='&' + +n1=nstart +do i=1,nkey { + call f77pak(strval(1,i),fstrva,SZ_FSTRVAL) + call ftpkns(ounit,fkeywr,n1,1,fstrva,fcomm,status) + n1=n1+1 + } + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyd.x b/pkg/tbtables/fitsio/fitssppb/fspkyd.x new file mode 100644 index 00000000..6169674b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fspkyd(ounit,keywrd,dval,decim,comm,status) + +# write a double precision value to a header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkye.x b/pkg/tbtables/fitsio/fitssppb/fspkye.x new file mode 100644 index 00000000..395e6b6f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fspkye(ounit,keywrd,rval,decim,comm,status) + +# write a real*4 value to a header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyf.x b/pkg/tbtables/fitsio/fitssppb/fspkyf.x new file mode 100644 index 00000000..9ef7d359 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fspkyf(ounit,keywrd,rval,decim,comm,status) + +# write a real*4 value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyg.x b/pkg/tbtables/fitsio/fitssppb/fspkyg.x new file mode 100644 index 00000000..a9faccec --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fspkyg(ounit,keywrd,dval,decim,comm,status) + +# write a double precision value to a header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyj.x b/pkg/tbtables/fitsio/fitssppb/fspkyj.x new file mode 100644 index 00000000..8cbc90e5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspkyj(ounit,keywrd,intval,comm,status) + +# write an integer value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyl.x b/pkg/tbtables/fitsio/fitssppb/fspkyl.x new file mode 100644 index 00000000..69f57797 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fspkyl(ounit,keywrd,logval,comm,status) + +# write a logical value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkys.x b/pkg/tbtables/fitsio/fitssppb/fspkys.x new file mode 100644 index 00000000..6d2b45c5 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspkys(ounit,keywrd,strval,comm,status) + +# write a character string value to a header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspkyt.x b/pkg/tbtables/fitsio/fitssppb/fspkyt.x new file mode 100644 index 00000000..d78bad96 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspkyt.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspkyt(iunit,keywrd,intval,dval,comm,status) + +# concatinate a integer value with a double precision fraction +# and write it to the FITS header along with the comment string +# The value will be displayed in F28.16 format + +int iunit # i input file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +double dval # i real*8 value +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftpkyt(iunit,fkeywr,intval,dval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsplsw.x b/pkg/tbtables/fitsio/fitssppb/fsplsw.x new file mode 100644 index 00000000..d8d12137 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsplsw.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsplsw(iunit,status) + +# write keywords to warn users that longstring convention may be used + +int iunit # i input file pointer +int status # o error status + +begin + +call ftplsw(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspmsg.x b/pkg/tbtables/fitsio/fitssppb/fspmsg.x new file mode 100644 index 00000000..ec9f66ae --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspmsg.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fspmsg(text) + +# write a 80 character record to the FITSIO error stack + +char text[SZ_FCARD] # i 80-char message +% character ftext*80 + +begin + +call f77pak(text,ftext,SZ_FCARD) + +call ftpmsg(ftext) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspnul.x b/pkg/tbtables/fitsio/fitssppb/fspnul.x new file mode 100644 index 00000000..56cb31b3 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspnul.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fspnul(ounit,blank,status) + +# Primary Null value definition +# Define the null value for an integer primary array. +# This must be the first HDU of the FITS file. + +int ounit # i output file pointer +int blank # i value used to represent undefined values +int status # o error status + +begin + +call ftpnul(ounit,blank,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppnb.x b/pkg/tbtables/fitsio/fitssppb/fsppnb.x new file mode 100644 index 00000000..45d09699 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppnb.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppnb(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value used for null pixels +int status # o error status + +begin + +call ftppnb(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppnd.x b/pkg/tbtables/fitsio/fitssppb/fsppnd.x new file mode 100644 index 00000000..4f808aa8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppnd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppnd(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +double nulval # d value used for null pixels +int status # o error status + +begin + +call ftppnd(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppne.x b/pkg/tbtables/fitsio/fitssppb/fsppne.x new file mode 100644 index 00000000..6279e59f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppne.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppne(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # r array of values +real nulval # r value used for null pixels +int status # o error status + +begin + +call ftppne(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppni.x b/pkg/tbtables/fitsio/fitssppb/fsppni.x new file mode 100644 index 00000000..dca6f308 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppni.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppni(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +short nulval # i value used for null pixels +int status # o error status + +begin + +call ftppni(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppnj.x b/pkg/tbtables/fitsio/fitssppb/fsppnj.x new file mode 100644 index 00000000..4ec4b718 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppnj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsppnj(ounit,group,felem,nelem,array,nulval,status) + +# Write an array of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int nulval # i value used for null pixels +int status # o error status + +begin + +call ftppnj(ounit,group,felem,nelem,array,nulval,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspprb.x b/pkg/tbtables/fitsio/fitssppb/fspprb.x new file mode 100644 index 00000000..6a9bf554 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspprb.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspprb(ounit,group,felem,nelem,array,status) + +# Write an array of byte values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpprb(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspprd.x b/pkg/tbtables/fitsio/fitssppb/fspprd.x new file mode 100644 index 00000000..d5cd4565 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspprd.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspprd(ounit,group,felem,nelem,array,status) + +# Write an array of r*8 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpprd(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppre.x b/pkg/tbtables/fitsio/fitssppb/fsppre.x new file mode 100644 index 00000000..fa9b2853 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppre.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsppre(ounit,group,felem,nelem,array,status) + +# Write an array of r*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +real array[ARB] # i array of values +int status # o error status + +begin + +call ftppre(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppri.x b/pkg/tbtables/fitsio/fitssppb/fsppri.x new file mode 100644 index 00000000..ab6afd59 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppri.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fsppri(ounit,group,felem,nelem,array,status) + +# Write an array of i*2 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +short array[ARB] # i array of values +int status # o error status + +begin + +call ftppri(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspprj.x b/pkg/tbtables/fitsio/fitssppb/fspprj.x new file mode 100644 index 00000000..b9d86710 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspprj.x @@ -0,0 +1,20 @@ +include "fitsio.h" + +procedure fspprj(ounit,group,felem,nelem,array,status) + +# Write an array of i*4 values into the primary array. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being written). + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpprj(ounit,group,felem,nelem,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsppru.x b/pkg/tbtables/fitsio/fitssppb/fsppru.x new file mode 100644 index 00000000..eedd82bd --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsppru.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsppru(ounit,group,felem,nelem,status) + +# set elements of the primary array equal to the undefined value + +int ounit # i output file pointer +int group # i group number +int felem # i first element in row +int nelem # i number of elements +int status # o error status + +begin + +call ftppru(ounit,group,felem,nelem,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsprec.x b/pkg/tbtables/fitsio/fitssppb/fsprec.x new file mode 100644 index 00000000..ee91cead --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsprec.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsprec(ounit,record,status) + +# write a 80 character record to the FITS header + +int ounit # i output file pointer +char record[SZ_FCARD] # i 80-char header record +% character frecor*80 +int status # o error status + +begin + +call f77pak(record,frecor,SZ_FCARD) + +call ftprec(ounit,frecor,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspscl.x b/pkg/tbtables/fitsio/fitssppb/fspscl.x new file mode 100644 index 00000000..df7d8233 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspscl.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fspscl(ounit,bscale,bzero,status) + +# Primary SCaLing factor definition +# Define the scaling factor for the primary header data. +# This must be the first HDU of the FITS file. + +int ounit # i output file pointer +double bscale # i scaling factor +double bzero # i scaling zeropoint +int status # o error status + +begin + +call ftpscl(ounit,bscale,bzero,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssb.x b/pkg/tbtables/fitsio/fitssppb/fspssb.x new file mode 100644 index 00000000..3a26ef08 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssb.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssb(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of byte values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpssb(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssd.x b/pkg/tbtables/fitsio/fitssppb/fspssd.x new file mode 100644 index 00000000..0960c17f --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssd.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssd(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of double precision values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +double array[ARB] # i array of values +int status # o error status + +begin + +call ftpssd(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspsse.x b/pkg/tbtables/fitsio/fitssppb/fspsse.x new file mode 100644 index 00000000..ffe42b34 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspsse.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspsse(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of real values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +real array[ARB] # i array of values +int status # o error status + +begin + +call ftpsse(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssi.x b/pkg/tbtables/fitsio/fitssppb/fspssi.x new file mode 100644 index 00000000..10612a9a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssi.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssi(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of integer*2 values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +short array[ARB] # i array of values +int status # o error status + +begin + +call ftpssi(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspssj.x b/pkg/tbtables/fitsio/fitssppb/fspssj.x new file mode 100644 index 00000000..46c7770e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspssj.x @@ -0,0 +1,24 @@ +include "fitsio.h" + +procedure fspssj(iunit,group,naxis,naxes,fpixel,lpixel,array,status) + +# Write a subsection of integer values to the primary array. +# A subsection is defined to be any contiguous rectangular +# array of pixels within the n-dimensional FITS data file. +# Data conversion and scaling will be performed if necessary +# (e.g, if the datatype of the FITS array is not the same +# as the array being read). + +int iunit # i input file pointer +int group # i group number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int fpixel[ARB] # i first pixel +int lpixel[ARB] # i last pixel +int array[ARB] # i array of values +int status # o error status + +begin + +call ftpssj(iunit,group,naxis,naxes,fpixel,lpixel,array,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspsvc.x b/pkg/tbtables/fitsio/fitssppb/fspsvc.x new file mode 100644 index 00000000..2c6ac3eb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspsvc.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fspsvc(keyrec,value,comm,status) + +# parse the header record to find value and comment strings + +char keyrec[SZ_FCARD] # i header keyword string +% character fkeyre*80 +char value[SZ_FSTRVAL] # o data value +% character fvalue*70 +char comm[SZ_FCOMMENT] # o keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keyrec,fkeyre,SZ_FCARD) + +call ftpsvc(fkeyre,fvalue,fcomm,status) + +call f77upk(fvalue ,value,SZ_FSTRVAL) +call f77upk(fcomm ,comm ,SZ_FCOMMENT) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsptbb.x b/pkg/tbtables/fitsio/fitssppb/fsptbb.x new file mode 100644 index 00000000..1f424db2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsptbb.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fsptbb(iunit,frow,fchar,nchars,value,status) + +# write a consecutive string of bytes to an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of bytes +int value[ARB] # i data value +int status # o error status + +begin + +call ftptbb(iunit,frow,fchar,nchars,value,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsptbs.x b/pkg/tbtables/fitsio/fitssppb/fsptbs.x new file mode 100644 index 00000000..c1c52b40 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsptbs.x @@ -0,0 +1,38 @@ +include "fitsio.h" + +procedure fsptbs(iunit,frow,fchar,nchars,svalue,status) + +# write a consecutive string of characters to an ascii or binary +# table. This will span multiple rows of the table if NCHARS+FCHAR is +# greater than the length of a row. + +int iunit # i input file pointer +int frow # i first row +int fchar # i first character +int nchars # i number of characters +char svalue[ARB] # i string value +% character fsvalu*256 +int status # o error status +int readfirst +int writefirst +int ntodo +int itodo + +begin + +# since the string may be arbitrarily long, write it in pieces +readfirst=1 +writefirst=fchar +ntodo=nchars +itodo=min(256,ntodo) + +while (itodo > 0) { + call f77pak(svalue[readfirst],fsvalu,itodo) + call ftptbs(iunit,frow,writefirst,itodo,fsvalu,status) + writefirst=writefirst+itodo + readfirst=readfirst+itodo + ntodo=ntodo-itodo + itodo=min(256,ntodo) + } + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsptdm.x b/pkg/tbtables/fitsio/fitssppb/fsptdm.x new file mode 100644 index 00000000..32f96fca --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsptdm.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fsptdm(ounit,colnum,naxis,naxes,status) + +# write the TDIMnnn keyword + +int ounit # i output file pointer +int colnum # i column number +int naxis # i number of axes +int naxes[ARB] # i dimension of each axis +int status # o error status + +begin + +call ftptdm(ounit,colnum,naxis,naxes,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fspthp.x b/pkg/tbtables/fitsio/fitssppb/fspthp.x new file mode 100644 index 00000000..1c11c2e9 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fspthp.x @@ -0,0 +1,18 @@ +include "fitsio.h" + +procedure fspthp(ounit,heap,status) + +# Define the starting address for the heap for a binary table. +# The default address is NAXIS1 * NAXIS2. It is in units of +# bytes relative to the beginning of the regular binary table data. +# This routine also writes the appropriate THEAP keyword to the +# FITS header. + +int ounit # i output file pointer +int heap # i heap starting address +int status # o error status + +begin + +call ftpthp(ounit,heap,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsrdef.x b/pkg/tbtables/fitsio/fitssppb/fsrdef.x new file mode 100644 index 00000000..afa92419 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsrdef.x @@ -0,0 +1,15 @@ +include "fitsio.h" + +procedure fsrdef(ounit,status) + +# Data DEFinition +# re-define the length of the data unit +# this simply redefines the start of the next HDU + +int ounit # i output file pointer +int status # o error status + +begin + +call ftrdef(ounit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fssnul.x b/pkg/tbtables/fitsio/fitssppb/fssnul.x new file mode 100644 index 00000000..6a11962b --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fssnul.x @@ -0,0 +1,19 @@ +include "fitsio.h" + +procedure fssnul(ounit,colnum,nulval,status) + +# ascii table Column NULl value definition +# Define the null value for an ASCII table column. + +int ounit # i output file pointer +int colnum # i column number +char nulval # i value for undefined pixels +% character*16 fnulva +int status # o error status + +begin + +call f77pak(nulval,fnulva,16) + +call ftsnul(ounit,colnum,fnulva,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fstkey.x b/pkg/tbtables/fitsio/fitssppb/fstkey.x new file mode 100644 index 00000000..0b98485e --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fstkey.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fstkey(keywrd,status) + +# test that keyword name contains only legal characters: +# uppercase letters, numbers, hyphen, underscore, or space + +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) + +call fttkey(fkeywr,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fstnul.x b/pkg/tbtables/fitsio/fitssppb/fstnul.x new file mode 100644 index 00000000..1c8997b4 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fstnul.x @@ -0,0 +1,16 @@ +include "fitsio.h" + +procedure fstnul(ounit,colnum,inull,status) + +# Table column NULl value definition +# Define the null value for an integer binary table column + +int ounit # i output file pointer +int colnum # i column number +int inull # integer null value +int status # o error status + +begin + +call fttnul(ounit,colnum,inull,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fstscl.x b/pkg/tbtables/fitsio/fitssppb/fstscl.x new file mode 100644 index 00000000..09d86cb2 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fstscl.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fstscl(ounit,colnum,bscale,bzero,status) + +# Table column SCaLing factor definition +# Define the scaling factor for a table column. + +int ounit # i output file pointer +int colnum # i column number +double bscale # i scaling factor +double bzero # i scaling zeropoint +int status # o error status + +begin + +call fttscl(ounit,colnum,bscale,bzero,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsucks.x b/pkg/tbtables/fitsio/fitssppb/fsucks.x new file mode 100644 index 00000000..d024f2d8 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsucks.x @@ -0,0 +1,11 @@ +include "fitsio.h" + +procedure fsucks(iunit,status) + +int iunit +int status # o error status + +begin + +call ftucks(iunit,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsucrd.x b/pkg/tbtables/fitsio/fitssppb/fsucrd.x new file mode 100644 index 00000000..70c0a609 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsucrd.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsucrd(ounit,keywrd,card,status) + +# update a given header record specified by keyword name. +# new record is appended to header if it doesn't exist. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char card[SZ_FCARD] # i 80-char header record +% character fcard*80 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(card ,fcard, SZ_FCARD) + +call ftucrd(ounit,fkeywr,fcard,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyd.x b/pkg/tbtables/fitsio/fitssppb/fsukyd.x new file mode 100644 index 00000000..1de99474 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyd.x @@ -0,0 +1,25 @@ +include "fitsio.h" + +procedure fsukyd(ounit,keywrd,dval,decim,comm,status) + +# update a double precision value header record in E format +# If it will fit, the value field will be 20 characters wide; +# otherwise it will be expanded to up to 35 characters, left +# justified. + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyd(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukye.x b/pkg/tbtables/fitsio/fitssppb/fsukye.x new file mode 100644 index 00000000..31668640 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukye.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsukye(ounit,keywrd,rval,decim,comm,status) + +# update a real*4 value header record in E format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukye(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyf.x b/pkg/tbtables/fitsio/fitssppb/fsukyf.x new file mode 100644 index 00000000..6c8fa1eb --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyf.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsukyf(ounit,keywrd,rval,decim,comm,status) + +# update a real*4 value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +real rval # i real*4 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyf(ounit,fkeywr,rval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyg.x b/pkg/tbtables/fitsio/fitssppb/fsukyg.x new file mode 100644 index 00000000..8922299a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyg.x @@ -0,0 +1,22 @@ +include "fitsio.h" + +procedure fsukyg(ounit,keywrd,dval,decim,comm,status) + +# update a double precision value header record in F format + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +double dval # i real*8 value +int decim # i number of decimal plac +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyg(ounit,fkeywr,dval,decim,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyj.x b/pkg/tbtables/fitsio/fitssppb/fsukyj.x new file mode 100644 index 00000000..2a639547 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyj.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsukyj(ounit,keywrd,intval,comm,status) + +# update an integer value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +int intval # i integer value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyj(ounit,fkeywr,intval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukyl.x b/pkg/tbtables/fitsio/fitssppb/fsukyl.x new file mode 100644 index 00000000..4f32127c --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukyl.x @@ -0,0 +1,21 @@ +include "fitsio.h" + +procedure fsukyl(ounit,keywrd,logval,comm,status) + +# update a logical value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +bool logval # i logical value +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukyl(ounit,fkeywr,logval,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsukys.x b/pkg/tbtables/fitsio/fitssppb/fsukys.x new file mode 100644 index 00000000..71ba3696 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsukys.x @@ -0,0 +1,23 @@ +include "fitsio.h" + +procedure fsukys(ounit,keywrd,strval,comm,status) + +# update a character string value header record + +int ounit # i output file pointer +char keywrd[SZ_FKEYWORD] # i keyword name +% character fkeywr*8 +char strval[SZ_FSTRVAL] # i string value +% character fstrva*70 +char comm[SZ_FCOMMENT] # i keyword comment +% character fcomm*48 +int status # o error status + +begin + +call f77pak(keywrd,fkeywr,SZ_FKEYWORD) +call f77pak(strval,fstrva,SZ_FSTRVAL) +call f77pak(comm ,fcomm ,SZ_FCOMMENT) + +call ftukys(ounit,fkeywr,fstrva,fcomm,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsvcks.x b/pkg/tbtables/fitsio/fitssppb/fsvcks.x new file mode 100644 index 00000000..17149c03 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsvcks.x @@ -0,0 +1,13 @@ +include "fitsio.h" + +procedure fsvcks(iunit,dataok,hduok,status) + +int iunit +int dataok +int hduok +int status # o error status + +begin + +call ftvcks(iunit,dataok,hduok,status) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsvers.x b/pkg/tbtables/fitsio/fitssppb/fsvers.x new file mode 100644 index 00000000..09f1a8e6 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsvers.x @@ -0,0 +1,14 @@ +include "fitsio.h" + +procedure fsvers(vernum) + +# Returns the current revision number of the FITSIO package. +# The revision number will be incremented whenever any modifications, +# bug fixes, or enhancements are made to the package + +real vernum # o FITSIO version number + +begin + +call ftvers(vernum) +end diff --git a/pkg/tbtables/fitsio/fitssppb/fswldp.x b/pkg/tbtables/fitsio/fitssppb/fswldp.x new file mode 100644 index 00000000..006b0480 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fswldp.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fswldp(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coord, + xpos,ypos,status) + +double xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,xpos,ypos +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call f77pak(coord,fcoord,4) +call ftwldp(xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,fcoord, + xpos,ypos,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/fsxypx.x b/pkg/tbtables/fitsio/fitssppb/fsxypx.x new file mode 100644 index 00000000..a6343d0a --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/fsxypx.x @@ -0,0 +1,17 @@ +include "fitsio.h" + +procedure fsxypx(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,coord, + xpix,ypix,status) + +double xpix,ypix,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,xpos,ypos +char coord[4] +% character fcoord*4 +int status # o error status + +begin + +call f77pak(coord,fcoord,4) +call ftxypx(xpos,ypos,xrval,yrval,xrpix,yrpix,xinc,yinc,rot,fcoord, + xpix,ypix,status) + +end diff --git a/pkg/tbtables/fitsio/fitssppb/mkpkg b/pkg/tbtables/fitsio/fitssppb/mkpkg new file mode 100644 index 00000000..0b527127 --- /dev/null +++ b/pkg/tbtables/fitsio/fitssppb/mkpkg @@ -0,0 +1,262 @@ +# FITSIO -- This IRAF mkpkg file updates the TBTABLES library to include +# the FITSIO interface. + +tbtables: +$checkout libtbtables.a ../ +$update libtbtables.a +$checkin libtbtables.a ../ +$exit + +libtbtables.a: + fsadef.x + fsarch.x + fsasfm.x + fsbdef.x + fsbnfm.x + fsclos.x + fscmps.x + fscmsg.x + fscopy.x + fscpdt.x + fscrhd.x + fsdcol.x + fsddef.x + fsdelt.x + fsdhdu.x + fsdkey.x + fsdrec.x + fsdrow.x + fsdsum.x + fsdtyp.x + fsesum.x + fsfiou.x + fsg2db.x + fsg2dd.x + fsg2de.x + fsg2di.x + fsg2dj.x + fsg3db.x + fsg3dd.x + fsg3de.x + fsg3di.x + fsg3dj.x + fsgabc.x + fsgacl.x + fsgbcl.x + fsgcfb.x + fsgcfc.x + fsgcfd.x + fsgcfe.x + fsgcfi.x + fsgcfj.x + fsgcfl.x + fsgcfm.x + fsgcfs.x + fsgcks.x + fsgcl.x + fsgcnn.x + fsgcno.x + fsgcrd.x + fsgcvb.x + fsgcvc.x + fsgcvd.x + fsgcve.x + fsgcvi.x + fsgcvj.x + fsgcvm.x + fsgcvs.x + fsgcx.x + fsgcxd.x + fsgcxi.x + fsgcxj.x + fsgdes.x + fsgerr.x + fsggpb.x + fsggpd.x + fsggpe.x + fsggpi.x + fsggpj.x + fsghad.x + fsghbn.x + fsghdn.x + fsghpr.x + fsghps.x + fsghsp.x + fsghtb.x + fsgics.x + fsgiou.x + fsgkey.x + fsgknd.x + fsgkne.x + fsgknj.x + fsgknl.x + fsgkns.x + fsgkyd.x + fsgkye.x + fsgkyj.x + fsgkyl.x + fsgkyn.x + fsgkys.x + fsgkyt.x + fsgmsg.x + fsgpfb.x + fsgpfd.x + fsgpfe.x + fsgpfi.x + fsgpfj.x + fsgpvb.x + fsgpvd.x + fsgpve.x + fsgpvi.x + fsgpvj.x + fsgrec.x + fsgrsz.x + fsgsdt.x + fsgsfb.x + fsgsfd.x + fsgsfe.x + fsgsfi.x + fsgsfj.x + fsgsvb.x + fsgsvd.x + fsgsve.x + fsgsvi.x + fsgsvj.x + fsgtbb.x + fsgtbs.x + fsgtcl.x + fsgtcs.x + fsgtdm.x + fsgthd.x + fshdef.x + fsibin.x + fsicol.x + fsiimg.x + fsikyd.x + fsikye.x + fsikyf.x + fsikyg.x + fsikyj.x + fsikyl.x + fsikys.x + fsinit.x + fsirec.x + fsirow.x + fsitab.x + fskeyn.x + fsmahd.x + fsmcom.x + fsmcrd.x + fsmkyd.x + fsmkye.x + fsmkyf.x + fsmkyg.x + fsmkyj.x + fsmkyl.x + fsmkys.x + fsmnam.x + fsmrec.x + fsmrhd.x + fsnkey.x + fsopen.x + fsp2db.x + fsp2dd.x + fsp2de.x + fsp2di.x + fsp2dj.x + fsp3db.x + fsp3dd.x + fsp3de.x + fsp3di.x + fsp3dj.x + fspcks.x + fspclb.x + fspclc.x + fspcld.x + fspcle.x + fspcli.x + fspclj.x + fspcll.x + fspclm.x + fspcls.x + fspclu.x + fspclx.x + fspcnb.x + fspcnd.x + fspcne.x + fspcni.x + fspcnj.x + fspcom.x + fspdat.x + fspdef.x + fspdes.x + fspgpb.x + fspgpd.x + fspgpe.x + fspgpi.x + fspgpj.x + fsphbn.x + fsphis.x + fsphpr.x + fsphtb.x + fspkls.x + fspknd.x + fspkne.x + fspknf.x + fspkng.x + fspknj.x + fspknl.x + fspkns.x + fspkyd.x + fspkye.x + fspkyf.x + fspkyg.x + fspkyj.x + fspkyl.x + fspkys.x + fspkyt.x + fsplsw.x + fspmsg.x + fspnul.x + fsppnb.x + fsppnd.x + fsppne.x + fsppni.x + fsppnj.x + fspprb.x + fspprd.x + fsppre.x + fsppri.x + fspprj.x + fsppru.x + fsprec.x + fspscl.x + fspssb.x + fspssd.x + fspsse.x + fspssi.x + fspssj.x + fspsvc.x + fsptbb.x + fsptbs.x + fsptdm.x + fspthp.x + fsrdef.x + fssnul.x + fstkey.x + fstnul.x + fstscl.x + fsucks.x + fsucrd.x + fsukyd.x + fsukye.x + fsukyf.x + fsukyg.x + fsukyj.x + fsukyl.x + fsukys.x + fsvcks.x + fsvers.x + fswldp.x + fsxypx.x + ; |