#define vmr vmr_ /* parameter for Name Translation is l_ */ #define ROUTINE int /* @(#)f2cgen.fc 17.1.1.1 (ESO-DMD) 01/25/02 17:40:34 */ /*=========================================================================== Copyright (C) 1995 European Southern Observatory (ESO) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. Correspondence concerning ESO-MIDAS should be addressed as follows: Internet e-mail: midas@eso.org Postal address: European Southern Observatory Data Management Division Karl-Schwarzschild-Strasse 2 D 85748 Garching bei Muenchen GERMANY ===========================================================================*/ /* +++++++++++++++++++++++++ f2cgen.fc +++++++++++++++++++++++++++++ .LANGUAGE C .AUTHOR K. Banse ESO - IPG, Garching .IDENT Module F2CGEN.FC .PURPUSE fortran to C interfaces for general routines .VERSION [1.00] 940327 .VERSION [1.10] 941021: fix PIXLIN interface ------------------------------------------------------------------------*/ #include #include #include #define LUTSIZE 256 /* */ #define COPWND copwnd_ ROUTINE COPWND( pntrA, npixA, pntrB, npixB, bgnA, bgnB, endA ) float *pntrA; fint2c *npixA; float *pntrB; fint2c *npixB; fint2c *bgnA; fint2c *bgnB; fint2c *endA; { Ccopwnd( pntrA, npixA, pntrB, npixB, bgnA, bgnB, endA ); } #define COPYF1 copyf1_ ROUTINE COPYF1( pntrA, npixA, bgnA, dimwA, pntrB, npixB, bgnB ) float *pntrA; fint2c *npixA; fint2c *bgnA; fint2c *dimwA; float *pntrB; fint2c *npixB; fint2c *bgnB; { Ccopyf1( pntrA, npixA, bgnA, dimwA, pntrB, npixB, bgnB ); } #define COPYF2 copyf2_ ROUTINE COPYF2( value, pntrB, npixB, bgnB, dimwB ) float *value; float *pntrB; fint2c *npixB; fint2c *bgnB; fint2c *dimwB; { Ccopyf2( *value, pntrB, npixB, bgnB, dimwB ); } #define COPYF copyf_ ROUTINE COPYF( pntrA, pntrB, dim ) float *pntrA; float *pntrB; fint2c *dim; { Ccopyf( pntrA, pntrB, *dim ); } #define COPYI copyi_ ROUTINE COPYI( pntrA, pntrB, dim ) fint2c *pntrA; fint2c *pntrB; fint2c *dim; { Ccopyi( pntrA, pntrB, *dim ); } #define CONFIL confil_ ROUTINE CONFIL( value, pntrB, dim ) float *value; float *pntrB; fint2c *dim; { Cconfil( *value, pntrB, *dim ); } #define COPYFX copyfx_ ROUTINE COPYFX( pntrA, imni, imno, npix, istrip ) float *pntrA; fint2c *imni; fint2c *imno; fint2c *npix; fint2c *istrip; { Ccopyfx( pntrA, *imni, *imno, npix, *istrip ); } #if 0 /* ==== Original Code ==== */ SUBROUTINE FRAMOU( frame ) CHARACTER frame; #else /* ==== Generated Code === */ #define FRAMOU framou_ FRAMOU(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ FRAMOU_C(STRIPPED_STRING(1,1,0)); ftoc_free(FORmark); /* */ } /* */ #define JMAGN jmagn_ ROUTINE JMAGN( jmeth, arr, nx, ny, ni, nb, fac, xc, yc, mag, dmag, sky, dsky, nrpix, flux, stat ) fint2c *jmeth; float *arr; fint2c *nx; fint2c *ny; fint2c *ni; fint2c *nb; float *fac; float *xc; float *yc; float *mag; float *dmag; float *sky; float *dsky; float *nrpix; float *flux; fint2c *stat; { int npix[2]; float xycen[2]; npix[0] = *nx; npix[1] = *ny; xycen[0] = *xc - 1.0; /* use C indexing for Cjmagn */ xycen[1] = *yc - 1.0; *stat = Cjmagn(*jmeth, arr, npix, *ni, *nb, fac, xycen, mag, dmag, sky, dsky, nrpix, flux ); } #if 0 /* ==== Original Code ==== */ SUBROUTINE STACEN(p_img, dimx, dimy, meth, image, xout, yout, xerr, yerr, xsig, ysig, xyval, stat ) float *p_img; fint2c *dimx; fint2c *dimy; CHARACTER meth; fint2c *image; float *xout; float *yout; float *xerr; float *yerr; float *xsig; float *ysig; float *xyval; fint2c *stat; #else /* ==== Generated Code === */ #define STACEN stacen_ STACEN(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ int npix[2], imap[4]; float xypos[2], xyerr[2], xysig[2]; va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ npix[0] = *PARAM(2,13,0,fint2c *); npix[1] = *PARAM(3,13,0,fint2c *); imap[0] =PARAM(5,13,1,fint2c *)[0] - 1; imap[1] =PARAM(5,13,1,fint2c *)[1] - 1; imap[2] =PARAM(5,13,1,fint2c *)[2] - 1; imap[3] =PARAM(5,13,1,fint2c *)[3] - 1; *PARAM(13,13,1,fint2c *) = Cstacen(STRIPPED_STRING(4,13,0),PARAM(1,13,0,float *), npix, imap, xypos, xyerr, xysig,PARAM(12,13,1,float *) ); *PARAM(6,13,1,float *) = xypos[0] + 1; *PARAM(7,13,1,float *) = xypos[1] + 1; *PARAM(8,13,1,float *) = xyerr[0]; *PARAM(9,13,1,float *) = xyerr[1]; *PARAM(10,13,1,float *) = xysig[0]; *PARAM(11,13,1,float *) = xysig[1]; ftoc_free(FORmark); /* */ } #define FPXWCO fpxwco_ ROUTINE FPXWCO(flag,imno,ccin,ccout,stat) fint2c *flag; /* 0: init, 1: fp -> wc, -1: wc -> fp */ fint2c *imno; /* only used for flag = 0 */ double *ccin; /* fp's (1) or wc's (-1) */ double *ccout; /* wc's (-1) or fp's (1) */ fint2c *stat; /* 0 = o.k. for flag != 0 0 or -1 for flag=0 to tell, if non- or linear coord system > 0 if error for all flags */ { *stat = fp2wc(*flag,*imno,ccin,ccout); /* in file wrldco.c */ } #define CPOWER cpower_ ROUTINE CPOWER(xa, xb, xc) float *xa; float *xb; float *xc; { MyPower(xa,xb,xc); } #define PIXLIN pixlin_ ROUTINE PIXLIN(xa, ya, xb, yb, step, xindx, yindx, limit, nindx ) float *xa; float *xb; float *ya; float *yb; float *step; fint2c *limit; float *xindx; float *yindx; fint2c *nindx; { double dstep = *step; *nindx = Cpixlin(*xa,*ya,*xb,*yb,dstep,*limit,xindx,yindx); } #define ZIMA zima_ ROUTINE ZIMA(p_in, npix, xindx, yindx, ndim, p_out, fmin, fmax ) float *p_in; fint2c *npix; float *xindx; float *yindx; fint2c *ndim; float *p_out; float *fmin; float *fmax; { Czima( p_in, npix, xindx, yindx, *ndim, p_out, fmin, fmax ); } /* */ #if 0 /* ==== Original Code ==== */ SUBROUTINE OPNTAB( table, tid, ncols, nrows, stat ) CHARACTER table; fint2c *tid; fint2c *ncols; fint2c *nrows; fint2c *stat; #else /* ==== Generated Code === */ #define OPNTAB opntab_ OPNTAB(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ *PARAM(5,5,1,fint2c *) = 0; OPNTBL(CHAR_LOC(1,5,0),PARAM(2,5,1,fint2c *),PARAM(3,5,1,fint2c *),PARAM(4,5,1,fint2c *)); ftoc_free(FORmark); /* */ } static void worky(mlut,qlut) float *mlut, *qlut; { register int jin, jout, jouta, joutb; jout = 0; jouta = LUTSIZE; joutb = LUTSIZE + LUTSIZE; for (jin=0; jin<3*LUTSIZE; jin+=3) { mlut[jout++] = qlut[jin]; mlut[jouta++] = qlut[jin+1]; mlut[joutb++] = qlut[jin+2]; } } #if 0 /* ==== Original Code ==== */ SUBROUTINE BLDLUT(table,rlut,stat) CHARACTER table; float *rlut; fint2c *stat; #else /* ==== Generated Code === */ #define BLDLUT bldlut_ BLDLUT(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ float mylut[3*LUTSIZE]; int range[2]; va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ *PARAM(3,3,1,fint2c *) = 0; worky(mylut,PARAM(2,3,1,float *)); /* no index massaging of MACRO stuff...! */ range[0] = 0; range[1] = 1; CRELUT(CHAR_LOC(1,3,0),mylut,LUTSIZE,0,range); ftoc_free(FORmark); /* */ } #if 0 /* ==== Original Code ==== */ SUBROUTINE BLDITT( table, ritt, stat ) CHARACTER table; float *ritt; fint2c *stat; #else /* ==== Generated Code === */ #define BLDITT blditt_ BLDITT(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ *PARAM(3,3,1,fint2c *) = 0; CREITT( CHAR_LOC(1,3,0 ),PARAM(2,3,1,float *) ); ftoc_free(FORmark); /* */ } /* */ #if 0 /* ==== Original Code ==== */ SUBROUTINE DATFIL(infile,dattyp,total,a,b,minflg,fmin,fmax) CHARACTER infile; fint2c *dattyp; fint2c *total; float *a; fint2c *b; fint2c *minflg; float *fmin; float *fmax; #else /* ==== Generated Code === */ #define DATFIL datfil_ DATFIL(va_alist) va_dcl { va_list Cargs; #endif /* ======================= */ int FORmark; /* */ va_start(Cargs); /* */ FORmark = ftoc_mark(); /* */ ReadASCI(STRIPPED_STRING(1,8,0),*PARAM(2,8,1,fint2c *),*PARAM(3,8,1,fint2c *),PARAM(4,8,1,float *),PARAM(5,8,1,fint2c *),*PARAM(6,8,1,fint2c *),PARAM(7,8,1,float *),PARAM(8,8,1,float *)); ftoc_free(FORmark); /* */ } #define HACKUP hackup_ ROUTINE HACKUP(npix, pix_form, retbuf) fint2c *npix; fint2c *pix_form; fint2c *retbuf; { void hack_up(); hack_up(npix,*pix_form,retbuf); }