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

/*+++++++++++++++++++  MIDAS monitor routines PREPG  +++++++++++++++++++++++++
.LANGUAGE    C
.IDENTIFICATION  Module PREPG
.AUTHOR  K. Banse                  ESO - Garching
.KEYWORDS
  MIDAS monitor, algebraic expressions, polish notation
.COMMENTS
  holds KEXP_CLEAN, KEXP_ATOM, KEXP_REDUCE, KEXP_CLASSIFY, KEXP_POLISH,
        KEXP_STACK, KEXP_PUSH, KEXP_POP, KEXP_PEEP
        worldcnv

.VERSION  [1.00] 870724: built from FORTRAN version 2.50

 100616		last modif
-------------------------------------------------------------------------*/
 
#include <fileexts.h>
 
#include <osyparms.h>
#include <monitdef.h>
#include <midback.h>
#include <stackext.h>

int move_sxdc();

/*

*/

int KEXP_CLEAN(instring,outstring,maxcnt,atom,latom)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  replace all scalars by 'S', all arrays by 'A', all 1-arg functions by 'P'
  all 2-arg functions by 'Q', 3-arg functions by 'R'
  finally truncate all operators to one character.
.ALGORITHM
  use routine KEXP_ATOM to extract the objects listed above
  test for functions and arrays
  everything else is considered a scalar, constant or keyword,
  (unless it's a delimiter)
  This is a modified version of EXP_CLEAN in express.for
.RETURNS
  no. of operands in expression, -1 if something wrong
---------------------------------------------------------------------*/

char	   *instring  /* IN: input string  */;
char	   *outstring /* OUT: "cleaned" output string  */;
int 	   maxcnt     /* IN: max. no. of atoms   */;
char	   *atom[]    /* OUT: pointer array	  \
                           points to extracted operands in original form  */;
int	   latom[]    /* OUT: holds lengths of 'atom'  */;

{
int   mycount, ml, ii, minus_flag, oo;
register int nr;
	
char	delim;
register char  ck, cm;



ml = 0;   nr = 0;

while (ml < 199)
   {
   ck = instring[nr];
   if (ck == '"')
      {
      KAUX.STR[ml++] = instring[nr++];           /* copy the '"' */

      while ((ck = instring[nr++]) != '\0')
         {
         KAUX.STR[ml++] = ck;
         if (ck == '"')
            {
            if (instring[nr] == '"') 
               KAUX.STR[ml++] = instring[nr++]; 
            ck = instring[nr];		/* set `ck' back to current elem */
            goto after_quote;
            }
         }
      return (-1);                        /* we need closing '"' */
      }

  after_quote:
   if (ck == '\0') break;			/* loop finished */

   cm = instring[nr+1];
   if ((ck == '*') && (cm == '*'))
      {
      KAUX.STR[ml++] = '`';
      nr ++;
      }
   else if ((ck == '+') && (cm == '-'))
      {
      KAUX.STR[ml++] = '-';
      nr ++;
      }
   else if ((ck == '-') && (cm == '-'))
      {
      KAUX.STR[ml++] = '+';
      nr ++;
      }
   else if ((ck == '/') && (cm == '/'))  /* ckey//ckey */
      {
      KAUX.STR[ml++] = '+';		/* not looked at in COMPU ... */
      nr ++;
      }
   else if (ck != ' ') 			/* everything esle, but skip spaces */
      KAUX.STR[ml++] = ck;
   nr ++;
   }

KAUX.STR[ml] = '\0';
mycount = 0;
minus_flag = 0;
ii = 0;   oo = 0;

	
/*  extract atoms from left to right  */

main_loop:
if (mycount >= maxcnt)		/* return with error if too many operands  */
   return (-1);

latom[mycount] = KEXP_ATOM(&KAUX.STR[ii],&delim,atom[mycount]);
	
if (delim == 'X')
   {
   if (minus_flag == 1)
      outstring[oo++] = ')';		/* append closing parenthesis  */

   outstring[oo] = '\0';		/*  finished  */
   return mycount;
   }
	


/*  in first pass the atom + delimiter is returned  */
/*  ------------------------------------------------*/

if (latom[mycount] != 0) 
   {
   if (delim != '(')
      outstring[oo] = 'S';		/* it's a scalar keyword or constant */
   else
      {
      outstring[oo] = 'A';		/* default to keyword array  */
   
      if (*(atom[mycount]+1) == '$')	/* look for M$function  */
         {
         CGN_UPSTR(atom[mycount]);
         if (*atom[mycount] == 'M') 
            {
            register char  *cp;
   
            cp = atom[mycount] + 2;
            if ( (strncmp(cp,"INDEX",5) == 0)  || 
                 (strcmp(cp,"FILTYP") == 0) ||
                 (strcmp(cp,"STRCMP") == 0) ||
                 (strcmp(cp,"PARSE") == 0) )
               outstring[oo] = 'Q';		/* 2-arg function  */
   
            else if (strcmp(cp,"REPLA") == 0) 
                outstring[oo] = 'R';		/* 3-arg function */

            else if (strncmp(cp,"EXIST",5) == 0) 
               {
               ck = *(cp+5);
               if ( (ck == 'D') || (ck == 'C') )
                  outstring[oo] = 'Q';		/* 2-arg function  */
               else
                  outstring[oo] = 'P';		/* 1-arg function  */
               }

            else if ( (strcmp(cp,"VALUE") == 0) ||
                      (strcmp(cp,"TNULL") == 0) )
               {
               int  mm, comma;
               char  *xp, *cpp, *cppp;
               register char cb;

               cpp = (char *) 0;		/* init */
	       cp = &KAUX.STR[ii+8];		/* move to after M$VALUE( */
               mm = CGN_INDEXC(cp,')');
               if (mm < 1) return (-1);

               /* this processing disables:
		  m$value(..m$func()..) or m$value(..a+b..) 
		  but supports: `wild' file names            */

               xp = cp;			/* test for the different options */
               comma = 0;
               for (nr=0; nr<mm; nr++)
                  {
                  cb = *xp++;
                  if (cb == '[')		/* (image[...]) */
                     break;
                  else if (cb == ',')
                     {
                     comma ++;
                     if (comma == 1) 
                        {
                        cpp = xp;
                        *(cpp-1) = '\0';
                        }
                     else
                        {			/* (table,column,row) */
                        cppp = xp;
                        *(cp + mm) = '\0';			
                        *(cppp-1) = '\0';

                        if ((mycount+3) >= maxcnt) return(-1);
                        mycount ++;
                        latom[mycount] = CGN_COPY(atom[mycount],cp);
                        mycount ++;
                        latom[mycount] = CGN_COPY(atom[mycount],cpp);
                        mycount ++;
                        latom[mycount] = CGN_COPY(atom[mycount],cppp);
                        mycount ++;
                        ii += (9+mm);	
                        (void)strcpy(&outstring[oo],"R(S,S,S)");
                        oo += 8;
                        goto main_loop;
                        }
                     }
                  }

               if (comma == 0) 
                  {				/* (keyword) */
                  xp = cp;
                  for (nr=0;;nr++)              /* if (key()) */
                     {				/* avoid P(A(S)) ... */
                     cb = *xp++;
                     if (cb == ')')
                        break;
                     else if (cb == '(')
                        {
                        mm ++;                  /* include last ')' */
                        break;
                        }
                     }

                  *(cp + mm) = '\0';			
                  mycount ++;
                  latom[mycount] = CGN_COPY(atom[mycount],cp);
                  mycount ++;
                  (void)strcpy(&outstring[oo],"P(S)");
                  oo += 4;
                  }
               else
                  {
                  xp = cpp;
                  for (nr=0;;nr++)			/* if (frame,descr()) */
                     {				/* avoid Q(S,A(S)) ... */
                     cb = *xp++;
                     if (cb == ')')
                        break;
                     else if (cb == '(')
                        {
                        mm ++;
                        break;
                        }				/* (frame,descr) */
                     }

                  *(cp + mm) = '\0';			
                  if ((mycount+2) >= maxcnt) return(-1);
                  mycount ++;
                  latom[mycount] = CGN_COPY(atom[mycount],cp);
                  mycount ++;
                  latom[mycount] = CGN_COPY(atom[mycount],cpp);
                  mycount ++;
                  (void)strcpy(&outstring[oo],"Q(S,S)");
                  oo += 6;
                  }

               ii += (9+mm);			/* skip M$VALUE(...) */
               goto main_loop;
               }

            else
               outstring[oo] = 'P';	/* all other are 1-arg functions */
            }
         }
      }
	
   oo ++ ;
   ii += latom[mycount++];
   	
   if (minus_flag == 1)
      {
      minus_flag = 0;			/* reset flag  */
      outstring[oo++] = ')';		/* and append closing parenthesis  */
      }
   }


/*  in second pass the delimiter only is returned  */
/*  -----------------------------------------------*/

else
   {
   if (delim == '-')  		
      {
      if ( (oo == 0) ||  			/* test for unary minus sign  */
           (outstring[oo-1] == '(') )	/* or  (-  */
         {
         *atom[mycount] = '0';		/* if so, replace it by " 0 - "  */
         atom[mycount][1] = ' ';
         latom[mycount++] = 1;
         outstring[oo++] = 'S';
         }
      else if ( (outstring[oo-1] == '*') || (outstring[oo-1] == '/') )
         {
         outstring[oo] = '(';		/* open parenthesis  */
         *atom[mycount] = '0';		/* if so, replace it by " 0 - "   */
         *(atom[mycount]+1) = ' ';
         latom[mycount++] = 1;
         outstring[++oo] = 'S';
         oo ++;
         minus_flag = 1;	/* set minus flag, since ) still to be added */
         }
      }
	
   else if (delim == '+')
      {
      if ( (oo == 0) || 			/* test for unary plus sign  */
           ( (oo > 0) && (outstring[oo-1] == '(') ) )
         {
         ii ++ ;			/* if so, ignore it  */
         goto main_loop;
         }
      }
	
   outstring[oo++] = delim;
   ii ++ ;
   }

goto main_loop;

}
/*

*/

int KEXP_ATOM(input,delim,atom)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  extract atoms and their delimiters from an arithmetic expression
.ALGORITHM
  straight forward, but watch out for ASCII constants "..." , they may contain
  delimiters
  This is a modified version of module EXP_ATOM in express.for
.RETURNS
int   length of 'atom' 
---------------------------------------------------------------------*/

char	*input	/* IN: input string  */;
char	*delim	/* OUT: delimiter of returned atom  */;
char	*atom	/* OUT: extracted operand   */;

{
int   const_flag, ii, latm;
register int  nr;
	
register char	delm, cc;

static int nlimits = 7, klimits = 9;
static char   limits[9] = {'\0','*','/','(',')',',','`','+','-'};



*atom = ' ';
delm = input[0];

if (delm == '\0')
   {
   *delim = 'X';
   return (0);
   }

latm = 0;
ii = 0;
const_flag = 0;	


/* here is the simplified 1st execution of the main_loop below */
/* ----------------------------------------------------------- */



if (delm == '"')			/* check for ASCII constants */
   {
   const_flag = 1;
   goto main_loop;
   }
else if (delm == '[') 
   {
   const_flag = 2;
   goto main_loop;                      /* raise flag to 2 */
   }

for (nr=1; nr<klimits; nr++)		/* we checked for '\0' already above */
   {
   if (delm == limits[nr])
      {
      *delim = delm;
      return (0);
      }
   }



	
main_loop:
latm++;
delm = input[++ii];
	

/*  check for ASCII constants  */

if (delm == '"') 
   {
   if (const_flag < 2)
      {
      const_flag = 1 - const_flag;		/*  1 => 0 and 0 => 1  */
      goto main_loop;				/* skip following tests  */
      }
   }
else if (delm == '[')
   {
   if (const_flag == 0)
      {
      const_flag = 2;
      goto main_loop;			/* raise flag to 2 */
      }
   }
else if (delm == ']') 
   {
   if (const_flag == 2)
      {
      const_flag = 0;
      goto main_loop;			/* lower flag to 0 */
      }
   }

if (const_flag == 0)			/* we're NOT inside constant  */
   {
   /*  first look for ddd.Eee numbers    */

   if ( (delm == '+') || (delm == '-') )
      {
      if (latm > 1)
         {
         cc = input[latm-1];
         if ( (cc == 'E') || (cc == 'e') || (cc == 'D') || (cc == 'd') )
            {
            for (nr=0; nr<latm-1; nr++)
               {
               cc = input[nr];
               if ( (cc != '.') && ((cc < '0') || (cc > '9')) )
                  goto sect_200;
               }
            goto main_loop;	/* we got such a number, continue...  */
            }
         }
   
     sect_200:    
      (void) memcpy(atom,input,(size_t)latm);
      atom[latm] = '\0';
      *delim = delm;
      return (latm);
      }

   for (nr=0; nr<nlimits; nr++)
      {
      if (delm == limits[nr]) 
         {
         (void) memcpy(atom,input,(size_t)latm);
         atom[latm] = '\0';
         *delim = delm;
         return (latm);
         }
      }
   }

goto main_loop;			/*  no delimiter - loop more  */
}

/*

*/

int KEXP_REDUCE(input,output,operation)

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  extract from a given polish expression the next binary subexpression
  and reduce the expression accordingly (replace subexpression by result)
.ALGORITHM
  look for instances of 'S S op' or 'A S )' or 'P S )' or 'Q S S )'
                                 or 'R S S S )'
  A = array, P = 1 arg function, Q = 2 arg function, R = 3 arg function
  This routine is a modified verrsion of EXP_REDUCE in express.for
.RETURNS 
int   starting index of subexpression in input string 
------------------------------------------------------------------------*/

char	*input	/* IN: input string (terminated by '\0') */;
char	*output /* OUT: "reduced" output string  */;
char	*operation  /* OUT: subexpression to execute next  */;

{	
int   kk, p1;
	
char  *t0, *t1, *t2;
register char  cr;


	
kk = (int) strlen(input);
*output = ' ';
p1 = 0;

	
loop:
t0 = &input[p1]; t1 = t0 + 1; t2 = t0 + 2;
cr = *t0;

	
/* look for 1-arg functions or arrays: P S ) or A S )  */

if ( (cr == 'P') || (cr == 'A') )  		
   {					/* for functions treat specially  */
   if ( (*t2 != ')') || (*t1 != 'S') )
      goto sect_1000;
   else
      goto sect_200;
   }
	
 
/* look for 2-arg functions: Q S S )  */

if (cr == 'Q')
   {
   if ( (*(t0+3) != ')') || (*t1 != 'S') || (*t2 != 'S') )
      goto sect_1000;
   else
      goto sect_200;
   }
	

/* look for 3-arg functions: R S S S )  */

if (cr == 'R')
   {
   if ( (*(t0+4) != ')') || 
        (*t1 != 'S') || (*t2 != 'S') || (*(t0+3) != 'S') )
      goto sect_1000;
   else
      goto sect_200;
   }
	

/*  look for operation: S S op  */

if ( (cr != 'S') || (*t1 != 'S') ||
     (*t2 == 'S') || (*t2 == 'A') ||
     (*t2 == 'P') || (*t2 == 'Q') || (*t2 == 'R') )
   goto sect_1000;


sect_200:				/*  valid operation found  */
if (p1 > 0)
   (void) strncpy(output,input,(size_t)p1);		/* copy 1. part  */

if (cr == 'R')  			/* copy last part */
   (void) strcpy(&output[p1+1],&input[p1+5]);

else if (cr == 'Q')  			/* copy last part */
   (void) strcpy(&output[p1+1],&input[p1+4]);

else
   {
   (void) strcpy(&output[p1+1],&input[p1+3]);		
   *(t0+3) = ' ';		/* make sure, we have no trailing stuff...  */
   }

	
/*  replace the operation by result  */

output[p1] = 'S';
(void) strncpy(operation,t0,(size_t)5);		/* copy task into operation  */
return (p1);


sect_1000:		/*  no valid operation, move on  */
if (++p1 < kk) goto loop;

return (p1);
}

/*

*/

#ifdef __STDC__
int KEXP_CLASSIFY(char input, int *ipr, int *spr)
#else
int KEXP_CLASSIFY(input,ipr,spr)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  assign an input and a stack priority to each operation
.ALGORITHM
  straight forward, since priorities are fixed
  This routine is a modified version of EXP_CLASSifY in express.for
.RETURNS
int   1 for scalar, S
      2 for operator, +,-,... ,
      3 for function or array, P,Q,R,A  
---------------------------------------------------------------------*/

char	input;	 /* IN: input operator or operand  */
int     *ipr;    /* OUT: input priority  */
int     *spr;    /* OUT: stack priority  */
#endif

{
static int   inpr[8] = {1,1,2,2,4,0,0,3};		/* input precedence  */
static int   stpr[8] = {1,1,2,2,0,4,0,3};		/* stack precedence  */
register int  nr;

static char   oper[8] = {'+','-','*','/','(',')',',','`'};

	
*ipr = 0;
*spr = 0;

if (input == 'S')
   return (1);					/* scalar */

if ( (input == 'A') || (input == 'P') || (input == 'Q') || (input == 'R') )
   return(3);					/*  function or array */
	

/*  otherwise compare input with operators  */

for (nr=0; nr<8; nr++)
   {
   if (input == oper[nr])
      {
      *ipr = inpr[nr];
      *spr = stpr[nr];
      return (2);			/* should be an operator...  */
      }
   }

return (2);				/* nothing of above  */
}

/*

*/

int KEXP_POLISH(instring,outstring)

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  convert an expression in "normal" algebraic notation to polish reversed notat
.ALGORITHM
  use a stack to store temporary data
  functions as P(A+B) will be converted to PAB+) to indicate range of function
