/* ==========================================================================
 Copyright (C) 1995-2007 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
========================================================================== */
 
/* ++++++++++++++++++++++++++++++++++++++++++++++++++

.IDENTIFICATION
  holds:	OpFrameCons	OpFrameFrame
		Func1Frame	Func2Frame	Func2FrameCon
.AUTHOR
  K. Banse                        ESO - Garching
.KEYWORDS
  bulk data frames, arithmetic operations
.PURPOSE
  perform arithmetic on arrays
.ALGORITHM
  do it according to opcode ( `, +, -, *, / or =)
  ` means ** (to the power of)

.VERSION
 070702		last modif
 -------------------------------------------------- */
 
#include <math.h>
#include <midas_def.h>

#define EPS  10.0e-33

#define MYABS(x)  ((x) < 0 ? -(x) : (x))

int  OpFrameCons(), OpFrameFrame(), Func1Frame(), Func2Frame(),
     Func2FrameCon(), DOpFrameCons(), DOpFrameFrame(), DFunc1Frame(),
     DFunc2Frame(), DFunc2FrameCon();

/*

*/

#ifdef __STDC__
int OpFrameCons(char *opcode, float *a, float *rc, float *c, 
                int ndim, float *usrn)

#else
int OpFrameCons(opcode, a, rc, c, ndim, usrn)
char  *opcode;	/* IN: operation */
float *a;	/* IN: input array */
float *rc;	/* IN: constant */
float *c;	/* OUT: output array */
int   ndim;	/* IN: size of array */
float *usrn;	/* IN: user Null value */
#endif


{
int   ncount;
register int  nr;
 
float  rt, scalr, usrnul;
register float *fpa, *fpc;

double dt;


scalr = *rc;
usrnul = *usrn;

 
 
fpa = a; fpc = c; 
ncount = 0;			/* counter for null vals */

  
/*  subtract operands */
  
if (opcode[2] == '-')
   {
   if (opcode[0] == 'C')
      {
      if (MYABS(scalr) > EPS) 
         {
         for (nr=0; nr<ndim; nr++) *fpc++ = scalr - (*fpa++);
         }
      else
         {				/* 0. - C(n)  */
         for (nr=0; nr<ndim; nr++) *fpc++ = -(*fpa++);
         }
      }
   else
      {
      if (MYABS(scalr) > EPS) 
         {
         for (nr=0; nr<ndim; nr++) *fpc++ = (*fpa++) - scalr;
         }
      else
         {				/* C(n) - 0.  */
         for (nr=0; nr<ndim; nr++) *fpc++ = *fpa++;
         }
      }
   }

/*  add operands */
 
else if (opcode[2] == '+') 
   {
   if (MYABS(scalr) > EPS)
      {
      for (nr=0; nr<ndim; nr++) *fpc++ = (*fpa++) + scalr;
      }
   else
      {					/* C(n) + 0. */
      for (nr=0; nr<ndim; nr++) *fpc++ = *fpa++;
      }
   }
 
/*  divide operands */
  
else if (opcode[2] == '/')
   {
   if (opcode[0] == 'C')
      {
      for (nr=0; nr<ndim; nr++)
         {
         rt = *fpa++;
         if (MYABS(rt) < EPS) 
            {
            *fpc++ = usrnul;
            ncount ++;
            }
         else
            *fpc++ = scalr / rt;
         }
      }
   else
      { 
      float  aa;

      aa = MYABS(scalr);
      if (aa < EPS)
         {
         ncount = ndim;
         for (nr=0; nr<ndim; nr++) *fpc++ = usrnul;
         }
      else
         {
         rt = aa - 1.0;		/* is constant = 1.0? */
         if (MYABS(rt) < EPS)
            {
            if (scalr < 0)		/* -1.0 */
               {
               for (nr=0; nr<ndim; nr++) *fpc++ = -(*fpa++);
               }
            else			/* +1.0 */
               {
               for (nr=0; nr<ndim; nr++) *fpc++ = *fpa++;
               }
            }
         else
            {
            rt = 1.0 / scalr;
            for (nr=0; nr<ndim; nr++) *fpc++ =  rt * (*fpa++);
            }
         }
      }
   }
 
/*   multiply operands */
  
else if (opcode[2] == '*')
   {
   float  aa;

   aa = MYABS(scalr);
   if (aa < EPS)
      {
      for (nr=0; nr<ndim; nr++) *fpc++ = 0.0;
      }
   else
      {
      rt = aa - 1.0;              /* is constant = 1.0? */
      if (MYABS(rt) < EPS)
         {
         if (scalr < 0)              /* -1.0 */
            {
            for (nr=0; nr<ndim; nr++) *fpc++ = -(*fpa++);
            }
         else                        /* +1.0 */
            {
            for (nr=0; nr<ndim; nr++) *fpc++ = *fpa++;
            }
         }
      else
         {
         for (nr=0; nr<ndim; nr++) *fpc++ =  scalr * (*fpa++);
         }
      }
   }

/*  copy constant */
 
else if (opcode[2] == '=')
   {
   for (nr=0; nr<ndim; nr++) *fpc++ =  scalr;
   }
 
/*   compute 1. operand ** 2. operand */
  
else if (opcode[2] == '`')
   {
   dt = (double) scalr;
   if (opcode[0] == 'C')
      {
      for (nr=0; nr<ndim; nr++)
         {
         *fpc++ = (float) pow(dt,(double)(*fpa++));
         }
      }
   else
      {
      if (MYABS(scalr) > EPS)
         {
         for (nr=0; nr<ndim; nr++)
            *fpc++ = (float) pow((double) (*fpa++),dt);
         } 
      else 
         {
         for (nr=0; nr<ndim; nr++) *fpc++ = 1.0;
         } 
      }
   }

return (ncount);
}
/*

*/

