void cvgClose( fitsfile **fptr, int *status ){
DECLARE_INTEGER(FUNIT);
DECLARE_INTEGER(STATUS);
CVG_EXPORT_FITS( *fptr, FUNIT );
F77_EXPORT_INTEGER( *status, STATUS );
F77_LOCK( F77_CALL(cvg_close)( INTEGER_ARG(&FUNIT),
INTEGER_ARG(&STATUS) ); )
int main()
{
int j;
DECLARE_INTEGER(ni);
DECLARE_INTEGER(i);
DECLARE_INTEGER_ARRAY(ia,NI);
DECLARE_INTEGER(nr);
DECLARE_REAL(r);
DECLARE_REAL_ARRAY(ra,NR);
DECLARE_INTEGER(nd);
DECLARE_DOUBLE(d);
DECLARE_DOUBLE_ARRAY(da,ND);
DECLARE_INTEGER(nl);
DECLARE_LOGICAL(l);
DECLARE_LOGICAL_ARRAY(la,NL);
DECLARE_INTEGER(nb);
DECLARE_BYTE(b);
DECLARE_BYTE_ARRAY(ba,NB);
DECLARE_INTEGER(nw);
DECLARE_WORD(w);
DECLARE_WORD_ARRAY(wa,NW);
DECLARE_INTEGER(nub);
DECLARE_UBYTE(ub);
DECLARE_UBYTE_ARRAY(uba,NUB);
DECLARE_INTEGER(nuw);
DECLARE_UWORD(uw);
DECLARE_UWORD_ARRAY(uwa,NUW);
DECLARE_CHARACTER(c1f,80);
DECLARE_CHARACTER_ARRAY(caf,80,NC);
DECLARE_INTEGER(nc);
char c;
char c1c[81];
ni = NI;
nr = NR;
nd = ND;
nl = NL;
nb = NB;
nw = NW;
nub= NUB;
nuw = NUW;
printf( "--> This is a test of C calling FORTRAN\n" );
/* Initialise fortran run time library */
cnfInitRTL( 0, NULL );
/* Test the passing of int arguments */
for( j=0 ; j<ni ; j++ )
ia[j] = j+1;
F77_LOCK( F77_CALL(ti)( INTEGER_ARRAY_ARG(ia), INTEGER_ARG(&ni), INTEGER_ARG(&i) ); )
void call_dgels(char *trans, int m, int n, int nrhs,
double *a, int lda, double *b, int ldb,
double *work, int lwork, int *info) {
DECLARE_CHARACTER( TRANS, 1 );
DECLARE_INTEGER(M);
DECLARE_INTEGER(N);
DECLARE_INTEGER(NRHS);
DECLARE_INTEGER(LDA);
DECLARE_INTEGER(LDB);
DECLARE_INTEGER(LWORK);
DECLARE_INTEGER(INFO);
slaStringExport(trans, TRANS, 1);
M = m;
N = n;
NRHS = nrhs;
LDA = lda;
LDB = ldb;
LWORK = lwork;
F77_CALL(dgels)( CHARACTER_ARG(TRANS),
INTEGER_ARG(&M),
INTEGER_ARG(&N),
INTEGER_ARG(&NRHS),
DOUBLE_ARRAY_ARG(a),
INTEGER_ARG(&LDA),
DOUBLE_ARRAY_ARG(b),
INTEGER_ARG(&LDB),
DOUBLE_ARRAY_ARG(work),
INTEGER_ARG(&LWORK),
INTEGER_ARG(&INFO)
TRAIL_ARG(TRANS) );
*info = INFO;
}
void ndfAssoc( const char *param,
const char *mode,
int *indf,
int *status ) {
DECLARE_CHARACTER_DYN(fparam);
DECLARE_CHARACTER_DYN(fmode);
DECLARE_INTEGER(findf);
DECLARE_INTEGER(fstatus);
F77_CREATE_EXPORT_CHARACTER( param, fparam );
F77_CREATE_EXPORT_CHARACTER( mode, fmode );
F77_EXPORT_INTEGER( *status, fstatus );
F77_LOCK( F77_CALL(ndf_assoc)( CHARACTER_ARG(fparam),
CHARACTER_ARG(fmode),
INTEGER_ARG(&findf),
INTEGER_ARG(&fstatus)
TRAIL_ARG(fparam)
TRAIL_ARG(fmode) ); )
/* Define a function called ast_resample_ukern1 which has a suitable
interface to allow it to be passed as an interpolation function to
the C interface of astResample<X> in the case where the "interp"
parameter is set to AST__UKERN1. In turn, it invokes the equivalent
user-supplied FORTRAN 77 interpolation function, a pointer to which
should previously have been stored in the static variable
"ast_resample_FINTERP". */
static void ast_resample_ukern1( double offset, const double params[],
int flags, double *value ) {
DECLARE_INTEGER(STATUS);
int *status;
/* Obtain the C status and then invoke the FORTRAN 77 interpolation
function via the stored pointer. */
status = astGetStatusPtr;
STATUS = astStatus;
( *ast_resample_FINTERP )( DOUBLE_ARG(&offset),
DOUBLE_ARRAY_ARG(params),
INTEGER_ARG(&flags),
DOUBLE_ARG(value),
INTEGER_ARG(&STATUS) );
/* Set the C status to the returned FORTRAN 77 status. */
astSetStatus( STATUS );
}
void datAssoc( const char *param,
const char *access,
HDSLoc **loc,
int *status ) {
DECLARE_CHARACTER_DYN(PARAM);
DECLARE_CHARACTER_DYN(ACCESS);
DECLARE_CHARACTER(LOC,DAT__SZLOC);
DECLARE_INTEGER(STATUS);
F77_CREATE_EXPORT_CHARACTER( param, PARAM );
F77_CREATE_EXPORT_CHARACTER( access, ACCESS );
F77_EXPORT_INTEGER( *status, STATUS );
F77_LOCK( F77_CALL(dat_assoc)( CHARACTER_ARG(PARAM),
CHARACTER_ARG(ACCESS),
CHARACTER_ARG(LOC),
INTEGER_ARG(&STATUS)
TRAIL_ARG(PARAM)
TRAIL_ARG(ACCESS)
TRAIL_ARG(LOC) ); )