.RETURNS
  status:		return status
			= 0, o.k., else trouble...
---------------------------------------------------------------------*/
 
char	*instring  /* IN: input string  */;
char	*outstring /* OUT: output string in polish reversed notation  */;

{
	
int   flag, inext, inpr, kk;
int   onext, type;
int stapr, srval, stval;
	
char	nchar, stop;
	



kk = (int) strlen(instring);
KEXP_STACK();
inext = 0;
onext = 0;

	
/*  extract operators and operands from left to right  */
	
loop_more:
if (inext > kk) goto pop_next;			/* end of string reached  */

nchar = instring[inext++];
type = KEXP_CLASSIFY(nchar,&inpr,&stapr);	/* classify token  */
	

if (type == 1) 		/*  number/variable  */
   {
   outstring[onext++] = nchar;
   goto loop_more;
   }

else if (type == 2) 	/*  operator  */
   {
  sect_200:
   if (nchar == ')')	/*  if [nchar] = closing parenthese, unwind stack   */
      {
     sect_220:
      flag = KEXP_POP(&stval,&stop);		/* pop from stack  */
      if (flag == -1) return (1);		/* missing parentheses...  */
      
      if (stop == '(') 
         goto loop_more;		   /* eliminate matching parentheses  */
      else if (stop == '[')
         {
         outstring[onext++] = nchar;	   /* write ')' for end-of-function  */
         goto loop_more;
         }
      else
         {
         outstring[onext++] = stop;	/* store stack operator in output str */
         goto sect_220;
         }
      }

   else if (nchar == ',')
      {			   /* if nchar = closing comma, unwind stack till '[' */
     sect_250:
      flag = KEXP_PEEP(&stval,&stop);			/* look at stack  */
      if (flag == -1) return (1);			/* something missing  */

      if (stop == '[')
         goto loop_more;				/* ok...  */
      else
         {
         flag = KEXP_POP(&srval,&stop);			/* pop stack  */
         outstring[onext++] = stop;	/* store stack operator in output str */
         goto sect_250;
         }
      }

   else		/*  all other characters here...  */
      {
      flag = KEXP_PEEP(&stval,&stop);	/* look what's on top of the stack  */
      if (flag == -1)  				/* if stack empty,  */
         {
         (void) KEXP_PUSH(stapr,nchar);		/* push on stack always  */
         goto loop_more;
	 }
	
      else if (inpr > stval)  		/* if input precedence > stack value, */
         {
         (void) KEXP_PUSH(stapr,nchar);	  /* push stack precedence on stack  */
         goto loop_more;
         }
      else
         {
         flag = KEXP_POP(&stval,&stop);
         outstring[onext++] = stop;
         goto sect_200;
         }
      }
   }

else			/*  function  */
   {
   outstring[onext++] = nchar;
   (void) KEXP_PUSH(0,'[');	/* push '[' on stack to mark function start */
   inext ++;					/* skip following '(' ...  */
   goto loop_more;
   }


pop_next:				/*  end of input string reached  */
while (KEXP_POP(&stval,&stop) != (-1)) 
   outstring[onext++] = stop;

outstring[onext] = '\0';	/* stack empty - we're done  */
return (0);
}