#ifdef __STDC__
int OpFrameFrame(char *opcode, float *a, float *b, float *c,
                int ndim, float *usrn)

#else
int OpFrameFrame(opcode, a, b, c, ndim, usrn)
char  *opcode;  /* IN: operation */
float *a;       /* IN: input array */
float *b;	/* IN: input array */
float *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
int   ncount;
register int  nr;

float  usrnul;
register float rt, *fpa, *fpb, *fpc;




usrnul = *usrn;
fpa = a; fpb = b; fpc = c;
ncount = 0;                     /* counter for null vals */



/*  add frames */

if (opcode[2] == '+')
   {
   for (nr=0; nr<ndim; nr++) *fpc++ = (*fpa++) + (*fpb++);
   }

/*  subtract 2. frame from 1. frame */

else if (opcode[2] == '-')
   {
   for (nr=0; nr<ndim; nr++) *fpc++ = (*fpa++) - (*fpb++);
   }

/*  multiply frames */

else if (opcode[2] == '*')
   {
   for (nr=0; nr<ndim; nr++) *fpc++ = (*fpa++) * (*fpb++);
   }

/*  divide 1. frame by 2. frame */

else if (opcode[2] == '/')
   {
   for (nr=0; nr<ndim; nr++)
      {
      rt = *fpb++;
      if (MYABS(rt) < EPS)
         {
         *fpc++ = usrnul;
         fpa++;				/* also increment 1. input frame */
         ncount ++;
         }
      else
         *fpc++ = (*fpa++) / rt;
      }
   }

/*  copy 1. frame into result frame */

else if (opcode[2] == '=')
   {
   for (nr=0; nr<ndim; nr++) *fpc++ =  *fpa++;
   }

/*  compute 1. frame ** 2. frame */

else if (opcode[2] == '`')
   {
   for (nr=0; nr<ndim; nr++)
      {
      *fpc++ = (float) pow((double)(*fpa++),(double)(*fpb++));
      }
   }

return ncount;
}
/*

*/

#ifdef __STDC__
int Func1Frame(char *cfunc, float *a, float *c, int ndim, float *usrn)

#else
int Func1Frame(cfunc, a, c, ndim, usrn)
char  *cfunc;  /* IN: operation */
float *a;       /* IN: input array */
float *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
int  it, ncount;
register int nr;

register double  dt, fact;

float  usrnul, ffact;
register float  rt, *fpa, *fpc;





usrnul = *usrn;
fpa = a; fpc = c;
ncount = 0;



/*  branch according to function */
 

if ((cfunc[0] == 'S') && (cfunc[1] == 'Q'))
   {						/* sqrt */
   for (nr=0; nr<ndim; nr++) 
      {
      rt = (*fpa++);
      if (rt > 0.0)
         *fpc++ = (float) sqrt((double) rt);
      else
         {
         if (rt < 0.0)
            {
            *fpc++ = usrnul;
            ncount ++;
            }
         else
            *fpc++ = 0.0;
         }
      }
   }

