mirror of
https://bitbucket.org/cosmicvoids/vide_public.git
synced 2025-07-04 15:21:11 +00:00
Imported Healpix, cfitsio, cosmotool. Added cmake tool to build dependencies (cfitsio, hdf5, netcdf, boost, healpix, gsl, ..). Adjusted CMakeLists.txt
This commit is contained in:
Guilhem Lavaux
parent
4bfb62f177
commit
51f6798f88
241 changed files with 243806 additions and 0 deletions
345
external/cfitsio/f77_wrap1.c
vendored
Normal file
345
external/cfitsio/f77_wrap1.c
vendored
Normal file
|
|
@ -0,0 +1,345 @@
|
|||
/************************************************************************
|
||||
|
||||
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"
|
||||
|
||||
unsigned long gMinStrLen=80L;
|
||||
fitsfile *gFitsFiles[MAXFITSFILES]={0};
|
||||
|
||||
/*---------------- Fortran Unit Number Allocation -------------*/
|
||||
|
||||
void Cffgiou( int *unit, int *status );
|
||||
void Cffgiou( int *unit, int *status )
|
||||
{
|
||||
int i;
|
||||
|
||||
if( *status>0 ) return;
|
||||
for( i=50;i<MAXFITSFILES;i++ ) /* Using a unit=0 sounds bad, so start at 1 */
|
||||
if( gFitsFiles[i]==NULL ) break;
|
||||
if( i==MAXFITSFILES ) {
|
||||
*unit = 0;
|
||||
*status = TOO_MANY_FILES;
|
||||
ffpmsg("Cffgiou has no more available unit numbers.");
|
||||
} else {
|
||||
*unit=i;
|
||||
gFitsFiles[i] = (fitsfile *)1; /* Flag it as taken until ftopen/init */
|
||||
/* can be called and set a real value */
|
||||
}
|
||||
}
|
||||
FCALLSCSUB2(Cffgiou,FTGIOU,ftgiou,PINT,PINT)
|
||||
|
||||
void Cfffiou( int unit, int *status );
|
||||
void Cfffiou( int unit, int *status )
|
||||
{
|
||||
if( *status>0 ) return;
|
||||
if( unit == -1 ) {
|
||||
int i; for( i=50; i<MAXFITSFILES; ) gFitsFiles[i++]=NULL;
|
||||
} else if( unit<1 || unit>=MAXFITSFILES ) {
|
||||
*status = BAD_FILEPTR;
|
||||
ffpmsg("Cfffiou was sent an unacceptable unit number.");
|
||||
} else gFitsFiles[unit]=NULL;
|
||||
}
|
||||
FCALLSCSUB2(Cfffiou,FTFIOU,ftfiou,INT,PINT)
|
||||
|
||||
|
||||
int CFITS2Unit( fitsfile *fptr )
|
||||
/* Utility routine to convert a fitspointer to a Fortran unit number */
|
||||
/* for use when a C program is calling a Fortran routine which could */
|
||||
/* in turn call CFITSIO... Modelled after code by Ning Gan. */
|
||||
{
|
||||
static fitsfile *last_fptr = (fitsfile *)NULL; /* Remember last fptr */
|
||||
static int last_unit = 0; /* Remember last unit */
|
||||
int status = 0;
|
||||
|
||||
/* Test whether we are repeating the last lookup */
|
||||
|
||||
if( last_unit && fptr==gFitsFiles[last_unit] )
|
||||
return( last_unit );
|
||||
|
||||
/* Check if gFitsFiles has an entry for this fptr. */
|
||||
/* Allows Fortran to call C to call Fortran to */
|
||||
/* call CFITSIO... OUCH!!! */
|
||||
|
||||
last_fptr = fptr;
|
||||
for( last_unit=1; last_unit<MAXFITSFILES; last_unit++ ) {
|
||||
if( fptr == gFitsFiles[last_unit] )
|
||||
return( last_unit );
|
||||
}
|
||||
|
||||
/* Allocate a new unit number for this fptr */
|
||||
Cffgiou( &last_unit, &status );
|
||||
if( status )
|
||||
last_unit = 0;
|
||||
else
|
||||
gFitsFiles[last_unit] = fptr;
|
||||
return( last_unit );
|
||||
}
|
||||
|
||||
|
||||
fitsfile* CUnit2FITS(int unit)
|
||||
{
|
||||
if( unit<1 || unit>=MAXFITSFILES )
|
||||
return(0);
|
||||
|
||||
return(gFitsFiles[unit]);
|
||||
}
|
||||
|
||||
/**************************************************/
|
||||
/* Start of wrappers for routines in fitsio.h */
|
||||
/**************************************************/
|
||||
|
||||
/*---------------- FITS file URL parsing routines -------------*/
|
||||
|
||||
FCALLSCSUB9(ffiurl,FTIURL,ftiurl,STRING,PSTRING,PSTRING,PSTRING,PSTRING,PSTRING,PSTRING,PSTRING,PINT)
|
||||
FCALLSCSUB3(ffrtnm,FTRTNM,ftrtnm,STRING,PSTRING,PINT)
|
||||
FCALLSCSUB3(ffexist,FTEXIST,ftexist,STRING,PINT,PINT)
|
||||
FCALLSCSUB3(ffextn,FTEXTN,ftextn,STRING,PINT,PINT)
|
||||
FCALLSCSUB7(ffrwrg,FTRWRG,ftrwrg,STRING,LONG,INT,PINT,PLONG,PLONG,PINT)
|
||||
|
||||
/*---------------- FITS file I/O routines ---------------*/
|
||||
|
||||
void Cffopen( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status );
|
||||
void Cffopen( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status )
|
||||
{
|
||||
int hdutype;
|
||||
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffopen( fptr, filename, iomode, status );
|
||||
ffmahd( *fptr, 1, &hdutype, status );
|
||||
*blocksize = 1;
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cffopen tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB5(Cffopen,FTOPEN,ftopen,PFITSUNIT,STRING,INT,PINT,PINT)
|
||||
|
||||
void Cffdkopn( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status );
|
||||
void Cffdkopn( fitsfile **fptr, const char *filename, int iomode, int *blocksize, int *status )
|
||||
{
|
||||
int hdutype;
|
||||
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffdkopn( fptr, filename, iomode, status );
|
||||
ffmahd( *fptr, 1, &hdutype, status );
|
||||
*blocksize = 1;
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cffdkopn tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB5(Cffdkopn,FTDKOPN,ftdkopn,PFITSUNIT,STRING,INT,PINT,PINT)
|
||||
|
||||
|
||||
void Cffnopn( fitsfile **fptr, const char *filename, int iomode, int *status );
|
||||
void Cffnopn( fitsfile **fptr, const char *filename, int iomode, int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffopen( fptr, filename, iomode, status );
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cffnopn tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cffnopn,FTNOPN,ftnopn,PFITSUNIT,STRING,INT,PINT)
|
||||
|
||||
void Cffdopn( fitsfile **fptr, const char *filename, int iomode, int *status );
|
||||
void Cffdopn( fitsfile **fptr, const char *filename, int iomode, int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffdopn( fptr, filename, iomode, status );
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cffdopn tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cffdopn,FTDOPN,ftdopn,PFITSUNIT,STRING,INT,PINT)
|
||||
|
||||
void Cfftopn( fitsfile **fptr, const char *filename, int iomode, int *status );
|
||||
void Cfftopn( fitsfile **fptr, const char *filename, int iomode, int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
fftopn( fptr, filename, iomode, status );
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cfftopn tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cfftopn,FTTOPN,fttopn,PFITSUNIT,STRING,INT,PINT)
|
||||
|
||||
void Cffiopn( fitsfile **fptr, const char *filename, int iomode, int *status );
|
||||
void Cffiopn( fitsfile **fptr, const char *filename, int iomode, int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffiopn( fptr, filename, iomode, status );
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cffiopn tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cffiopn,FTIOPN,ftiopn,PFITSUNIT,STRING,INT,PINT)
|
||||
|
||||
void Cffreopen( fitsfile *openfptr, fitsfile **newfptr, int *status );
|
||||
void Cffreopen( fitsfile *openfptr, fitsfile **newfptr, int *status )
|
||||
{
|
||||
if( *newfptr==NULL || *newfptr==(fitsfile*)1 ) {
|
||||
ffreopen( openfptr, newfptr, status );
|
||||
} else {
|
||||
*status = FILE_NOT_OPENED;
|
||||
ffpmsg("Cffreopen tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB3(Cffreopen,FTREOPEN,ftreopen,FITSUNIT,PFITSUNIT,PINT)
|
||||
|
||||
void Cffinit( fitsfile **fptr, const char *filename, int blocksize, int *status );
|
||||
void Cffinit( fitsfile **fptr, const char *filename, int blocksize, int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffinit( fptr, filename, status );
|
||||
} else {
|
||||
*status = FILE_NOT_CREATED;
|
||||
ffpmsg("Cffinit tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cffinit,FTINIT,ftinit,PFITSUNIT,STRING,INT,PINT)
|
||||
|
||||
void Cffdkinit( fitsfile **fptr, const char *filename, int blocksize, int *status );
|
||||
void Cffdkinit( fitsfile **fptr, const char *filename, int blocksize, int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
ffdkinit( fptr, filename, status );
|
||||
} else {
|
||||
*status = FILE_NOT_CREATED;
|
||||
ffpmsg("Cffdkinit tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cffdkinit,FTDKINIT,ftdkinit,PFITSUNIT,STRING,INT,PINT)
|
||||
|
||||
void Cfftplt( fitsfile **fptr, const char *filename, const char *tempname,
|
||||
int *status );
|
||||
void Cfftplt( fitsfile **fptr, const char *filename, const char *tempname,
|
||||
int *status )
|
||||
{
|
||||
if( *fptr==NULL || *fptr==(fitsfile*)1 ) {
|
||||
fftplt( fptr, filename, tempname, status );
|
||||
} else {
|
||||
*status = FILE_NOT_CREATED;
|
||||
ffpmsg("Cfftplt tried to use an already opened unit.");
|
||||
}
|
||||
}
|
||||
FCALLSCSUB4(Cfftplt,FTTPLT,fttplt,PFITSUNIT,STRING,STRING,PINT)
|
||||
|
||||
FCALLSCSUB2(ffflus,FTFLUS,ftflus,FITSUNIT,PINT)
|
||||
FCALLSCSUB3(ffflsh,FTFLSH,ftflsh,FITSUNIT, INT, PINT)
|
||||
|
||||
void Cffclos( int unit, int *status );
|
||||
void Cffclos( int unit, int *status )
|
||||
{
|
||||
if( gFitsFiles[unit]!=NULL && gFitsFiles[unit]!=(void*)1 ) {
|
||||
ffclos( gFitsFiles[unit], status ); /* Flag unit number as unavailable */
|
||||
gFitsFiles[unit]=(fitsfile*)1; /* in case want to reuse it */
|
||||
}
|
||||
}
|
||||
FCALLSCSUB2(Cffclos,FTCLOS,ftclos,INT,PINT)
|
||||
|
||||
void Cffdelt( int unit, int *status );
|
||||
void Cffdelt( int unit, int *status )
|
||||
{
|
||||
if( gFitsFiles[unit]!=NULL && gFitsFiles[unit]!=(void*)1 ) {
|
||||
ffdelt( gFitsFiles[unit], status ); /* Flag unit number as unavailable */
|
||||
gFitsFiles[unit]=(fitsfile*)1; /* in case want to reuse it */
|
||||
}
|
||||
}
|
||||
FCALLSCSUB2(Cffdelt,FTDELT,ftdelt,INT,PINT)
|
||||
|
||||
FCALLSCSUB3(ffflnm,FTFLNM,ftflnm,FITSUNIT,PSTRING,PINT)
|
||||
FCALLSCSUB3(ffflmd,FTFLMD,ftflmd,FITSUNIT,PINT,PINT)
|
||||
|
||||
/*--------------- utility routines ---------------*/
|
||||
FCALLSCSUB1(ffvers,FTVERS,ftvers,PFLOAT)
|
||||
FCALLSCSUB1(ffupch,FTUPCH,ftupch,PSTRING)
|
||||
FCALLSCSUB2(ffgerr,FTGERR,ftgerr,INT,PSTRING)
|
||||
FCALLSCSUB1(ffpmsg,FTPMSG,ftpmsg,STRING)
|
||||
FCALLSCSUB1(ffgmsg,FTGMSG,ftgmsg,PSTRING)
|
||||
FCALLSCSUB0(ffcmsg,FTCMSG,ftcmsg)
|
||||
FCALLSCSUB0(ffpmrk,FTPMRK,ftpmrk)
|
||||
FCALLSCSUB0(ffcmrk,FTCMRK,ftcmrk)
|
||||
|
||||
void Cffrprt( char *fname, int status );
|
||||
void Cffrprt( char *fname, int status )
|
||||
{
|
||||
if( !strcmp(fname,"STDOUT") || !strcmp(fname,"stdout") )
|
||||
ffrprt( stdout, status );
|
||||
else if( !strcmp(fname,"STDERR") || !strcmp(fname,"stderr") )
|
||||
ffrprt( stderr, status );
|
||||
else {
|
||||
FILE *fptr;
|
||||
|
||||
fptr = fopen(fname, "a");
|
||||
if (fptr==NULL)
|
||||
printf("file pointer is null.\n");
|
||||
else {
|
||||
ffrprt(fptr,status);
|
||||
fclose(fptr);
|
||||
}
|
||||
}
|
||||
}
|
||||
FCALLSCSUB2(Cffrprt,FTRPRT,ftrprt,STRING,INT)
|
||||
|
||||
FCALLSCSUB5(ffcmps,FTCMPS,ftcmps,STRING,STRING,LOGICAL,PLOGICAL,PLOGICAL)
|
||||
FCALLSCSUB2(fftkey,FTTKEY,fttkey,STRING,PINT)
|
||||
FCALLSCSUB2(fftrec,FTTREC,fttrec,STRING,PINT)
|
||||
FCALLSCSUB2(ffnchk,FTNCHK,ftnchk,FITSUNIT,PINT)
|
||||
FCALLSCSUB4(ffkeyn,FTKEYN,ftkeyn,STRING,INT,PSTRING,PINT)
|
||||
FCALLSCSUB4(ffgknm,FTGKNM,ftgknm,STRING,PSTRING, PINT, PINT)
|
||||
FCALLSCSUB4(ffnkey,FTNKEY,ftnkey,INT,STRING,PSTRING,PINT)
|
||||
FCALLSCSUB3(ffdtyp,FTDTYP,ftdtyp,STRING,PSTRING,PINT)
|
||||
FCALLSCFUN1(INT,ffgkcl,FTGKCL,ftgkcl,STRING)
|
||||
FCALLSCSUB4(ffpsvc,FTPSVC,ftpsvc,STRING,PSTRING,PSTRING,PINT)
|
||||
FCALLSCSUB4(ffgthd,FTGTHD,ftgthd,STRING,PSTRING,PINT,PINT)
|
||||
FCALLSCSUB5(ffasfm,FTASFM,ftasfm,STRING,PINT,PLONG,PINT,PINT)
|
||||
FCALLSCSUB5(ffbnfm,FTBNFM,ftbnfm,STRING,PINT,PLONG,PLONG,PINT)
|
||||
|
||||
#define ftgabc_STRV_A2 NUM_ELEM_ARG(1)
|
||||
#define ftgabc_LONGV_A5 A1
|
||||
FCALLSCSUB6(ffgabc,FTGABC,ftgabc,INT,STRINGV,INT,PLONG,LONGV,PINT)
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue