aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/cfitsio/f77_wrap2.c
diff options
context:
space:
mode:
authorJoe Hunkeler <jhunkeler@gmail.com>2015-08-11 16:51:37 -0400
committerJoe Hunkeler <jhunkeler@gmail.com>2015-08-11 16:51:37 -0400
commit40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch)
tree4464880c571602d54f6ae114729bf62a89518057 /pkg/tbtables/cfitsio/f77_wrap2.c
downloadiraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'pkg/tbtables/cfitsio/f77_wrap2.c')
-rw-r--r--pkg/tbtables/cfitsio/f77_wrap2.c1081
1 files changed, 1081 insertions, 0 deletions
diff --git a/pkg/tbtables/cfitsio/f77_wrap2.c b/pkg/tbtables/cfitsio/f77_wrap2.c
new file mode 100644
index 00000000..3c148cc1
--- /dev/null
+++ b/pkg/tbtables/cfitsio/f77_wrap2.c
@@ -0,0 +1,1081 @@
+/************************************************************************
+ Together, f77_wrap1.c and f77_wrap2.c contain C wrappers for all
+ the CFITSIO routines prototyped in fitsio.h, except for the
+ generic datatype routines and features not supported in fortran
+ (eg, unsigned integers), a few routines prototyped in fitsio2.h,
+ which only a handful of FTOOLS use, plus a few obsolete FITSIO
+ routines not present in CFITSIO. This file allows Fortran code
+ to use the CFITSIO library instead of the FITSIO library without
+ modification. It also gives access to new routines not present
+ in FITSIO. Fortran FTOOLS must continue using the old routine
+ names from FITSIO (ie, ftxxxx), but most of the C-wrappers simply
+ redirect those calls to the corresponding CFITSIO routines (ie,
+ ffxxxx), with appropriate parameter massaging where necessary.
+ The main exception are read/write routines ending in j (ie, long
+ data) which get redirected to C routines ending in k (ie, int
+ data). This is more consistent with the default integer type in
+ Fortran. f77_wrap1.c primarily holds routines operating on whole
+ files and extension headers. f77_wrap2.c handle routines which
+ read and write the data portion, plus miscellaneous extra routines.
+
+ File created by Peter Wilson (HSTX), Oct-Dec. 1997
+************************************************************************/
+
+#include "fitsio2.h"
+#include "f77_wrap.h"
+
+/*------------ read primary array or image elements -------------*/
+FCALLSCSUB8(ffgpvb,FTGPVB,ftgpvb,FITSUNIT,LONG,LONG,LONG,BYTE,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvi,FTGPVI,ftgpvi,FITSUNIT,LONG,LONG,LONG,SHORT,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvk,FTGPVJ,ftgpvj,FITSUNIT,LONG,LONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvk,FTGPVK,ftgpvk,FITSUNIT,LONG,LONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpve,FTGPVE,ftgpve,FITSUNIT,LONG,LONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB8(ffgpvd,FTGPVD,ftgpvd,FITSUNIT,LONG,LONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+
+#define ftgpfb_LOGV_A6 A4
+FCALLSCSUB8(ffgpfb,FTGPFB,ftgpfb,FITSUNIT,LONG,LONG,LONG,BYTEV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfi_LOGV_A6 A4
+FCALLSCSUB8(ffgpfi,FTGPFI,ftgpfi,FITSUNIT,LONG,LONG,LONG,SHORTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfj_LOGV_A6 A4
+FCALLSCSUB8(ffgpfk,FTGPFJ,ftgpfj,FITSUNIT,LONG,LONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfk_LOGV_A6 A4
+FCALLSCSUB8(ffgpfk,FTGPFK,ftgpfk,FITSUNIT,LONG,LONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfe_LOGV_A6 A4
+FCALLSCSUB8(ffgpfe,FTGPFE,ftgpfe,FITSUNIT,LONG,LONG,LONG,FLOATV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgpfd_LOGV_A6 A4
+FCALLSCSUB8(ffgpfd,FTGPFD,ftgpfd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,LOGICALV,PLOGICAL,PINT)
+
+FCALLSCSUB9(ffg2db,FTG2DB,ftg2db,FITSUNIT,LONG,BYTE,LONG,LONG,LONG,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2di,FTG2DI,ftg2di,FITSUNIT,LONG,SHORT,LONG,LONG,LONG,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2dk,FTG2DJ,ftg2dj,FITSUNIT,LONG,INT,LONG,LONG,LONG,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2dk,FTG2DK,ftg2dk,FITSUNIT,LONG,INT,LONG,LONG,LONG,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2de,FTG2DE,ftg2de,FITSUNIT,LONG,FLOAT,LONG,LONG,LONG,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffg2dd,FTG2DD,ftg2dd,FITSUNIT,LONG,DOUBLE,LONG,LONG,LONG,DOUBLEV,PLOGICAL,PINT)
+
+FCALLSCSUB11(ffg3db,FTG3DB,ftg3db,FITSUNIT,LONG,BYTE,LONG,LONG,LONG,LONG,LONG,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3di,FTG3DI,ftg3di,FITSUNIT,LONG,SHORT,LONG,LONG,LONG,LONG,LONG,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3dk,FTG3DJ,ftg3dj,FITSUNIT,LONG,INT,LONG,LONG,LONG,LONG,LONG,INTV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3dk,FTG3DK,ftg3dk,FITSUNIT,LONG,INT,LONG,LONG,LONG,LONG,LONG,INTV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3de,FTG3DE,ftg3de,FITSUNIT,LONG,FLOAT,LONG,LONG,LONG,LONG,LONG,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB11(ffg3dd,FTG3DD,ftg3dd,FITSUNIT,LONG,DOUBLE,LONG,LONG,LONG,LONG,LONG,DOUBLEV,PLOGICAL,PINT)
+
+ /* The follow LONGV definitions have +1 appended because the */
+ /* routines use of NAXIS+1 elements of the long vectors. */
+
+#define ftgsvb_LONGV_A4 A3+1
+#define ftgsvb_LONGV_A5 A3+1
+#define ftgsvb_LONGV_A6 A3+1
+#define ftgsvb_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvb,FTGSVB,ftgsvb,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,BYTE,BYTEV,PLOGICAL,PINT)
+
+#define ftgsvi_LONGV_A4 A3+1
+#define ftgsvi_LONGV_A5 A3+1
+#define ftgsvi_LONGV_A6 A3+1
+#define ftgsvi_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvi,FTGSVI,ftgsvi,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,SHORT,SHORTV,PLOGICAL,PINT)
+
+#define ftgsvj_LONGV_A4 A3+1
+#define ftgsvj_LONGV_A5 A3+1
+#define ftgsvj_LONGV_A6 A3+1
+#define ftgsvj_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvk,FTGSVJ,ftgsvj,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,INT,INTV,PLOGICAL,PINT)
+
+#define ftgsvk_LONGV_A4 A3+1
+#define ftgsvk_LONGV_A5 A3+1
+#define ftgsvk_LONGV_A6 A3+1
+#define ftgsvk_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvk,FTGSVK,ftgsvk,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,INT,INTV,PLOGICAL,PINT)
+
+#define ftgsve_LONGV_A4 A3+1
+#define ftgsve_LONGV_A5 A3+1
+#define ftgsve_LONGV_A6 A3+1
+#define ftgsve_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsve,FTGSVE,ftgsve,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,FLOAT,FLOATV,PLOGICAL,PINT)
+
+#define ftgsvd_LONGV_A4 A3+1
+#define ftgsvd_LONGV_A5 A3+1
+#define ftgsvd_LONGV_A6 A3+1
+#define ftgsvd_LONGV_A7 A3+1
+FCALLSCSUB11(ffgsvd,FTGSVD,ftgsvd,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+
+/* Must handle LOGICALV conversion manually */
+void Cffgsfb( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, unsigned char *array, int *flagval, int *anynul, int *status );
+void Cffgsfb( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, unsigned char *array, int *flagval, int *anynul, int *status )
+{
+ char *Cflagval;
+ long nflagval;
+ int i;
+
+ for( nflagval=1, i=0; i<naxis; i++ )
+ nflagval *= (trc[i]-blc[i])/inc[i]+1;
+ Cflagval = F2CcopyLogVect(nflagval, flagval );
+ ffgsfb( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );
+ C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfb_LONGV_A4 A3+1
+#define ftgsfb_LONGV_A5 A3+1
+#define ftgsfb_LONGV_A6 A3+1
+#define ftgsfb_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfb,FTGSFB,ftgsfb,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,BYTEV,INTV,PLOGICAL,PINT)
+
+/* Must handle LOGICALV conversion manually */
+void Cffgsfi( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, short *array, int *flagval, int *anynul, int *status );
+void Cffgsfi( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, short *array, int *flagval, int *anynul, int *status )
+{
+ char *Cflagval;
+ long nflagval;
+ int i;
+
+ for( nflagval=1, i=0; i<naxis; i++ )
+ nflagval *= (trc[i]-blc[i])/inc[i]+1;
+ Cflagval = F2CcopyLogVect(nflagval, flagval );
+ ffgsfi( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );
+ C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfi_LONGV_A4 A3+1
+#define ftgsfi_LONGV_A5 A3+1
+#define ftgsfi_LONGV_A6 A3+1
+#define ftgsfi_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfi,FTGSFI,ftgsfi,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,SHORTV,INTV,PLOGICAL,PINT)
+
+/* Must handle LOGICALV conversion manually */
+void Cffgsfk( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, int *array, int *flagval, int *anynul, int *status );
+void Cffgsfk( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, int *array, int *flagval, int *anynul, int *status )
+{
+ char *Cflagval;
+ long nflagval;
+ int i;
+
+ for( nflagval=1, i=0; i<naxis; i++ )
+ nflagval *= (trc[i]-blc[i])/inc[i]+1;
+ Cflagval = F2CcopyLogVect(nflagval, flagval );
+ ffgsfk( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );
+ C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfk_LONGV_A4 A3+1
+#define ftgsfk_LONGV_A5 A3+1
+#define ftgsfk_LONGV_A6 A3+1
+#define ftgsfk_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfk,FTGSFK,ftgsfk,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,INTV,INTV,PLOGICAL,PINT)
+
+#define ftgsfj_LONGV_A4 A3+1
+#define ftgsfj_LONGV_A5 A3+1
+#define ftgsfj_LONGV_A6 A3+1
+#define ftgsfj_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfk,FTGSFJ,ftgsfj,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,INTV,INTV,PLOGICAL,PINT)
+
+/* Must handle LOGICALV conversion manually */
+void Cffgsfe( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, float *array, int *flagval, int *anynul, int *status );
+void Cffgsfe( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, float *array, int *flagval, int *anynul, int *status )
+{
+ char *Cflagval;
+ long nflagval;
+ int i;
+
+ for( nflagval=1, i=0; i<naxis; i++ )
+ nflagval *= (trc[i]-blc[i])/inc[i]+1;
+ Cflagval = F2CcopyLogVect(nflagval, flagval );
+ ffgsfe( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );
+ C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfe_LONGV_A4 A3+1
+#define ftgsfe_LONGV_A5 A3+1
+#define ftgsfe_LONGV_A6 A3+1
+#define ftgsfe_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfe,FTGSFE,ftgsfe,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,FLOATV,INTV,PLOGICAL,PINT)
+
+/* Must handle LOGICALV conversion manually */
+void Cffgsfd( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, double *array, int *flagval, int *anynul, int *status );
+void Cffgsfd( fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, long *trc, long *inc, double *array, int *flagval, int *anynul, int *status )
+{
+ char *Cflagval;
+ long nflagval;
+ int i;
+
+ for( nflagval=1, i=0; i<naxis; i++ )
+ nflagval *= (trc[i]-blc[i])/inc[i]+1;
+ Cflagval = F2CcopyLogVect(nflagval, flagval );
+ ffgsfd( fptr, colnum, naxis, naxes, blc, trc, inc, array, Cflagval, anynul, status );
+ C2FcopyLogVect(nflagval, flagval, Cflagval);
+}
+#define ftgsfd_LONGV_A4 A3+1
+#define ftgsfd_LONGV_A5 A3+1
+#define ftgsfd_LONGV_A6 A3+1
+#define ftgsfd_LONGV_A7 A3+1
+FCALLSCSUB11(Cffgsfd,FTGSFD,ftgsfd,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,DOUBLEV,INTV,PLOGICAL,PINT)
+
+FCALLSCSUB6(ffggpb,FTGGPB,ftggpb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffggpi,FTGGPI,ftggpi,FITSUNIT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB6(ffggpk,FTGGPJ,ftggpj,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffggpk,FTGGPK,ftggpk,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffggpe,FTGGPE,ftggpe,FITSUNIT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB6(ffggpd,FTGGPD,ftggpd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,PINT)
+
+/*--------------------- read column elements -------------*/
+/* To guarantee that we allocate enough memory to hold strings within
+ a table, call FFGTCL first to obtain width of the unique string
+ and use it as the minimum string width. Also test whether column
+ has a variable width in which case a single string is read
+ containing all its characters, so only declare a string vector
+ with 1 element. */
+
+#define ftgcvs_STRV_A7 NUM_ELEMS(velem)
+CFextern VOID_cfF(FTGCVS,ftgcvs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,STRING,PSTRINGV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGCVS,ftgcvs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,STRING,PSTRINGV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(FITSUNIT,1)
+ QCF(INT,2)
+ QCF(LONG,3)
+ QCF(LONG,4)
+ QCF(LONG,5)
+ QCF(STRING,6)
+ QCF(PSTRINGV,7)
+ QCF(PLOGICAL,8)
+ QCF(PINT,9)
+
+ fitsfile *fptr;
+ int colnum, *anynul, *status, velem, type;
+ long firstrow, firstelem, nelem;
+ long repeat;
+ unsigned long gMinStrLen=80L; /* gMin = width */
+ char *nulval, **array;
+
+ fptr = TCF(ftgcvs,FITSUNIT,1,0);
+ colnum = TCF(ftgcvs,INT,2,0);
+ firstrow = TCF(ftgcvs,LONG,3,0);
+ firstelem = TCF(ftgcvs,LONG,4,0);
+ nelem = TCF(ftgcvs,LONG,5,0);
+ nulval = TCF(ftgcvs,STRING,6,0);
+ /* put off variable 7 (array) until column type is learned */
+ anynul = TCF(ftgcvs,PLOGICAL,8,0);
+ status = TCF(ftgcvs,PINT,9,0);
+
+ ffgtcl( fptr, colnum, &type, &repeat, (long *)&gMinStrLen, status );
+ if( type<0 ) velem = 1; /* Variable length column */
+ else velem = nelem;
+
+ array = TCF(ftgcvs,PSTRINGV,7,0);
+
+ ffgcvs( fptr, colnum, firstrow, firstelem, nelem, nulval, array,
+ anynul, status );
+
+ RCF(FITSUNIT,1)
+ RCF(INT,2)
+ RCF(LONG,3)
+ RCF(LONG,4)
+ RCF(LONG,5)
+ RCF(STRING,6)
+ RCF(PSTRINGV,7)
+ RCF(PLOGICAL,8)
+ RCF(PINT,9)
+}
+
+
+
+#define ftgcl_LOGV_A6 A5
+FCALLSCSUB7(ffgcl,FTGCL,ftgcl,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+
+#define ftgcvl_LOGV_A7 A5
+FCALLSCSUB9(ffgcvl,FTGCVL,ftgcvl,FITSUNIT,INT,LONG,LONG,LONG,LOGICAL,LOGICALV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvb,FTGCVB,ftgcvb,FITSUNIT,INT,LONG,LONG,LONG,BYTE,BYTEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvi,FTGCVI,ftgcvi,FITSUNIT,INT,LONG,LONG,LONG,SHORT,SHORTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvk,FTGCVJ,ftgcvj,FITSUNIT,INT,LONG,LONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvk,FTGCVK,ftgcvk,FITSUNIT,INT,LONG,LONG,LONG,INT,INTV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcve,FTGCVE,ftgcve,FITSUNIT,INT,LONG,LONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvd,FTGCVD,ftgcvd,FITSUNIT,INT,LONG,LONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvc,FTGCVC,ftgcvc,FITSUNIT,INT,LONG,LONG,LONG,FLOAT,FLOATV,PLOGICAL,PINT)
+FCALLSCSUB9(ffgcvm,FTGCVM,ftgcvm,FITSUNIT,INT,LONG,LONG,LONG,DOUBLE,DOUBLEV,PLOGICAL,PINT)
+
+#define ftgcx_LOGV_A6 A5
+FCALLSCSUB7(ffgcx,FTGCX,ftgcx,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+
+/* We need to worry about unsigned vs signed pointers in the following */
+/* two routines, so use a pair of C wrappers which cast the pointers */
+/* before passing them to CFITSIO. */
+
+void Cffgcxui(fitsfile *fptr, int colnum, long firstrow, long nrows,
+ long firstbit, int nbits, short *array, int *status);
+void Cffgcxui(fitsfile *fptr, int colnum, long firstrow, long nrows,
+ long firstbit, int nbits, short *array, int *status)
+{
+ ffgcxui( fptr, colnum, firstrow, nrows, firstbit, nbits,
+ (unsigned short *)array, status );
+}
+FCALLSCSUB8(Cffgcxui,FTGCXI,ftgcxi,FITSUNIT,INT,LONG,LONG,LONG,INT,SHORTV,PINT)
+
+void Cffgcxuk(fitsfile *fptr, int colnum, long firstrow, long nrows,
+ long firstbit, int nbits, int *array, int *status);
+void Cffgcxuk(fitsfile *fptr, int colnum, long firstrow, long nrows,
+ long firstbit, int nbits, int *array, int *status)
+{
+ ffgcxuk( fptr, colnum, firstrow, nrows, firstbit, nbits,
+ (unsigned int *)array, status );
+}
+FCALLSCSUB8(Cffgcxuk,FTGCXJ,ftgcxj,FITSUNIT,INT,LONG,LONG,LONG,INT,INTV,PINT)
+
+/* To guarantee that we allocate enough memory to hold strings within
+ a table, call FFGTCL first to obtain width of the unique string
+ and use it as the minimum string width. Also test whether column
+ has a variable width in which case a single string is read
+ containing all its characters, so only declare a string vector
+ with 1 element. */
+
+#define ftgcfs_STRV_A6 NUM_ELEMS(velem)
+#define ftgcfs_LOGV_A7 A5
+CFextern VOID_cfF(FTGCFS,ftgcfs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,PSTRINGV,LOGICALV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTGCFS,ftgcfs)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FITSUNIT,INT,LONG,LONG,LONG,PSTRINGV,LOGICALV,PLOGICAL,PINT,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(FITSUNIT,1)
+ QCF(INT,2)
+ QCF(LONG,3)
+ QCF(LONG,4)
+ QCF(LONG,5)
+ QCF(PSTRINGV,6)
+ QCF(LOGICALV,7)
+ QCF(PLOGICAL,8)
+ QCF(PINT,9)
+
+ fitsfile *fptr;
+ int colnum, *anynul, *status, velem, type;
+ long firstrow, firstelem, nelem;
+ long repeat;
+ unsigned long gMinStrLen=80L; /* gMin = width */
+ char **array, *nularray;
+
+ fptr = TCF(ftgcfs,FITSUNIT,1,0);
+ colnum = TCF(ftgcfs,INT,2,0);
+ firstrow = TCF(ftgcfs,LONG,3,0);
+ firstelem = TCF(ftgcfs,LONG,4,0);
+ nelem = TCF(ftgcfs,LONG,5,0);
+ /* put off variable 6 (array) until column type is learned */
+ nularray = TCF(ftgcfs,LOGICALV,7,0);
+ anynul = TCF(ftgcfs,PLOGICAL,8,0);
+ status = TCF(ftgcfs,PINT,9,0);
+
+ ffgtcl( fptr, colnum, &type, &repeat, (long*)&gMinStrLen, status );
+ if( type<0 ) velem = 1; /* Variable length column */
+ else velem = nelem;
+
+ array = TCF(ftgcfs,PSTRINGV,6,0);
+
+ ffgcfs( fptr, colnum, firstrow, firstelem, nelem, array, nularray,
+ anynul, status);
+
+ RCF(FITSUNIT,1)
+ RCF(INT,2)
+ RCF(LONG,3)
+ RCF(LONG,4)
+ RCF(LONG,5)
+ RCF(PSTRINGV,6)
+ RCF(LOGICALV,7)
+ RCF(PLOGICAL,8)
+ RCF(PINT,9)
+}
+
+
+
+#define ftgcfl_LOGV_A6 A5
+#define ftgcfl_LOGV_A7 A5
+FCALLSCSUB9(ffgcfl,FTGCFL,ftgcfl,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfb_LOGV_A7 A5
+FCALLSCSUB9(ffgcfb,FTGCFB,ftgcfb,FITSUNIT,INT,LONG,LONG,LONG,BYTEV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfi_LOGV_A7 A5
+FCALLSCSUB9(ffgcfi,FTGCFI,ftgcfi,FITSUNIT,INT,LONG,LONG,LONG,SHORTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfj_LOGV_A7 A5
+FCALLSCSUB9(ffgcfk,FTGCFJ,ftgcfj,FITSUNIT,INT,LONG,LONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfk_LOGV_A7 A5
+FCALLSCSUB9(ffgcfk,FTGCFK,ftgcfk,FITSUNIT,INT,LONG,LONG,LONG,INTV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfe_LOGV_A7 A5
+FCALLSCSUB9(ffgcfe,FTGCFE,ftgcfe,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,LOGICALV,PLOGICAL,PINT)
+
+#define ftgcfd_LOGV_A7 A5
+FCALLSCSUB9(ffgcfd,FTGCFD,ftgcfd,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,LOGICALV,PLOGICAL,PINT)
+
+/* Must handle LOGICALV conversion manually */
+void Cffgcfc( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, float *array, int *nularray, int *anynul, int *status );
+void Cffgcfc( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, float *array, int *nularray, int *anynul, int *status )
+{
+ char *Cnularray;
+
+ Cnularray = F2CcopyLogVect(nelem*2, nularray );
+ ffgcfc( fptr, colnum, firstrow, firstelem, nelem, array, Cnularray, anynul, status );
+ C2FcopyLogVect(nelem*2, nularray, Cnularray );
+}
+FCALLSCSUB9(Cffgcfc,FTGCFC,ftgcfc,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,INTV,PLOGICAL,PINT)
+
+/* Must handle LOGICALV conversion manually */
+void Cffgcfm( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, double *array, int *nularray, int *anynul, int *status );
+void Cffgcfm( fitsfile *fptr, int colnum, long firstrow, long firstelem, long nelem, double *array, int *nularray, int *anynul, int *status )
+{
+ char *Cnularray;
+
+ Cnularray = F2CcopyLogVect(nelem*2, nularray );
+ ffgcfm( fptr, colnum, firstrow, firstelem, nelem, array, Cnularray, anynul, status );
+ C2FcopyLogVect(nelem*2, nularray, Cnularray );
+}
+FCALLSCSUB9(Cffgcfm,FTGCFM,ftgcfm,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,INTV,PLOGICAL,PINT)
+
+FCALLSCSUB6(ffgdes,FTGDES,ftgdes,FITSUNIT,INT,LONG,PLONG,PLONG,PINT)
+
+FCALLSCSUB6(ffgtbb,FTGTBB,ftgtbb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffgtbb,FTGTBS,ftgtbs,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+
+/*------------ write primary array or image elements -------------*/
+FCALLSCSUB6(ffpprb,FTPPRB,ftpprb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffppri,FTPPRI,ftppri,FITSUNIT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB6(ffpprk,FTPPRJ,ftpprj,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffpprk,FTPPRK,ftpprk,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffppre,FTPPRE,ftppre,FITSUNIT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB6(ffpprd,FTPPRD,ftpprd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,PINT)
+
+FCALLSCSUB7(ffppnb,FTPPNB,ftppnb,FITSUNIT,LONG,LONG,LONG,BYTEV,BYTE,PINT)
+FCALLSCSUB7(ffppni,FTPPNI,ftppni,FITSUNIT,LONG,LONG,LONG,SHORTV,SHORT,PINT)
+FCALLSCSUB7(ffppnk,FTPPNJ,ftppnj,FITSUNIT,LONG,LONG,LONG,INTV,INT,PINT)
+FCALLSCSUB7(ffppnk,FTPPNK,ftppnk,FITSUNIT,LONG,LONG,LONG,INTV,INT,PINT)
+FCALLSCSUB7(ffppne,FTPPNE,ftppne,FITSUNIT,LONG,LONG,LONG,FLOATV,FLOAT,PINT)
+FCALLSCSUB7(ffppnd,FTPPND,ftppnd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,DOUBLE,PINT)
+
+FCALLSCSUB7(ffp2db,FTP2DB,ftp2db,FITSUNIT,LONG,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB7(ffp2di,FTP2DI,ftp2di,FITSUNIT,LONG,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB7(ffp2dk,FTP2DJ,ftp2dj,FITSUNIT,LONG,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffp2dk,FTP2DK,ftp2dk,FITSUNIT,LONG,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffp2de,FTP2DE,ftp2de,FITSUNIT,LONG,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffp2dd,FTP2DD,ftp2dd,FITSUNIT,LONG,LONG,LONG,LONG,DOUBLEV,PINT)
+
+FCALLSCSUB9(ffp3db,FTP3DB,ftp3db,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB9(ffp3di,FTP3DI,ftp3di,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB9(ffp3dk,FTP3DJ,ftp3dj,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB9(ffp3dk,FTP3DK,ftp3dk,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB9(ffp3de,FTP3DE,ftp3de,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB9(ffp3dd,FTP3DD,ftp3dd,FITSUNIT,LONG,LONG,LONG,LONG,LONG,LONG,DOUBLEV,PINT)
+
+#define ftpssb_LONGV_A4 A3
+#define ftpssb_LONGV_A5 A3
+#define ftpssb_LONGV_A6 A3
+FCALLSCSUB8(ffpssb,FTPSSB,ftpssb,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,BYTEV,PINT)
+
+#define ftpssi_LONGV_A4 A3
+#define ftpssi_LONGV_A5 A3
+#define ftpssi_LONGV_A6 A3
+FCALLSCSUB8(ffpssi,FTPSSI,ftpssi,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,SHORTV,PINT)
+
+#define ftpssj_LONGV_A4 A3
+#define ftpssj_LONGV_A5 A3
+#define ftpssj_LONGV_A6 A3
+FCALLSCSUB8(ffpssk,FTPSSJ,ftpssj,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,INTV,PINT)
+
+#define ftpssk_LONGV_A4 A3
+#define ftpssk_LONGV_A5 A3
+#define ftpssk_LONGV_A6 A3
+FCALLSCSUB8(ffpssk,FTPSSK,ftpssk,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,INTV,PINT)
+
+#define ftpsse_LONGV_A4 A3
+#define ftpsse_LONGV_A5 A3
+#define ftpsse_LONGV_A6 A3
+FCALLSCSUB8(ffpsse,FTPSSE,ftpsse,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,FLOATV,PINT)
+
+#define ftpssd_LONGV_A4 A3
+#define ftpssd_LONGV_A5 A3
+#define ftpssd_LONGV_A6 A3
+FCALLSCSUB8(ffpssd,FTPSSD,ftpssd,FITSUNIT,LONG,LONG,LONGV,LONGV,LONGV,DOUBLEV,PINT)
+
+FCALLSCSUB6(ffpgpb,FTPGPB,ftpgpb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB6(ffpgpi,FTPGPI,ftpgpi,FITSUNIT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB6(ffpgpk,FTPGPJ,ftpgpj,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffpgpk,FTPGPK,ftpgpk,FITSUNIT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB6(ffpgpe,FTPGPE,ftpgpe,FITSUNIT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB6(ffpgpd,FTPGPD,ftpgpd,FITSUNIT,LONG,LONG,LONG,DOUBLEV,PINT)
+
+FCALLSCSUB5(ffppru,FTPPRU,ftppru,FITSUNIT,LONG,LONG,LONG,PINT)
+FCALLSCSUB4(ffpprn,FTPPRN,ftpprn,FITSUNIT,LONG,LONG,PINT)
+
+/*--------------------- write column elements -------------*/
+#define ftpcls_STRV_A6 NUM_ELEM_ARG(5)
+FCALLSCSUB7(ffpcls,FTPCLS,ftpcls,FITSUNIT,INT,LONG,LONG,LONG,STRINGV,PINT)
+
+#define ftpcll_LOGV_A6 A5
+FCALLSCSUB7(ffpcll,FTPCLL,ftpcll,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+FCALLSCSUB7(ffpclb,FTPCLB,ftpclb,FITSUNIT,INT,LONG,LONG,LONG,BYTEV,PINT)
+FCALLSCSUB7(ffpcli,FTPCLI,ftpcli,FITSUNIT,INT,LONG,LONG,LONG,SHORTV,PINT)
+FCALLSCSUB7(ffpclk,FTPCLJ,ftpclj,FITSUNIT,INT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffpclk,FTPCLK,ftpclk,FITSUNIT,INT,LONG,LONG,LONG,INTV,PINT)
+FCALLSCSUB7(ffpcle,FTPCLE,ftpcle,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffpcld,FTPCLD,ftpcld,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,PINT)
+FCALLSCSUB7(ffpclc,FTPCLC,ftpclc,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,PINT)
+FCALLSCSUB7(ffpclm,FTPCLM,ftpclm,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,PINT)
+FCALLSCSUB6(ffpclu,FTPCLU,ftpclu,FITSUNIT,INT,LONG,LONG,LONG,PINT)
+
+#define ftpclx_LOGV_A6 A5
+FCALLSCSUB7(ffpclx,FTPCLX,ftpclx,FITSUNIT,INT,LONG,LONG,LONG,LOGICALV,PINT)
+
+#define ftpcns_STRV_A6 NUM_ELEM_ARG(5)
+FCALLSCSUB8(ffpcns,FTPCNS,ftpcns,FITSUNIT,INT,LONG,LONG,LONG,STRINGV,STRING,PINT)
+
+FCALLSCSUB8(ffpcnb,FTPCNB,ftpcnb,FITSUNIT,INT,LONG,LONG,LONG,BYTEV,BYTE,PINT)
+FCALLSCSUB8(ffpcni,FTPCNI,ftpcni,FITSUNIT,INT,LONG,LONG,LONG,SHORTV,SHORT,PINT)
+FCALLSCSUB8(ffpcnk,FTPCNJ,ftpcnj,FITSUNIT,INT,LONG,LONG,LONG,INTV,INT,PINT)
+FCALLSCSUB8(ffpcnk,FTPCNK,ftpcnk,FITSUNIT,INT,LONG,LONG,LONG,INTV,INT,PINT)
+FCALLSCSUB8(ffpcne,FTPCNE,ftpcne,FITSUNIT,INT,LONG,LONG,LONG,FLOATV,FLOAT,PINT)
+FCALLSCSUB8(ffpcnd,FTPCND,ftpcnd,FITSUNIT,INT,LONG,LONG,LONG,DOUBLEV,DOUBLE,PINT)
+
+FCALLSCSUB6(ffpdes,FTPDES,ftpdes,FITSUNIT,INT,LONG,LONG,LONG,PINT)
+
+FCALLSCSUB6(ffptbb,FTPTBB,ftptbb,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+ /* Add extra entry point to ffptbb... ftptbs obsolete */
+FCALLSCSUB6(ffptbb,FTPTBS,ftptbs,FITSUNIT,LONG,LONG,LONG,BYTEV,PINT)
+
+FCALLSCSUB4(ffirow,FTIROW,ftirow,FITSUNIT,LONG,LONG,PINT)
+FCALLSCSUB4(ffdrow,FTDROW,ftdrow,FITSUNIT,LONG,LONG,PINT)
+#define ftdrws_LONGV_A2 A3
+FCALLSCSUB4(ffdrws,FTDRWS,ftdrws,FITSUNIT,LONGV,LONG,PINT)
+FCALLSCSUB5(fficol,FTICOL,fticol,FITSUNIT,INT,STRING,STRING,PINT)
+
+#define fticls_STRV_A4 NUM_ELEM_ARG(3)
+#define fticls_STRV_A5 NUM_ELEM_ARG(3)
+FCALLSCSUB6(fficls,FTICLS,fticls,FITSUNIT,INT,INT,STRINGV,STRINGV,PINT)
+FCALLSCSUB4(ffmvec,FTMVEC,ftmvec,FITSUNIT,INT,LONG,PINT)
+FCALLSCSUB3(ffdcol,FTDCOL,ftdcol,FITSUNIT,INT,PINT)
+FCALLSCSUB6(ffcpcl,FTCPCL,ftcpcl,FITSUNIT,FITSUNIT,INT,INT,INT,PINT)
+
+/*********************************************************************/
+/* Iterator Functions */
+/*********************************************************************/
+
+/* Use a simple ellipse prototype for Fwork_fn to satisfy finicky compilers */
+typedef struct {
+ void *userData;
+ void (*Fwork_fn)(PLONG_cfTYPE *total_n, ...);
+} FtnUserData;
+
+/* Declare protoypes to make C++ happy */
+int Cwork_fn(long, long, long, long, int, iteratorCol *, void *);
+void Cffiter( int n_cols, int *units, int *colnum, char *colname[],
+ int *datatype, int *iotype,
+ long offset, long n_per_loop, void *Fwork_fn,
+ void *userData, int *status);
+
+/******************************************************************/
+/* Cffiter is the wrapper for CFITSIO's ffiter which takes most */
+/* of its arguments via a structure, iteratorCol. This routine */
+/* takes a list of arrays and converts them into a single array */
+/* of type iteratorCol and passes it to CFITSIO. Because ffiter */
+/* will be passing control to a Fortran work function, the C */
+/* wrapper, Cwork_fn, must be passed in its place which then */
+/* calls the Fortran routine after the necessary data */
+/* manipulation. The Fortran routine is passed via the user- */
+/* supplied parameter pointer. */
+/******************************************************************/
+
+void Cffiter( int n_cols, int *units, int *colnum, char *colname[],
+ int *datatype, int *iotype,
+ long offset, long n_per_loop, void *Fwork_fn,
+ void *userData, int *status)
+{
+ iteratorCol *cols;
+ int i;
+ FtnUserData FuserData;
+
+ FuserData.Fwork_fn = (void(*)(PLONG_cfTYPE *,...))Fwork_fn;
+ FuserData.userData = userData;
+
+ cols = (iteratorCol *)malloc( n_cols*sizeof(iteratorCol) );
+ if( cols==NULL ) {
+ *status = MEMORY_ALLOCATION;
+ return;
+ }
+ for(i=0;i<n_cols;i++) {
+ cols[i].fptr = gFitsFiles[ units[i] ];
+ cols[i].colnum = colnum[i];
+ strncpy(cols[i].colname,colname[i],70);
+ cols[i].datatype = datatype[i];
+ cols[i].iotype = iotype[i];
+ }
+
+ ffiter( n_cols, cols, offset, n_per_loop, Cwork_fn,
+ (void*)&FuserData, status );
+ free(cols);
+}
+#define ftiter_STRV_A4 NUM_ELEM_ARG(1)
+FCALLSCSUB11(Cffiter,FTITER,ftiter,INT,INTV,INTV,STRINGV,INTV,INTV,LONG,LONG,PVOID,PVOID,PINT)
+
+/*-----------------------------------------------------------------*/
+/* This function is called by CFITSIO's ffiter and serves as the */
+/* wrapper for the Fortran work function which is passed in the */
+/* extra user-supplied pointer. It breaks up C's iteratorCol */
+/* into several separate arrays. Because we cannot send an */
+/* array of pointers for the column data, we instead send *many* */
+/* arrays as final parameters. */
+/*-----------------------------------------------------------------*/
+
+int Cwork_fn( long total_n, long offset, long first_n, long n_values,
+ int n_cols, iteratorCol *cols, void *FuserData )
+{
+ int *units, *colnum, *datatype, *iotype, *repeat;
+ char **sptr;
+ void **ptrs;
+ int i,j,k,nstr,status=0;
+ long *slen;
+
+#ifdef vmsFortran
+ /* Passing strings under VMS require a special structure */
+ fstringvector *vmsStrs;
+#endif
+
+ /* Allocate memory for all the arrays. Grab all the int's */
+ /* at once and divide up among parameters */
+
+ ptrs = (void**)malloc(2*n_cols*sizeof(void*));
+ if( ptrs==NULL )
+ return( MEMORY_ALLOCATION );
+ units = (int*)malloc(5*n_cols*sizeof(int));
+ if( units==NULL ) {
+ free(ptrs);
+ return( MEMORY_ALLOCATION );
+ }
+ colnum = units + 1 * n_cols;
+ datatype = units + 2 * n_cols;
+ iotype = units + 3 * n_cols;
+ repeat = units + 4 * n_cols;
+
+ nstr = 0;
+ slen = (long*)(ptrs+n_cols);
+#ifdef vmsFortran
+ vmsStrs = (fstringvector *)calloc(sizeof(fstringvector),n_cols);
+ if( vmsStrs==NULL ) {
+ free(ptrs);
+ free(units);
+ return( MEMORY_ALLOCATION );
+ }
+#endif
+
+ for(i=0;i<n_cols;i++) {
+ for(j=0;j<MAXFITSFILES;j++)
+ if( cols[i].fptr==gFitsFiles[j] )
+ units[i] = j;
+ colnum[i] = cols[i].colnum;
+ datatype[i] = cols[i].datatype;
+ iotype[i] = cols[i].iotype;
+ repeat[i] = cols[i].repeat;
+
+ if( datatype[i]==TLOGICAL ) {
+ /* Don't forget first element is null value */
+ ptrs[i] = (void *)malloc( (n_values*repeat[i]+1)*4 );
+ if( ptrs[i]==NULL ) {
+ free(ptrs);
+ free(units);
+ return( MEMORY_ALLOCATION );
+ }
+ for( j=0;j<=n_values*repeat[i]; j++ )
+ ((int*)ptrs[i])[j] = C2FLOGICAL( ((char*)cols[i].array)[j]);
+ } else if ( datatype[i]==TSTRING ) {
+ sptr = (char**)cols[i].array;
+ slen[nstr] = sptr[1] - sptr[0];
+ for(j=0;j<=n_values;j++)
+ for(k=strlen( sptr[j] );k<slen[nstr];k++)
+ sptr[j][k] = ' ';
+#ifdef vmsFortran
+ vmsStrs[nstr].dsc$a_pointer = sptr[0];
+ vmsStrs[nstr].dsc$w_length = slen[nstr];
+ vmsStrs[nstr].dsc$l_m[0] = n_values+1;
+ vmsStrs[nstr].dsc$l_arsize = slen[nstr] * (n_values+1);
+ vmsStrs[nstr].dsc$bounds[0].dsc$l_u = n_values+1;
+ vmsStrs[nstr].dsc$a_a0 = sptr[0] - slen[nstr];
+ ptrs[i] = (void *)(vmsStrs+nstr);
+#else
+ ptrs[i] = (void *)sptr[0];
+#endif
+ nstr++;
+ } else
+ ptrs[i] = (void *)cols[i].array;
+ }
+
+ if(!status) {
+ /* Handle Fortran function call manually... */
+ /* cfortran.h cannot handle all the desired */
+ /* 'ptrs' nor the indirect function call. */
+
+ PLONG_cfTYPE a1,a2,a3,a4; /* Do this in case longs are */
+ FtnUserData *f; /* not the same size as ints */
+
+ a1 = total_n;
+ a2 = offset;
+ a3 = first_n;
+ a4 = n_values;
+ f = (FtnUserData *)FuserData;
+
+ f->Fwork_fn(&a1,&a2,&a3,&a4,&n_cols,units,colnum,datatype,
+ iotype,repeat,&status,f->userData,
+ ptrs[ 0], ptrs[ 1], ptrs[ 2], ptrs[ 3], ptrs[ 4],
+ ptrs[ 5], ptrs[ 6], ptrs[ 7], ptrs[ 8], ptrs[ 9],
+ ptrs[10], ptrs[11], ptrs[12], ptrs[13], ptrs[14],
+ ptrs[15], ptrs[16], ptrs[17], ptrs[18], ptrs[19],
+ ptrs[20], ptrs[21], ptrs[22], ptrs[23], ptrs[24] );
+ }
+
+ /* Check whether there are any LOGICAL or STRING columns being outputted */
+ nstr=0;
+ for( i=0;i<n_cols;i++ ) {
+ if( iotype[i]!=InputCol ) {
+ if( datatype[i]==TLOGICAL ) {
+ for( j=0;j<=n_values*repeat[i];j++ )
+ ((char*)cols[i].array)[j] = F2CLOGICAL( ((int*)ptrs[i])[j] );
+ free(ptrs[i]);
+ } else if( datatype[i]==TSTRING ) {
+ for( j=0;j<=n_values;j++ )
+ ((char**)cols[i].array)[j][slen[nstr]-1] = '\0';
+ }
+ }
+ if( datatype[i]==TSTRING ) nstr++;
+ }
+
+ free(ptrs);
+ free(units);
+#ifdef vmsFortran
+ free(vmsStrs);
+#endif
+ return(status);
+}
+
+
+/*--------------------- WCS Utilities ----------------------------*/
+FCALLSCSUB10(ffgics,FTGICS,ftgics,FITSUNIT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB12(ffgtcs,FTGTCS,ftgtcs,FITSUNIT,INT,INT,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PDOUBLE,PSTRING,PINT)
+FCALLSCSUB13(ffwldp,FTWLDP,ftwldp,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,STRING,PDOUBLE,PDOUBLE,PINT)
+FCALLSCSUB13(ffxypx,FTXYPX,ftxypx,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,DOUBLE,STRING,PDOUBLE,PDOUBLE,PINT)
+
+/*------------------- Conversion Utilities -----------------*/
+/* (prototyped in fitsio2.h) */
+/*----------------------------------------------------------*/
+
+CFextern VOID_cfF(FTI2C,fti2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LONG,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTI2C,fti2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LONG,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(LONG,1)
+ QCF(PSTRING,2)
+ QCF(PINT,3)
+ char str[21];
+
+ ffi2c( TCF(fti2c,LONG,1,0)
+ TCF(fti2c,PSTRING,2,1)
+ TCF(fti2c,PINT,3,1) );
+
+ sprintf(str,"%20s",B2);
+ strcpy(B2,str);
+
+ RCF(LONG,1)
+ RCF(PSTRING,2)
+ RCF(PINT,3)
+}
+
+CFextern VOID_cfF(FTL2C,ftl2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LOGICAL,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTL2C,ftl2c)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),LOGICAL,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(LOGICAL,1)
+ QCF(PSTRING,2)
+ QCF(PINT,3)
+ char str[21];
+
+ ffl2c( TCF(ftl2c,LOGICAL,1,0)
+ TCF(ftl2c,PSTRING,2,1)
+ TCF(ftl2c,PINT,3,1) );
+
+ sprintf(str,"%20s",B2);
+ strcpy(B2,str);
+
+ RCF(LOGICAL,1)
+ RCF(PSTRING,2)
+ RCF(PINT,3)
+}
+
+FCALLSCSUB3(ffs2c,FTS2C,fts2c,STRING,PSTRING,PINT)
+
+CFextern VOID_cfF(FTR2F,ftr2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTR2F,ftr2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(FLOAT,1)
+ QCF(INT,2)
+ QCF(PSTRING,3)
+ QCF(PINT,4)
+ char str[21];
+
+ ffr2f( TCF(ftr2f,FLOAT,1,0)
+ TCF(ftr2f,INT,2,1)
+ TCF(ftr2f,PSTRING,3,1)
+ TCF(ftr2f,PINT,4,1) );
+
+ sprintf(str,"%20s",B3);
+ strcpy(B3,str);
+
+ RCF(FLOAT,1)
+ RCF(INT,2)
+ RCF(PSTRING,3)
+ RCF(PINT,4)
+}
+
+CFextern VOID_cfF(FTR2E,ftr2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTR2E,ftr2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),FLOAT,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(FLOAT,1)
+ QCF(INT,2)
+ QCF(PSTRING,3)
+ QCF(PINT,4)
+ char str[21];
+
+ ffr2e( TCF(ftr2e,FLOAT,1,0)
+ TCF(ftr2e,INT,2,1)
+ TCF(ftr2e,PSTRING,3,1)
+ TCF(ftr2e,PINT,4,1) );
+
+ sprintf(str,"%20s",B3);
+ strcpy(B3,str);
+
+ RCF(FLOAT,1)
+ RCF(INT,2)
+ RCF(PSTRING,3)
+ RCF(PINT,4)
+}
+
+CFextern VOID_cfF(FTD2F,ftd2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTD2F,ftd2f)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(DOUBLE,1)
+ QCF(INT,2)
+ QCF(PSTRING,3)
+ QCF(PINT,4)
+ char str[21];
+
+ ffd2f( TCF(ftd2f,DOUBLE,1,0)
+ TCF(ftd2f,INT,2,1)
+ TCF(ftd2f,PSTRING,3,1)
+ TCF(ftd2f,PINT,4,1) );
+
+ sprintf(str,"%20s",B3);
+ strcpy(B3,str);
+
+ RCF(DOUBLE,1)
+ RCF(INT,2)
+ RCF(PSTRING,3)
+ RCF(PINT,4)
+}
+
+CFextern VOID_cfF(FTD2E,ftd2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0));
+CFextern VOID_cfF(FTD2E,ftd2e)
+CFARGT14(NCF,DCF,ABSOFT_cf2(VOID),DOUBLE,INT,PSTRING,PINT,PINT,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0))
+{
+ QCF(DOUBLE,1)
+ QCF(INT,2)
+ QCF(PSTRING,3)
+ QCF(PINT,4)
+ QCF(PINT,5)
+ char str[21];
+ int *vlen;
+
+ vlen = TCF(ftd2e,PINT,4,0);
+
+ /* C version of routine doesn't use the 4th parameter, vlen */
+ ffd2e( TCF(ftd2e,DOUBLE,1,0)
+ TCF(ftd2e,INT,2,1)
+ TCF(ftd2e,PSTRING,3,1)
+ TCF(ftd2e,PINT,5,1) );
+
+ *vlen = strlen(B3);
+ if ( *vlen<20 ) {
+ sprintf(str,"%20s",B3); /* right justify if vlen<20 characters */
+ strcpy(B3,str);
+ *vlen = 20;
+ }
+
+ RCF(DOUBLE,1)
+ RCF(INT,2)
+ RCF(PSTRING,3)
+ RCF(PINT,4)
+ RCF(PINT,5)
+}
+
+FCALLSCSUB3(ffc2ii,FTC2II,ftc2ii,STRING,PLONG,PINT)
+FCALLSCSUB3(ffc2ll,FTC2LL,ftc2ll,STRING,PINT,PINT)
+FCALLSCSUB3(ffc2rr,FTC2RR,ftc2rr,STRING,PFLOAT,PINT)
+FCALLSCSUB3(ffc2dd,FTC2DD,ftc2dd,STRING,PDOUBLE,PINT)
+FCALLSCSUB7(ffc2x,FTC2X,ftc2x,STRING,PSTRING,PLONG,PINT,PSTRING,PDOUBLE,PINT)
+FCALLSCSUB3(ffc2s,FTC2S,ftc2s,STRING,PSTRING,PINT)
+FCALLSCSUB3(ffc2i,FTC2I,ftc2i,STRING,PLONG,PINT)
+FCALLSCSUB3(ffc2r,FTC2R,ftc2r,STRING,PFLOAT,PINT)
+FCALLSCSUB3(ffc2d,FTC2D,ftc2d,STRING,PDOUBLE,PINT)
+FCALLSCSUB3(ffc2l,FTC2L,ftc2l,STRING,PINT,PINT)
+
+/*------------------ Byte-level read/seek/write -----------------*/
+/* (prototyped in fitsio2.h) */
+/*---------------------------------------------------------------*/
+
+/*
+ ffmbyt should not be called by any application programs, so
+ the wrapper should not need to be defined. If it is needed then
+ the second parameter (LONG) will need to be changed to the
+ equivalent of the C 'off_t' type, which may be 32 or 64 bits long
+ depending on the compiler.
+ -W.Pence (7/21/00)
+
+FCALLSCSUB4(ffmbyt,FTMBYT,ftmbyt,FITSUNIT,LONG,LOGICAL,PINT)
+*/
+
+FCALLSCSUB4(ffgbyt,FTGCBF,ftgcbf,FITSUNIT,LONG,PVOID,PINT)
+FCALLSCSUB4(ffgbyt,FTGBYT,ftgbyt,FITSUNIT,LONG,PVOID,PINT)
+
+FCALLSCSUB4(ffpbyt,FTPCBF,ftpcbf,FITSUNIT,LONG,PVOID,PINT)
+FCALLSCSUB4(ffpbyt,FTPBYT,ftpbyt,FITSUNIT,LONG,PVOID,PINT)
+
+
+/*-------------- Additional missing FITSIO routines -------------*/
+/* (abandoned in CFITSIO) */
+/*---------------------------------------------------------------*/
+
+void Cffcrep( char *comm, char *comm1, int *repeat );
+void Cffcrep( char *comm, char *comm1, int *repeat )
+{
+/*
+ check if the first comment string is to be repeated for all keywords
+ (if the last non-blank character is '&', then it is to be repeated)
+
+ comm input comment string
+ OUTPUT PARAMETERS:
+ comm1 output comment string, = COMM minus the last '&' character
+ repeat TRUE if the last character of COMM was the '&' character
+
+ written by Wm Pence, HEASARC/GSFC, June 1991
+ translated to C by Peter Wilson, HSTX/GSFC, Oct 1997
+*/
+
+ int len;
+
+ *repeat=FALSE;
+ len=strlen(comm);
+ /* cfortran strips trailing spaces so only check last character */
+ if( len && comm[ len-1 ]=='&' ) {
+ strncpy(comm1,comm,len-1); /* Don't copy '&' */
+ comm1[len-1]='\0';
+ *repeat=TRUE;
+ }
+ return;
+}
+FCALLSCSUB3(Cffcrep,FTCREP,ftcrep,STRING,PSTRING,PLOGICAL)
+
+
+/*------------------ Test floats for NAN values -----------------*/
+/* (defined in fitsio2.h) */
+/*---------------------------------------------------------------*/
+
+int Cfnan( float *val );
+int Cfnan( float *val )
+{
+ int code;
+
+#if BYTESWAPPED
+ short *sptr = (short*)val + 1;
+#else
+ short *sptr = (short*)val;
+#endif
+
+ code = fnan(*sptr);
+ if( code==2 ) *val = 0.0; /* Underflow */
+
+ return( code!=0 );
+}
+FCALLSCFUN1(LOGICAL,Cfnan,FTTRNN,fttrnn,PFLOAT)
+
+
+int Cdnan( double *val );
+int Cdnan( double *val )
+{
+ int code;
+
+#if BYTESWAPPED
+ short *sptr = (short*)val + 3;
+#else
+ short *sptr = (short*)val;
+#endif
+
+ code = dnan(*sptr);
+ if( code==2 ) *val = 0.0; /* Underflow */
+
+ return( code!=0 );
+}
+FCALLSCFUN1(LOGICAL,Cdnan,FTTDNN,fttdnn,PDOUBLE)
+
+/*-------- Functions no longer supported... normally redundant -----------*/
+/* Included only to support older code */
+/*------------------------------------------------------------------------*/
+
+void Cffempty(void);
+void Cffempty(void)
+{ return; }
+FCALLSCSUB0(Cffempty,FTPDEF,ftpdef)
+FCALLSCSUB0(Cffempty,FTBDEF,ftbdef)
+FCALLSCSUB0(Cffempty,FTADEF,ftadef)
+FCALLSCSUB0(Cffempty,FTDDEF,ftddef)
+
+
+/*-------- Functions which use the lex and yacc/bison parser code -----------*/
+/*---------------------------------------------------------------------------*/
+
+#define fttexp_LONGV_A7 A3
+FCALLSCSUB8(fftexp,FTTEXP,fttexp,FITSUNIT,STRING,INT,PINT,PLONG,PINT,LONGV,PINT)
+
+#define ftfrow_LOGV_A6 A4
+FCALLSCSUB7(fffrow,FTFROW,ftfrow,FITSUNIT,STRING,LONG,LONG,PLONG,LOGICALV,PINT)
+
+#define ftfrwc_LOGV_A8 A6
+FCALLSCSUB9(fffrwc,FTFRWC,ftfrwc,FITSUNIT,STRING,STRING,STRING,STRING,LONG,DOUBLEV,LOGICALV,PINT)
+
+FCALLSCSUB4(ffsrow,FTSROW,ftsrow,FITSUNIT,FITSUNIT,STRING,PINT)
+FCALLSCSUB9(ffcrow,FTCROW,ftcrow,FITSUNIT,INT,STRING,LONG,LONG,PVOID,PVOID,PLOGICAL,PINT)
+FCALLSCSUB6(ffcalc,FTCALC,ftcalc,FITSUNIT,STRING,FITSUNIT,STRING,STRING,PINT)
+
+#define ftcalc_rng_LONGV_A7 A6
+#define ftcalc_rng_LONGV_A8 A6
+FCALLSCSUB9(ffcalc_rng,FTCALC_RNG,ftcalc_rng,FITSUNIT,STRING,FITSUNIT,STRING,STRING,INT,LONGV,LONGV,PINT)
+
+/*--------------------- grouping routines ------------------*/
+
+FCALLSCSUB4(ffgtcr,FTGTCR,ftgtcr,FITSUNIT,STRING,INT,PINT)
+FCALLSCSUB4(ffgtis,FTGTIS,ftgtis,FITSUNIT,STRING,INT,PINT)
+FCALLSCSUB3(ffgtch,FTGTCH,ftgtch,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtrm,FTGTRM,ftgtrm,FITSUNIT,INT,PINT)
+FCALLSCSUB4(ffgtcp,FTGTCP,ftgtcp,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB4(ffgtmg,FTGTMG,ftgtmg,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtcm,FTGTCM,ftgtcm,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtvf,FTGTVF,ftgtvf,FITSUNIT,PLONG,PINT)
+FCALLSCSUB4(ffgtop,FTGTOP,ftgtop,FITSUNIT,INT,PFITSUNIT,PINT)
+FCALLSCSUB4(ffgtam,FTGTAM,ftgtam,FITSUNIT,FITSUNIT,INT,PINT)
+FCALLSCSUB3(ffgtnm,FTGTNM,ftgtnm,FITSUNIT,PLONG,PINT)
+FCALLSCSUB3(ffgmng,FTGMNG,ftgmng,FITSUNIT,PLONG,PINT)
+FCALLSCSUB4(ffgmop,FTGMOP,ftgmop,FITSUNIT,LONG,PFITSUNIT,PINT)
+FCALLSCSUB5(ffgmcp,FTGMCP,ftgmcp,FITSUNIT,FITSUNIT,LONG,INT,PINT)
+FCALLSCSUB5(ffgmtf,FTGMTF,ftgmtf,FITSUNIT,FITSUNIT,LONG,INT,PINT)
+FCALLSCSUB4(ffgmrm,FTGMRM,ftgmrm,FITSUNIT,LONG,INT,PINT)