else if ((cfunc[0] == 'L') && (cfunc[1] == 'N'))
   {						/* ln */
   for (nr=0; nr<ndim; nr++) 
      {
      rt = (*fpa++);
      if (rt <= 0.0)
         {
         *fpc++ = usrnul;
         ncount ++;
         }
      else
         *fpc++ = (float) log((double)rt);
      }
   }


else if ((cfunc[0] == 'L') && (cfunc[1] == 'O'))
   {						/* log or log10 */
   for (nr=0; nr<ndim; nr++) 
      {
      rt = (*fpa++);
      if (rt <= 0.0)
         {
         *fpc++ = usrnul;
         ncount ++;
         }
      else
         *fpc++ = (float) log10((double)rt);
      }
   }


else if ((cfunc[0] == 'E') && (cfunc[1] == 'X'))
   {                                            /* exp or exp10 */
   if (cfunc[3] != '1')
      {
      for (nr=0; nr<ndim; nr++)
         *fpc++ = (float) exp((double)(*fpa++));
      }
   else
      {
      dt = log(10.0);			/* use: 10**x = e**(x*ln(10))  */
      for (nr=0; nr<ndim; nr++)
         {
         *fpc++ = (float) exp((double)(*fpa++) * dt);
         }
      }
   }

else if ((cfunc[0] == 'I') && (cfunc[1] == 'N'))
   {                                            /* int is as NINT */
   for (nr=0; nr<ndim; nr++)
      {
      it = (int) ((*fpa++) + 0.5);
      *fpc++ = (float) it;
      }
   }
 
else if ((cfunc[0] == 'A') && (cfunc[1] == 'B'))
   {                                            /* abs */
   for (nr=0; nr<ndim; nr++)
      {
      rt = *fpa++;
      *fpc++ = MYABS(rt);
      }
   }

else
   {
   if (cfunc[0] == 'A') 
      {
      ffact = 180.0 / M_PI;

      if (cfunc[1] == 'S')
         {                                            /* arc sin */
         for (nr=0; nr<ndim; nr++)
            {
            *fpc++ = ffact * (float) asin((double)(*fpa++));
            }
         }
      else if (cfunc[1] == 'C')
         {                                            /* arc cos */
         for (nr=0; nr<ndim; nr++)
            {
            *fpc++ = ffact * (float) acos((double)(*fpa++));
            }
         }
      else if (cfunc[1] == 'T')
         {                                            /* arc tan */
         for (nr=0; nr<ndim; nr++)
            {
            *fpc++ = ffact * (float) atan((double)(*fpa++));
            }
         }
      }
   else
      {
      fact  = M_PI / 180.0;
 
      if (cfunc[0] == 'S') 
         {                                            /* sin */
         for (nr=0; nr<ndim; nr++)
            {
            *fpc++ = (float) sin((double)(*fpa++) * fact);
            }
         }
      else if (cfunc[0] == 'C') 
         {                                            /* cos */
         for (nr=0; nr<ndim; nr++)
            {
            *fpc++ = (float) cos((double)(*fpa++) * fact);
            }
         }
      else if (cfunc[0] == 'T') 
         {                                            /* tan */
         for (nr=0; nr<ndim; nr++)
            {
            *fpc++ = (float) tan((double)(*fpa++) * fact);
            }
         }
      }
   }

return ncount;
}
/*

*/

#ifdef __STDC__
int Func2Frame(char *cfunc, float *a, float *b, float *c, int ndim, float *usrn)

#else
int Func2Frame(cfunc, a, b, c, ndim, usrn)
char  *cfunc;  /* IN: operation */
float *a;       /* IN: input array */
float *b;       /* IN: input array */
float *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
register int nr;

float  usrnul, ffact;
register float *fpa, *fpb, *fpc, rt1, rt2;

double  dt1, dt2, fact;




fact  = M_PI / 180.0;
ffact = 180.0 / M_PI;

usrnul = *usrn;
fpa = a; fpb = b; fpc = c;



/*  branch according to function */

