/* @(#)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 /* */ 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 ); } 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 ); } ROUTINE COPYF2( value, pntrB, npixB, bgnB, dimwB ) float *value; float *pntrB; fint2c *npixB; fint2c *bgnB; fint2c *dimwB; { Ccopyf2( *value, pntrB, npixB, bgnB, dimwB ); } ROUTINE COPYF( pntrA, pntrB, dim ) float *pntrA; float *pntrB; fint2c *dim; { Ccopyf( pntrA, pntrB, *dim ); } ROUTINE COPYI( pntrA, pntrB, dim ) fint2c *pntrA; fint2c *pntrB; fint2c *dim; { Ccopyi( pntrA, pntrB, *dim ); } ROUTINE CONFIL( value, pntrB, dim ) float *value; float *pntrB; fint2c *dim; { Cconfil( *value, pntrB, *dim ); } ROUTINE COPYFX( pntrA, imni, imno, npix, istrip ) float *pntrA; fint2c *imni; fint2c *imno; fint2c *npix; fint2c *istrip; { Ccopyfx( pntrA, *imni, *imno, npix, *istrip ); } SUBROUTINE FRAMOU( frame ) CHARACTER frame; { FRAMOU_C(STRIPPED_STRING(frame)); } /* */ 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 ); } 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; { int npix[2], imap[4]; float xypos[2], xyerr[2], xysig[2]; npix[0] = *dimx; npix[1] = *dimy; imap[0] = image[0] - 1; imap[1] = image[1] - 1; imap[2] = image[2] - 1; imap[3] = image[3] - 1; *stat = Cstacen(STRIPPED_STRING(meth), p_img, npix, imap, xypos, xyerr, xysig, xyval ); *xout = xypos[0] + 1; *yout = xypos[1] + 1; *xerr = xyerr[0]; *yerr = xyerr[1]; *xsig = xysig[0]; *ysig = xysig[1]; } 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 */ } ROUTINE CPOWER(xa, xb, xc) float *xa; float *xb; float *xc; { MyPower(xa,xb,xc); } 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); } 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 ); } /* */ SUBROUTINE OPNTAB( table, tid, ncols, nrows, stat ) CHARACTER table; fint2c *tid; fint2c *ncols; fint2c *nrows; fint2c *stat; { *stat = 0; OPNTBL(CHAR_LOC(table),tid,ncols,nrows); } 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]; } } SUBROUTINE BLDLUT(table,rlut,stat) CHARACTER table; float *rlut; fint2c *stat; { float mylut[3*LUTSIZE]; int range[2]; *stat = 0; worky(mylut,rlut); /* no index massaging of MACRO stuff...! */ range[0] = 0; range[1] = 1; CRELUT(CHAR_LOC(table),mylut,LUTSIZE,0,range); } SUBROUTINE BLDITT( table, ritt, stat ) CHARACTER table; float *ritt; fint2c *stat; { *stat = 0; CREITT( CHAR_LOC( table ), ritt ); } /* */ 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; { ReadASCI(STRIPPED_STRING(infile),*dattyp,*total,a,b,*minflg,fmin,fmax); } ROUTINE HACKUP(npix, pix_form, retbuf) fint2c *npix; fint2c *pix_form; fint2c *retbuf; { void hack_up(); hack_up(npix,*pix_form,retbuf); }