/* @(#)prepg.c 17.1.1.1 (ESO-DMD) 01/25/02 17:37:40 */ /*=========================================================================== 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 ===========================================================================*/ /*+++++++++++++++++++ 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 010425 last modif -------------------------------------------------------------------------*/ #include #include #include #include #include /* */ 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 (ml > 0) /* always true... */ { ck = instring[nr++]; if (ck == '\0') return (-1); /* we need closing '"' */ else { KAUX.STR[ml++] = ck; if (ck == '"') { if (instring[nr] == '"') KAUX.STR[ml++] = instring[nr++]; ck = instring[nr]; /* set `ck' back to current elem */ break; } } } } if (ck == '\0') break; /* loop finished */ cm = instring[nr+1]; if ((ck == '*') && (cm == '*')) { KAUX.STR[ml++] = '`'; nr += 2; } else if ((ck == '+') && (cm == '-')) { KAUX.STR[ml++] = '-'; nr += 2; } else if ((ck == '-') && (cm == '-')) { KAUX.STR[ml++] = '+'; nr += 2; } else if ((ck == '/') && (cm == '/')) /* ckey//ckey */ { KAUX.STR[ml++] = '+'; /* not looked at in COMPU ... */ nr += 2; } else if (ck == ' ') /* skip spaces */ nr ++ ; else KAUX.STR[ml++] = instring[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,"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) { int mm, comma; char *xp, *cpp, *cppp; register char cb; 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= 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) */ *(cp + mm) = '\0'; mycount ++; latom[mycount] = CGN_COPY(atom[mycount],cp); mycount ++; ii += (9+mm); (void)strcpy(&outstring[oo],"P(S)"); oo += 4; goto main_loop; } xp = cpp; for (nr=0;;nr++) /* for (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 ++; ii += (9+mm); (void)strcpy(&outstring[oo],"Q(S,S)"); oo += 6; 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; static char limits[7] = {'\0','*','/','(',')',',','`'}; *atom = ' '; if (input[0] == '\0') { *delim = 'X'; return (0); } latm = -1; ii = -1; const_flag = 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; /* skip following tests */ } } else if (delm == ']') { if (const_flag == 2) { const_flag = 0; goto main_loop; /* skip following tests */ } } if (const_flag > 0) /* skip only inside constant */ goto main_loop; /* 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 '9') ) ) goto sect_200; } goto main_loop; /* we got such a number, continue... */ } } sect_200: if (latm > 0) { (void) strncpy(atom,input,latm); atom[latm] = '\0'; } *delim = delm; return (latm); } for (nr=0; nr 0) { (void) strncpy(atom,input,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 task[5]; kk = (int) strlen(input); *output = ' '; p1 = 0; loop: (void) strncpy(task,&input[p1],5); /* look for 1-arg functions or arrays: P S ) or A S ) */ if ( (task[0] == 'P') || (task[0] == 'A') ) { /* for functions treat specially */ if ( (task[2] != ')') || (task[1] != 'S') ) goto sect_1000; else goto sect_200; } /* look for 2-arg functions: Q S S ) */ if (task[0] == 'Q') { if ( (task[3] != ')') || (task[1] != 'S') || (task[2] != 'S') ) goto sect_1000; else goto sect_200; } /* look for 3-arg functions: R S S S ) */ if (task[0] == 'R') { if ( (task[4] != ')') || (task[1] != 'S') || (task[2] != 'S') || (task[3] != 'S') ) goto sect_1000; else goto sect_200; } /* look for operation: S S op */ if ( (task[0] != 'S') || (task[1] != 'S') || (task[2] == 'S') || (task[2] == 'A') || (task[2] == 'P') || (task[2] == 'Q') || (task[2] == 'R') ) goto sect_1000; sect_200: /* valid operation found */ if (p1 > 0) (void)strncpy(output,input,p1); /* copy 1. part */ if (task[0] == 'R') /* copy last part */ (void)strcpy(&output[p1+1],&input[p1+5]); else if (task[0] == 'Q') /* copy last part */ (void)strcpy(&output[p1+1],&input[p1+4]); else { (void)strcpy(&output[p1+1],&input[p1+3]); task[3] = ' '; /* make sure, we have no trailing stuff... */ } /* replace the operation by result */ output[p1] = 'S'; (void)strncpy(operation,task,5); /* copy task into operation */ return (p1); sect_1000: /* no valid operation, move on */ p1 ++; if (p1 >= kk) return (p1); goto loop; } /* */ #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, */ { flag = KEXP_PUSH(stapr,nchar); /* push on stack always */ goto loop_more; } else if (inpr > stval) /* if input precedence > stack value, */ { flag = 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; flag = KEXP_PUSH(0,'['); /* push '[' on stack to mark function start */ inext ++; /* skip following '(' ... */ goto loop_more; } pop_next: /* end of input string reached */ flag = KEXP_POP(&stval,&stop); if (flag == -1) /* stack empty - we're done */ { outstring[onext] = '\0'; return (0); } else { outstring[onext++] = stop; goto pop_next; /* look for more */ } } /* */ 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(); 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 dispflg = 1; (void) FRAMACC('O',TOKEN[1].STR,1,&imnoa); /* open frame */ for (nr=0; nr<3; nr++) npix[nr] = 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 ',' */ { 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); (void) 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') 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 <- (-1) */ for (nr=0; nr<12; nr++) dnul[nr] = -1.0; (void) SCKWRD("OUTPUTD",dnul,1,12,&unit); } return(stat); }