if ((cfunc[0] == 'A') && (cfunc[1] == 'T'))
   {                                            /* atan2 */
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = (double) (*fpa++) * fact;
      dt2 = (double) (*fpb++) * fact;
      *fpc++ = atan2(dt1,dt2) * ffact;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'I'))
   {                                            /* min */
   for (nr=0; nr<ndim; nr++)
      {
      rt1 = *fpa++;
      rt2 = *fpb++;
      *fpc++ = rt1 < rt2 ? rt1 : rt2;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'A'))
   {                                            /* max */
   for (nr=0; nr<ndim; nr++)
      {
      rt1 = *fpa++;
      rt2 = *fpb++;
      *fpc++ = rt1 > rt2 ? rt1 : rt2;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'O'))
   {					/* mod (remainder of fram1/fram2) */
   register int  it1, it2;

   for (nr=0; nr<ndim; nr++)
      {
      it1 = (int) *fpa++;
      it2 = (int) *fpb++;
      *fpc++ = (float) (it1 % it2);
      }
   }
return 0;
}
/*

*/

#ifdef __STDC__
int Func2FrameCon(char *cfunc, float *a, float *rc, float *c, int ndim, 
                  float *usrn)

#else
int Func2FrameCon(cfunc, a, rc, c, ndim, usrn)
char  *cfunc;  /* IN: operation */
float *a;       /* IN: input array */
float *rc;	/* IN: constant */
float *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
register int  nr;

float  scalr, usrnul;
register float *fpa, *fpc, rt1;

double  dt1, dt2, fact, ffact;



fact  = M_PI / 180.0;
ffact = 180.0 / M_PI;

scalr = *rc;
usrnul = *usrn;
fpa = a; fpc = c;



/*  branch according to function */

if ((cfunc[0] == 'A') && (cfunc[1] == 'T'))
   {                                            /* atan2 */
   dt2 = (double) (scalr) * fact;
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = (double) (*fpa++) * fact;
      *fpc++ = atan2(dt1,dt2) * ffact;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'I'))
   {                                            /* min */
   for (nr=0; nr<ndim; nr++)
      {
      rt1 = *fpa++;
      *fpc++ = rt1 < scalr ? rt1 : scalr;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'A'))
   {                                            /* max */
   for (nr=0; nr<ndim; nr++)
      {
      rt1 = *fpa++;
      *fpc++ = rt1 > scalr ? rt1 : scalr;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'O'))
   {                                    /* mod (remainder of fram1/scalr) */
   register int  it1, it2;

   it2 = (int) scalr;
   for (nr=0; nr<ndim; nr++)
      {
      it1 = (int) *fpa++;
      *fpc++ = (float) (it1 % it2);
      }
   }
return 0;
}
/*

*/
 
/* ++++++++++++++++++++++++++++++++++++++++++++++++++

.IDENTIFICATION
  holds:	DOpFrameCons	DOpFrameFrame
		DFunc1Frame	DFunc2Frame	DFunc2FrameCon
.AUTHOR
  K. Banse                        ESO - Garching
.KEYWORDS
  bulk data frames, arithmetic operations
.PURPOSE
  perform arithmetic on arrays
.ALGORITHM
  do it according to opcode ( `, +, -, *, / or =)
  ` means ** (to the power of)

.VERSION
 030805		last modif
 -------------------------------------------------- */
 

#ifdef __STDC__
int DOpFrameCons(char *opcode, double *a, double *rc, double *c, 
                 int ndim, float *usrn)

#else
int DOpFrameCons(opcode, a, rc, c, ndim, usrn)
char  *opcode;	/* IN: operation */
double *a;	/* IN: input array */
double *rc;	/* IN: constant */
double *c;	/* OUT: output array */
int   ndim;	/* IN: size of array */
float *usrn;	/* IN: user Null value */
#endif


{
int   ncount;
register int  nr;
 
double *dpa, *dpc;
double  dt, scalr, usrnul;




scalr = *rc;
usrnul = (double) *usrn;
 
dpa = a; dpc = c; 
ncount = 0;			/* counter for null vals */

  
/*  subtract operands */
  
if (opcode[2] == '-')
   {
   if (opcode[0] == 'C')
      {
      if (MYABS(scalr) > EPS) 
         {
         for (nr=0; nr<ndim; nr++) *dpc++ = scalr - (*dpa++);
         }
      else
         {				/* 0. - C(n)  */
         for (nr=0; nr<ndim; nr++) *dpc++ = -(*dpa++);
         }
      }
   else
      {
      if (MYABS(scalr) > EPS) 
         {
         for (nr=0; nr<ndim; nr++) *dpc++ = (*dpa++) - scalr;
         }
      else
         {				/* C(n) - 0.  */
         for (nr=0; nr<ndim; nr++) *dpc++ = *dpa++;
         }
      }
   }

/*  add operands */
 
else if (opcode[2] == '+') 
   {
   if (MYABS(scalr) > EPS)
      {
      for (nr=0; nr<ndim; nr++) *dpc++ = (*dpa++) + scalr;
      }
   else
      {					/* C(n) + 0. */
      for (nr=0; nr<ndim; nr++) *dpc++ = *dpa++;
      }
   }
 
/*  divide operands */
  
else if (opcode[2] == '/')
   {
   if (opcode[0] == 'C')
      {
      for (nr=0; nr<ndim; nr++)
         {
         dt = *dpa++;
         if (MYABS(dt) < EPS) 
            {
            *dpc++ = usrnul;
            ncount ++;
            }
         else
            *dpc++ = scalr / dt;
         }
      }
   else
      { 
      double  dd;

      dd = MYABS(scalr);
      if (dd < EPS)
         {
         ncount = ndim;
         for (nr=0; nr<ndim; nr++) *dpc++ = usrnul;
         }
      else
         {
         dt = dd - 1.0;		/* is constant = 1.0? */
         if (MYABS(dt) < EPS)
            {
            if (scalr < 0)		/* -1.0 */
               {
               for (nr=0; nr<ndim; nr++) *dpc++ = -(*dpa++);
               }
            else			/* +1.0 */
               {
               for (nr=0; nr<ndim; nr++) *dpc++ = *dpa++;
               }
            }
         else
            {
            dt = 1.0 / scalr;
            for (nr=0; nr<ndim; nr++) *dpc++ =  dt * (*dpa++);
            }
         }
      }
   }
 
/*   multiply operands */
  
else if (opcode[2] == '*')
   {
   double  dd;

   dd = MYABS(scalr);
   if (dd < EPS)
      {
      for (nr=0; nr<ndim; nr++) *dpc++ = 0.0;
      }
   else
      {
      dt = dd - 1.0;              /* is constant = 1.0? */
      if (MYABS(dt) < EPS)
         {
         if (scalr < 0)              /* -1.0 */
            {
            for (nr=0; nr<ndim; nr++) *dpc++ = -(*dpa++);
            }
         else                        /* +1.0 */
            {
            for (nr=0; nr<ndim; nr++) *dpc++ = *dpa++;
            }
         }
      else
         {
         for (nr=0; nr<ndim; nr++) *dpc++ =  scalr * (*dpa++);
         }
      }
   }

/*  copy constant */
 
else if (opcode[2] == '=')
   {
   for (nr=0; nr<ndim; nr++) *dpc++ =  scalr;
   }
 
/*   compute 1. operand ** 2. operand */
  
else if (opcode[2] == '`')
   {
   if (opcode[0] == 'C')
      {
      for (nr=0; nr<ndim; nr++)
         {
         *dpc++ = pow(scalr,*dpa++);
         }
      }
   else
      {
      if (MYABS(scalr) > EPS)
         {
         for (nr=0; nr<ndim; nr++)
            *dpc++ = pow(*dpa++,scalr);
         } 
      else 
         {
         for (nr=0; nr<ndim; nr++) *dpc++ = 1.0;
         } 
      }
   }

return (ncount);
}
/*

*/

#ifdef __STDC__
int DOpFrameFrame(char *opcode, double *a, double *b, double *c,
                  int ndim, float *usrn)

#else
int DOpFrameFrame(opcode, a, b, c, ndim, usrn)
char  *opcode;  /* IN: operation */
double *a;       /* IN: input array */
double *b;	/* IN: input array */
double *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
int   ncount;
register int  nr;

double  usrnul;
register double dt, *dpa, *dpb, *dpc;





usrnul = (double) *usrn;
dpa = a; dpb = b; dpc = c;
ncount = 0;                     /* counter for null vals */



/*  add frames */

if (opcode[2] == '+')
   {
   for (nr=0; nr<ndim; nr++) *dpc++ = (*dpa++) + (*dpb++);
   }

/*  subtract 2. frame from 1. frame */

else if (opcode[2] == '-')
   {
   for (nr=0; nr<ndim; nr++) *dpc++ = (*dpa++) - (*dpb++);
   }

/*  multiply frames */

else if (opcode[2] == '*')
   {
   for (nr=0; nr<ndim; nr++) *dpc++ = (*dpa++) * (*dpb++);
   }

/*  divide 1. frame by 2. frame */

else if (opcode[2] == '/')
   {
   for (nr=0; nr<ndim; nr++)
      {
      dt = *dpb++;
      if (MYABS(dt) < EPS)
         {
         *dpc++ = usrnul;
         dpa++;			/* also increment 1. input frame */
         ncount ++;
         }
      else
         *dpc++ = (*dpa++) / dt;
      }
   }

/*  copy 1. frame into result frame */

else if (opcode[2] == '=')
   {
   for (nr=0; nr<ndim; nr++) *dpc++ =  *dpa++;
   }

/*  compute 1. frame ** 2. frame */

else if (opcode[2] == '`')
   {
   for (nr=0; nr<ndim; nr++)
      {
      *dpc++ = pow((*dpa++),(*dpb++));
      }
   }

return ncount;
}
/*

*/

#ifdef __STDC__
int DFunc1Frame(char *cfunc, double *a, double *c, int ndim, float *usrn)

#else
int DFunc1Frame(cfunc, a, c, ndim, usrn)
char  *cfunc;  /* IN: operation */
double *a;       /* IN: input array */
double *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
int  it, ncount;
register int nr;

register double  dt, fact, ffact;
register double  *dpa, *dpc;

float  usrnul;





usrnul = (double)*usrn;
dpa = a; dpc = c;
ncount = 0;



/*  branch according to function */
 

if ((cfunc[0] == 'S') && (cfunc[1] == 'Q'))
   {						/* sqrt */
   for (nr=0; nr<ndim; nr++) 
      {
      dt = (*dpa++);
      if (dt > 0.0)
         *dpc++ = sqrt(dt);
      else
         {
         if (dt < 0.0)
            {
            *dpc++ = usrnul;
            ncount ++;
            }
         else
            *dpc++ = 0.0;
         }
      }
   }

else if ((cfunc[0] == 'L') && (cfunc[1] == 'N'))
   {						/* ln */
   for (nr=0; nr<ndim; nr++) 
      {
      dt = (*dpa++);
      if (dt <= 0.0)
         {
         *dpc++ = usrnul;
         ncount ++;
         }
      else
         *dpc++ = log(dt);
      }
   }


else if ((cfunc[0] == 'L') && (cfunc[1] == 'O'))
   {						/* log or log10 */
   for (nr=0; nr<ndim; nr++) 
      {
      dt = (*dpa++);
      if (dt <= 0.0)
         {
         *dpc++ = usrnul;
         ncount ++;
         }
      else
         *dpc++ = log10(dt);
      }
   }


else if ((cfunc[0] == 'E') && (cfunc[1] == 'X'))
   {                                            /* exp or exp10 */
   if (cfunc[3] != '1')
      {
      for (nr=0; nr<ndim; nr++)
         *dpc++ = exp((*dpa++));
      }
   else
      {
      dt = log(10.0);			/* use: 10**x = e**(x*ln(10))  */
      for (nr=0; nr<ndim; nr++)
         {
         *dpc++ = exp((*dpa++)*dt);
         }
      }
   }

else if ((cfunc[0] == 'I') && (cfunc[1] == 'N'))
   {                                            /* int is as NINT */
   for (nr=0; nr<ndim; nr++)
      {
      it = (int) ((*dpa++) + 0.5);
      *dpc++ = (double) it;
      }
   }
 
else if ((cfunc[0] == 'A') && (cfunc[1] == 'B'))
   {                                            /* abs */
   for (nr=0; nr<ndim; nr++)
      {
      dt = *dpa++;
      *dpc++ = MYABS(dt);
      }
   }

else
   {
   if (cfunc[0] == 'A') 
      {
      ffact = 180.0 / M_PI;

      if (cfunc[1] == 'S')
         {                                            /* arc sin */
         for (nr=0; nr<ndim; nr++)
            {
            *dpc++ = ffact * asin((*dpa++));
            }
         }
      else if (cfunc[1] == 'C')
         {                                            /* arc cos */
         for (nr=0; nr<ndim; nr++)
            {
            *dpc++ = ffact * acos((*dpa++));
            }
         }
      else if (cfunc[1] == 'T')
         {                                            /* arc tan */
         for (nr=0; nr<ndim; nr++)
            {
            *dpc++ = ffact * atan((*dpa++));
            }
         }
      }
   else
      {
      fact  = M_PI / 180.0;
 
      if (cfunc[0] == 'S') 
         {                                            /* sin */
         for (nr=0; nr<ndim; nr++)
            {
            *dpc++ = sin((*dpa++) * fact);
            }
         }
      else if (cfunc[0] == 'C') 
         {                                            /* cos */
         for (nr=0; nr<ndim; nr++)
            {
            *dpc++ = cos((*dpa++) * fact);
            }
         }
      else if (cfunc[0] == 'T') 
         {                                            /* tan */
         for (nr=0; nr<ndim; nr++)
            {
            *dpc++ = tan((*dpa++) * fact);
            }
         }
      }
   }

return ncount;
}
/*

*/

#ifdef __STDC__
int DFunc2Frame(char *cfunc, double *a, double *b, double *c, int ndim, 
                float *usrn)

#else
int DFunc2Frame(cfunc, a, b, c, ndim, usrn)
char  *cfunc;  /* IN: operation */
double *a;       /* IN: input array */
double *b;       /* IN: input array */
double *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
register int nr;

double  usrnul;
register double *dpa, *dpb, *dpc, dt1, dt2;





usrnul = (double)*usrn;
dpa = a; dpb = b; dpc = c;



/*  branch according to function */

if ((cfunc[0] == 'A') && (cfunc[1] == 'T'))
   {                                            /* atan2 */
   double  ffact, fact;

   fact  = M_PI / 180.0;
   ffact = 180.0 / M_PI;

   for (nr=0; nr<ndim; nr++)
      {
      dt1 = (double) (*dpa++) * fact;
      dt2 = (double) (*dpb++) * fact;
      *dpc++ = atan2(dt1,dt2) * ffact;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'I'))
   {                                            /* min */
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = *dpa++;
      dt2 = *dpb++;
      *dpc++ = dt1 < dt2 ? dt1 : dt2;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'A'))
   {                                            /* max */
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = *dpa++;
      dt2 = *dpb++;
      *dpc++ = dt1 > dt2 ? dt1 : dt2;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'O'))
   {					/* mod (remainder of fram1/fram2) */
   register int  it1, it2;

   for (nr=0; nr<ndim; nr++)
      {
      it1 = (int) *dpa++;
      it2 = (int) *dpb++;
      *dpc++ = (double) (it1 % it2);
      }
   }
return 0;
}
/*

*/

#ifdef __STDC__
int DFunc2FrameCon(char *cfunc, double *a, double *rc, double *c, int ndim, 
                  float *usrn)

#else
int DFunc2FrameCon(cfunc, a, rc, c, ndim, usrn)
char  *cfunc;  /* IN: operation */
double *a;       /* IN: input array */
double *rc;	/* IN: constant */
double *c;       /* OUT: output array */
int   ndim;     /* IN: size of array */
float *usrn;    /* IN: user Null value */
#endif


{
register int  nr;

double  scalr, usrnul;
register double *dpa, *dpc, dt1, dt2;

double  fact, ffact;



fact  = M_PI / 180.0;
ffact = 180.0 / M_PI;

scalr = *rc;
usrnul = (double)*usrn;
dpa = a; dpc = c;



/*  branch according to function */

if ((cfunc[0] == 'A') && (cfunc[1] == 'T'))
   {                                            /* atan2 */
   dt2 = scalr * fact;
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = (*dpa++) * fact;
      *dpc++ = atan2(dt1,dt2) * ffact;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'I'))
   {                                            /* min */
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = *dpa++;
      *dpc++ = dt1 < scalr ? dt1 : scalr;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'A'))
   {                                            /* max */
   for (nr=0; nr<ndim; nr++)
      {
      dt1 = *dpa++;
      *dpc++ = dt1 > scalr ? dt1 : scalr;
      }
   }

else if ((cfunc[0] == 'M') && (cfunc[1] == 'O'))
   {                                    /* mod (remainder of fram1/scalr) */
   register int  it1, it2;

   it2 = (int) scalr;
   for (nr=0; nr<ndim; nr++)
      {
      it1 = (int) *dpa++;
      *dpc++ = (double) (it1 % it2);
      }
   }
return 0;
}