/*

*/

void KEXP_STACK()

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  initialize stack
.ALGORITHM
  clear
.RETURNS
  nothing
---------------------------------------------------------------------*/
	
{
STACK.PNTR = -1;	/* pointer to top of stack  */
STACK.OVF = 39;		/* max. 40 operands on line of 80 characters...  */
}



#ifdef __STDC__
int KEXP_PUSH(int ival, char cval)
#else
int KEXP_PUSH(ival,cval)

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  push on stack
.ALGORITHM
  clear
.RETURNS
  0 = o.k.
  1 = overflow
---------------------------------------------------------------------*/

int  ival    /* IN: integer value  */;
char cval    /* IN: char. value  */;
#endif

{
if (STACK.PNTR >= STACK.OVF)  return (1);
	
STACK.CA[++STACK.PNTR] = cval;			/*  stack o.k.  */
STACK.IA[STACK.PNTR] = ival;

return (0);
}

/*

*/

int KEXP_POP(ival,cval)

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  pop from stack
.ALGORITHM
  clear
.RETURNS
  0 = o.k.
  1 = underflow
---------------------------------------------------------------------*/

int  *ival    /* OUT: integer value  */;
char *cval    /* OUT: char. value  */;

{
if (STACK.PNTR < 0) return (-1);
	
*ival = STACK.IA[STACK.PNTR];			/*  stack o.k.  */
*cval = STACK.CA[STACK.PNTR--];

return (0);
}




