From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- vendor/cfitsio/f77_wrap2.c | 711 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 711 insertions(+) create mode 100644 vendor/cfitsio/f77_wrap2.c (limited to 'vendor/cfitsio/f77_wrap2.c') diff --git a/vendor/cfitsio/f77_wrap2.c b/vendor/cfitsio/f77_wrap2.c new file mode 100644 index 00000000..8b7de365 --- /dev/null +++ b/vendor/cfitsio/f77_wrap2.c @@ -0,0 +1,711 @@ +/************************************************************************ + + f77_wrap1.c and f77_wrap2.c have now been split into 4 files to + prevent compile-time memory errors (from expansion of compiler commands). + f77_wrap1.c was split into f77_wrap1.c and f77_wrap3.c, and + f77_wrap2.c was split into f77_wrap2.c and f77_wrap4.c: + + f77_wrap1.c contains routines operating on whole files and some + utility routines. + + f77_wrap2.c contains routines operating on primary array, image, + or column elements. + + f77_wrap3.c contains routines operating on headers & keywords. + + f77_wrap4.c contains miscellaneous routines. + + Peter's original comments: + + 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" + + +FCALLSCSUB5(ffgextn,FTGEXTN,ftgextn,FITSUNIT,LONG,LONG,BYTEV,PINT) +FCALLSCSUB5(ffpextn,FTPEXTN,ftpextn,FITSUNIT,LONG,LONG,BYTEV,PINT) + +/*------------ 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(ffgpvjj,FTGPVK,ftgpvk,FITSUNIT,LONG,LONG,LONG,LONGLONG,LONGLONGV,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(ffgpfjj,FTGPFK,ftgpfk,FITSUNIT,LONG,LONG,LONG,LONGLONGV,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(ffg2djj,FTG2DK,ftg2dk,FITSUNIT,LONG,LONGLONG,LONG,LONG,LONG,LONGLONGV,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(ffg3djj,FTG3DK,ftg3dk,FITSUNIT,LONG,LONGLONG,LONG,LONG,LONG,LONG,LONG,LONGLONGV,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(ffgsvjj,FTGSVK,ftgsvk,FITSUNIT,INT,INT,LONGV,LONGV,LONGV,LONGV,LONGLONG,LONGLONGV,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