int KEXP_PEEP(ival,cval)

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
  look at stack
.ALGORITHM
  clear
.RETURNS
  0 = o.k.
  1 = underflow
---------------------------------------------------------------------*/

int  *ival    /* OUT: integer value  */;
char *cval    /* OUT: char. value  */;

{
if (STACK.PNTR < 0) return (-1);

*ival = STACK.IA[STACK.PNTR];			/*  stack o.k.  */
*cval = STACK.CA[STACK.PNTR];

return (0);
}

/*

*/

int worldcnv()

{
int  nval, nulo, unit, imnoa, pixdim, direc, linflag, dispflg, sav;
int  k, mm, off, stat, px3, npix[3], sublo[3], subhi[3];
register int  nr;

char  cbuf[104], tbuf[80], auxstr[80], convstr[80], subs[3][32];
register char  cr;

double   dd1[3], dd2[3], dd3[6], dnul[12];

float   rr, rval[3];

void  form_sexa();



mm = 0;
cr = TOKEN[3].STR[0];			/* check, if no output wanted */

if ((cr == 'N') || (cr == 'n'))
   {
   sav = KIWORDS[OFF_LOG+3];		/* save current settings */
   KIWORDS[OFF_LOG+3] = 1;
   dispflg = -1;
   }
else
   {
   sav = 0;
   dispflg = 1;
   }

(void) FRAMACC('O',TOKEN[1].STR,1,&imnoa);		/* open frame */
if (imnoa < 0)
   {
   stat = 122;
   goto end_of_it;
   }

npix[0] = npix[1] = npix[2] = 1;
(void) SCDRDI(imnoa,"NPIX",1,3,&nval,npix,&nulo,&unit);

linflag = fp2wc(0,imnoa,dd1,dd2);	/* init + test, if `real' WCS */


for (nr=0; nr<3; nr++)
  {
  dd1[nr] = 1.0;
  dd2[nr] = 0.0;
  sublo[nr] = 0;
  }


(void) strcpy(cbuf,TOKEN[2].STR);		/* coord specs */
px3 = 0;
cr = cbuf[0];
if ((cr == '@') || (cr == '>') || (cr == '<') || (cr == 'C'))
   direc = 1;				/* frame pixels entered */
else
   {					/* world coords entered */
   direc = 0;
   k = CGN_INDEXC(cbuf,',');
   if (k > 0)				/* at least 2 dim */
      {
      nr = k + 1;
      k = CGN_INDEXC(&cbuf[nr],',');
      if (k > 0)
         {
         mm = nr + k + 1;
         cr = cbuf[mm];
         if ((cr == '@') || (cr == '>') || (cr == '<') || (cr == 'C'))
            px3 = 1;			/* we have a 3rd fpix index */
         }
      }
   }	



/*  world coords in, frame pixels out */

if (direc == 0)				/* world coords entered */
   {
   stat = Convcoo(0,imnoa,cbuf,3,&pixdim,sublo,subhi);
   if (stat != 0) 
      {
      stat = 98;
      goto end_of_it;
      }

   if (px3 == 1)
      {
      (void) SCDRDD(imnoa,"START",1,3,&nval,dd1,&nulo,&unit);
      (void) SCDRDD(imnoa,"STEP",1,3,&nval,dd2,&nulo,&unit);
      dd1[0] = dd1[2] + sublo[2]*dd2[2];
      (void) sprintf(tbuf,"%8.8g",dd1[0]);
      k = 7;
      for (nr=0; nr<7; nr++)		/* skip leading blanks */
         {
         if (tbuf[nr] != ' ')
            {
            k = nr;
            break;
            }
         }
      (void) strcpy(&cbuf[mm],&tbuf[k]);
      }
   (void) sprintf(auxstr,"world coords entered = %s",cbuf);
   SCTPUT(auxstr);

   for (nr=0; nr<pixdim; nr++) sublo[nr] ++;
   

   if (pixdim == 1)				/* 1-dim frame */
      {
      (void) CGN_CNVT(cbuf,4,1,subhi,rval,dd1);
      (void) sprintf(cbuf,"frame pixels = %d",sublo[0]);
      }

   else if (pixdim == 2)			/* 2-dim frame */
      {
      dd1[2] = 1.0;
      if (linflag == 0)
         {
         (void) strcpy(convstr,cbuf);		/* prepare string for CNVT */
         for (nr=0; nr<80; nr++)		/*  ':'  ->  ','  */
            {
            if (convstr[nr] == ':')
               convstr[nr] = ',';
            else if (convstr[nr] == '\0')
               break;
            }

         k = CGN_INDEXC(cbuf,',');
         cbuf[k] = '\0';
         off = CGN_INDEXC(cbuf,':'); 		/* off > 0: sexa -> dec */
         (void) move_sxdc(off,1,cbuf,auxstr);		/* RA */
         (void) sprintf(tbuf,"  or %s, ",auxstr);
         k ++;

         if (off > 0)				/* RA, DEC input */
            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
         else					/* decimal input */
            (void) CGN_CNVT(convstr,4,2,subhi,rval,dd1);


         (void) move_sxdc(off,0,&cbuf[k],auxstr);	/* DEC */
         (void) strcat(tbuf,auxstr);
         SCTPUT(tbuf);

         if (off > 0)				/* tbuf holds decimal wc */
            (void) CGN_CNVT(&tbuf[5],4,2,subhi,rval,dd1);
         else					/* tbuf holds RA,DEC wc */
            {
            (void) strcpy(convstr,&tbuf[5]);        /* save string,  : -> ,  */
            for (nr=0; nr<80; nr++)
               {
               if (convstr[nr] == ':')
                  convstr[nr] = ',';
               else if (convstr[nr] == '\0')
                  break;
               }

            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
            }

         (void) SCKWRD("OUTPUTD",dd1,1,3,&unit);   /* save dec. coords */
         (void) SCKWRD("OUTPUTD",dd3,4,6,&unit);   /* save hours,mins,secs */
         }
      (void) sprintf(cbuf,"frame pixels = %d,%d",sublo[0],sublo[1]);
      }

   else						/* 3-dim frame */
      {
      if (linflag == 0)
         {
         (void) strcpy(convstr,cbuf);           /* prepare string for CNVT */
         for (nr=0; nr<80; nr++)                /*  ':'  ->  ','  */
            {
            if (convstr[nr] == ':')
               convstr[nr] = ',';
            else if (convstr[nr] == '\0')
               break;
            }

         k = CGN_INDEXC(cbuf,',');
         cbuf[k] = '\0';
         off = CGN_INDEXC(cbuf,':');            /* off > 0: sexa -> dec */
         (void) move_sxdc(off,1,cbuf,auxstr);           /* RA */
         (void) sprintf(tbuf,"  or %s, ",auxstr);
         k ++;

         if (off > 0)                           /* RA, DEC input */
            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
         else                                   /* decimal input */
            (void) CGN_CNVT(convstr,4,2,subhi,rval,dd1);

         CGN_strcpy(cbuf,&cbuf[k]);		/* move to y-, z- pixel */
         k = CGN_INDEXC(cbuf,',');
         cbuf[k] = '\0';
         (void) move_sxdc(off,0,cbuf,auxstr);		/* DEC */
         (void) strcat(tbuf,auxstr);

         if (off > 0)                                   /* tbuf: dec. wc */
            (void) CGN_CNVT(&tbuf[5],4,2,subhi,rval,dd1);
         else                                           /* tbuf: RA,DEC wc */
            {
            (void) strcpy(convstr,&tbuf[5]);        /* save string,  : -> ,  */
            for (nr=0; nr<80; nr++)
               {
               if (convstr[nr] == ':')
                  convstr[nr] = ',';
               else if (convstr[nr] == '\0')
                  break;
               }

            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
            }

         (void) strcat(tbuf,", ");
         k ++;
         (void) CGN_CNVT(&cbuf[k],4,1,subhi,rval,&dd1[2]);
         (void) strcat(tbuf,&cbuf[k]);
         SCTPUT(tbuf);

         (void) SCKWRD("OUTPUTD",dd3,4,6,&unit);   /* save hours,mins,secs */
         }

      (void) sprintf(cbuf,
                     "frame pixels = %d,%d,%d",sublo[0],sublo[1],sublo[2]);
      (void) SCKWRD("OUTPUTD",dd1,1,3,&unit);      /* save dec. wcoords */
      }

   dd2[0] = (double) sublo[0];			/* store frame pixels */
   dd2[1] = (double) sublo[1];
   dd2[2] = (double) sublo[2];
   (void) SCKWRD("OUTPUTD",dd2,10,3,&unit); 
   }


/*  frame pixels in, world coords out */

else					/* pixel coords. entered */
   {
   off = 0;
   pixdim = 0;
   for (nr=0; nr<3; nr++)
      {
      k = CGN_EXTRSS(cbuf,(int)strlen(cbuf),',',&off,subs[nr],30);
      if (k < 1)
         break;
      else
         pixdim = nr + 1;
      }

   for (nr=0; nr<pixdim; nr++)
      {
      if (subs[nr][0] == '<')
         dd1[nr] = 1.0;
      else if (subs[nr][0] == '>')
         dd1[nr] = (double) npix[nr];
      else if (subs[nr][0] == 'C')
         {
         k = npix[nr]/2;
         dd1[nr] = (double) k;
         }
      else				/* remains only "@" format */
         {
         if (CGN_CNVT(&subs[nr][1],4,1,&nval,&rr,&dd1[nr]) != 1) 
            {
            stat = 100;
            goto end_of_it;
            }
         }
      }

   sublo[0] = (int) dd1[0];		/* split according to NAXIS */
   if (pixdim == 1)
      (void) sprintf(auxstr,"frame pixel entered = %d",sublo[0]);

   else if (pixdim == 2)
      {
      sublo[1] = (int) dd1[1];
      (void) sprintf(auxstr,"frame pixels entered = %d,%d",sublo[0],sublo[1]);
      }
   else
      {
      sublo[1] = (int) dd1[1];
      sublo[2] = (int) dd1[2];
      (void) sprintf(auxstr,"frame pixels entered = %d,%d,%d",sublo[0],sublo[1],                     sublo[2]);
      }
   SCTPUT(auxstr);
   (void) SCKWRD("OUTPUTD",dd1,10,3,&unit);      /* save frame pixels */

   if (fp2wc(1,imnoa,dd1,dd2) != 0) 		/* convert fp -> wc */
      {
      stat = 99;
      goto end_of_it;
      }

   /* split according to NAXIS */

   if (pixdim == 1)
      (void) sprintf(cbuf,"world coords = %10.8g",dd2[0]);

   else if (pixdim == 2)
      {
      if (linflag == 0)
         {
         form_sexa(1,dd2[0],auxstr);			/* RA */
         (void) strcpy(convstr,auxstr);
         for (nr=0; nr<80; nr++)
            {
            if (convstr[nr] == ':')
               convstr[nr] = ',';
            else if (convstr[nr] == '\0')
               break;
            }
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
         (void) SCKWRD("OUTPUTD",dd3,4,3,&unit);
         (void) sprintf(cbuf,"world coords = %10.8g, %10.8g  or  %s, ",
                        dd2[0],dd2[1],auxstr);

         form_sexa(0,dd2[1],auxstr);			/* DEC */
         (void) strcpy(convstr,auxstr);
         for (nr=0; nr<80; nr++)
            {
            if (convstr[nr] == ':')
               convstr[nr] = ',';
            else if (convstr[nr] == '\0')
               break;
            }
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
         (void) SCKWRD("OUTPUTD",dd3,7,3,&unit);
         (void) strcat(cbuf,auxstr);
         }
      else
         (void) sprintf(cbuf,"world coords = %10.8g,%10.8g",dd2[0],dd2[1]);
      }
   else
      {
      if (linflag == 0)
         {
         form_sexa(1,dd2[0],auxstr);                    /* RA */
         (void) strcpy(convstr,auxstr);
         for (nr=0; nr<80; nr++)
            {
            if (convstr[nr] == ':')
               convstr[nr] = ',';
            else if (convstr[nr] == '\0')
               break;
            }
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
         (void) SCKWRD("OUTPUTD",dd3,4,3,&unit);
         (void) sprintf(cbuf,"world coords = %10.8g, %10.8g, %10.8g",
                        dd2[0],dd2[1],dd2[2]);

         SCTPUT(cbuf);
         (void) sprintf(cbuf,"   or  %s, ",auxstr);
         form_sexa(0,dd2[1],auxstr);                    /* DEC */
         (void) strcpy(convstr,auxstr);
         for (nr=0; nr<80; nr++)
            {
            if (convstr[nr] == ':')
               convstr[nr] = ',';
            else if (convstr[nr] == '\0')
               break;
            }
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
         (void) SCKWRD("OUTPUTD",dd3,7,3,&unit);
         (void) strcat(cbuf,auxstr);
         (void) sprintf(auxstr,", %10.8g",dd2[2]);
         (void) strcat(cbuf,auxstr);
         }
      else
         (void) sprintf(cbuf,"world coords = %10.8g, %10.8g, %10.8g",
                        dd2[0],dd2[1],dd2[2]);
      }

   (void) SCKWRD("OUTPUTD",dd2,1,3,&unit);		/* save dec. wc */
   }

SCTPUT(cbuf);
stat = 0;

end_of_it:
if (dispflg == -1) KIWORDS[OFF_LOG+3] = sav;		/* reset LOG(4) */
if (stat != 0)
   {						/* OUTPUTD(10-12)  <-  (-1) */
   if (dispflg == 1) 
      {
      if (stat == 122)
         SCTMES(M_RED_COLOR,"could not access given frame...");
      else
         SCTMES(M_RED_COLOR,"CONVERT/COORDS: conversion failed...");
      }
   for (nr=0; nr<3; nr++) dnul[nr] = -1.0;
   (void) SCKWRD("OUTPUTD",dnul,10,3,&unit);
   }
return(stat);
}


