← Back to branch summary

~ubuntu-branches/ubuntu/wily/eso-midas/wily-proposed

« back to all changes in this revision

Viewing changes to monit/prepg.c

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
monit/prepg.c
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2010 European Southern Observatory (ESO)
 
3
 
 
4
  This program is free software; you can redistribute it and/or 
 
5
  modify it under the terms of the GNU General Public License as 
 
6
  published by the Free Software Foundation; either version 2 of 
 
7
  the License, or (at your option) any later version.
 
8
 
 
9
  This program is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
  GNU General Public License for more details.
 
13
 
 
14
  You should have received a copy of the GNU General Public 
 
15
  License along with this program; if not, write to the Free 
 
16
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
  MA 02139, USA.
 
18
 
 
19
  Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
        Internet e-mail: midas@eso.org
 
21
        Postal address: European Southern Observatory
 
22
                        Data Management Division 
 
23
                        Karl-Schwarzschild-Strasse 2
 
24
                        D 85748 Garching bei Muenchen 
 
25
                        GERMANY
 
26
===========================================================================*/
 
27
 
 
28
/*+++++++++++++++++++  MIDAS monitor routines PREPG  +++++++++++++++++++++++++
 
29
.LANGUAGE    C
 
30
.IDENTIFICATION  Module PREPG
 
31
.AUTHOR  K. Banse                  ESO - Garching
 
32
.KEYWORDS
 
33
  MIDAS monitor, algebraic expressions, polish notation
 
34
.COMMENTS
 
35
  holds KEXP_CLEAN, KEXP_ATOM, KEXP_REDUCE, KEXP_CLASSIFY, KEXP_POLISH,
 
36
        KEXP_STACK, KEXP_PUSH, KEXP_POP, KEXP_PEEP
 
37
        worldcnv
 
38
 
 
39
.VERSION  [1.00] 870724: built from FORTRAN version 2.50
 
40
 
 
41
 100616         last modif
 
42
-------------------------------------------------------------------------*/
 
43
 
 
44
#include <fileexts.h>
 
45
 
 
46
#include <osyparms.h>
 
47
#include <monitdef.h>
 
48
#include <midback.h>
 
49
#include <stackext.h>
 
50
 
 
51
int move_sxdc();
 
52
 
 
53
/*
 
54
 
 
55
*/
 
56
 
 
57
int KEXP_CLEAN(instring,outstring,maxcnt,atom,latom)
 
58
 
 
59
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
60
.PURPOSE
 
61
  replace all scalars by 'S', all arrays by 'A', all 1-arg functions by 'P'
 
62
  all 2-arg functions by 'Q', 3-arg functions by 'R'
 
63
  finally truncate all operators to one character.
 
64
.ALGORITHM
 
65
  use routine KEXP_ATOM to extract the objects listed above
 
66
  test for functions and arrays
 
67
  everything else is considered a scalar, constant or keyword,
 
68
  (unless it's a delimiter)
 
69
  This is a modified version of EXP_CLEAN in express.for
 
70
.RETURNS
 
71
  no. of operands in expression, -1 if something wrong
 
72
---------------------------------------------------------------------*/
 
73
 
 
74
char       *instring  /* IN: input string  */;
 
75
char       *outstring /* OUT: "cleaned" output string  */;
 
76
int        maxcnt     /* IN: max. no. of atoms   */;
 
77
char       *atom[]    /* OUT: pointer array       \
 
78
                           points to extracted operands in original form  */;
 
79
int        latom[]    /* OUT: holds lengths of 'atom'  */;
 
80
 
 
81
{
 
82
int   mycount, ml, ii, minus_flag, oo;
 
83
register int nr;
 
84
        
 
85
char    delim;
 
86
register char  ck, cm;
 
87
 
 
88
 
 
89
 
 
90
ml = 0;   nr = 0;
 
91
 
 
92
while (ml < 199)
 
93
   {
 
94
   ck = instring[nr];
 
95
   if (ck == '"')
 
96
      {
 
97
      KAUX.STR[ml++] = instring[nr++];           /* copy the '"' */
 
98
 
 
99
      while ((ck = instring[nr++]) != '\0')
 
100
         {
 
101
         KAUX.STR[ml++] = ck;
 
102
         if (ck == '"')
 
103
            {
 
104
            if (instring[nr] == '"') 
 
105
               KAUX.STR[ml++] = instring[nr++]; 
 
106
            ck = instring[nr];          /* set `ck' back to current elem */
 
107
            goto after_quote;
 
108
            }
 
109
         }
 
110
      return (-1);                        /* we need closing '"' */
 
111
      }
 
112
 
 
113
  after_quote:
 
114
   if (ck == '\0') break;                       /* loop finished */
 
115
 
 
116
   cm = instring[nr+1];
 
117
   if ((ck == '*') && (cm == '*'))
 
118
      {
 
119
      KAUX.STR[ml++] = '`';
 
120
      nr ++;
 
121
      }
 
122
   else if ((ck == '+') && (cm == '-'))
 
123
      {
 
124
      KAUX.STR[ml++] = '-';
 
125
      nr ++;
 
126
      }
 
127
   else if ((ck == '-') && (cm == '-'))
 
128
      {
 
129
      KAUX.STR[ml++] = '+';
 
130
      nr ++;
 
131
      }
 
132
   else if ((ck == '/') && (cm == '/'))  /* ckey//ckey */
 
133
      {
 
134
      KAUX.STR[ml++] = '+';             /* not looked at in COMPU ... */
 
135
      nr ++;
 
136
      }
 
137
   else if (ck != ' ')                  /* everything esle, but skip spaces */
 
138
      KAUX.STR[ml++] = ck;
 
139
   nr ++;
 
140
   }
 
141
 
 
142
KAUX.STR[ml] = '\0';
 
143
mycount = 0;
 
144
minus_flag = 0;
 
145
ii = 0;   oo = 0;
 
146
 
 
147
        
 
148
/*  extract atoms from left to right  */
 
149
 
 
150
main_loop:
 
151
if (mycount >= maxcnt)          /* return with error if too many operands  */
 
152
   return (-1);
 
153
 
 
154
latom[mycount] = KEXP_ATOM(&KAUX.STR[ii],&delim,atom[mycount]);
 
155
        
 
156
if (delim == 'X')
 
157
   {
 
158
   if (minus_flag == 1)
 
159
      outstring[oo++] = ')';            /* append closing parenthesis  */
 
160
 
 
161
   outstring[oo] = '\0';                /*  finished  */
 
162
   return mycount;
 
163
   }
 
164
        
 
165
 
 
166
 
 
167
/*  in first pass the atom + delimiter is returned  */
 
168
/*  ------------------------------------------------*/
 
169
 
 
170
if (latom[mycount] != 0) 
 
171
   {
 
172
   if (delim != '(')
 
173
      outstring[oo] = 'S';              /* it's a scalar keyword or constant */
 
174
   else
 
175
      {
 
176
      outstring[oo] = 'A';              /* default to keyword array  */
 
177
   
 
178
      if (*(atom[mycount]+1) == '$')    /* look for M$function  */
 
179
         {
 
180
         CGN_UPSTR(atom[mycount]);
 
181
         if (*atom[mycount] == 'M') 
 
182
            {
 
183
            register char  *cp;
 
184
   
 
185
            cp = atom[mycount] + 2;
 
186
            if ( (strncmp(cp,"INDEX",5) == 0)  || 
 
187
                 (strcmp(cp,"FILTYP") == 0) ||
 
188
                 (strcmp(cp,"STRCMP") == 0) ||
 
189
                 (strcmp(cp,"PARSE") == 0) )
 
190
               outstring[oo] = 'Q';             /* 2-arg function  */
 
191
   
 
192
            else if (strcmp(cp,"REPLA") == 0) 
 
193
                outstring[oo] = 'R';            /* 3-arg function */
 
194
 
 
195
            else if (strncmp(cp,"EXIST",5) == 0) 
 
196
               {
 
197
               ck = *(cp+5);
 
198
               if ( (ck == 'D') || (ck == 'C') )
 
199
                  outstring[oo] = 'Q';          /* 2-arg function  */
 
200
               else
 
201
                  outstring[oo] = 'P';          /* 1-arg function  */
 
202
               }
 
203
 
 
204
            else if ( (strcmp(cp,"VALUE") == 0) ||
 
205
                      (strcmp(cp,"TNULL") == 0) )
 
206
               {
 
207
               int  mm, comma;
 
208
               char  *xp, *cpp, *cppp;
 
209
               register char cb;
 
210
 
 
211
               cpp = (char *) 0;                /* init */
 
212
               cp = &KAUX.STR[ii+8];            /* move to after M$VALUE( */
 
213
               mm = CGN_INDEXC(cp,')');
 
214
               if (mm < 1) return (-1);
 
215
 
 
216
               /* this processing disables:
 
217
                  m$value(..m$func()..) or m$value(..a+b..) 
 
218
                  but supports: `wild' file names            */
 
219
 
 
220
               xp = cp;                 /* test for the different options */
 
221
               comma = 0;
 
222
               for (nr=0; nr<mm; nr++)
 
223
                  {
 
224
                  cb = *xp++;
 
225
                  if (cb == '[')                /* (image[...]) */
 
226
                     break;
 
227
                  else if (cb == ',')
 
228
                     {
 
229
                     comma ++;
 
230
                     if (comma == 1) 
 
231
                        {
 
232
                        cpp = xp;
 
233
                        *(cpp-1) = '\0';
 
234
                        }
 
235
                     else
 
236
                        {                       /* (table,column,row) */
 
237
                        cppp = xp;
 
238
                        *(cp + mm) = '\0';                      
 
239
                        *(cppp-1) = '\0';
 
240
 
 
241
                        if ((mycount+3) >= maxcnt) return(-1);
 
242
                        mycount ++;
 
243
                        latom[mycount] = CGN_COPY(atom[mycount],cp);
 
244
                        mycount ++;
 
245
                        latom[mycount] = CGN_COPY(atom[mycount],cpp);
 
246
                        mycount ++;
 
247
                        latom[mycount] = CGN_COPY(atom[mycount],cppp);
 
248
                        mycount ++;
 
249
                        ii += (9+mm);   
 
250
                        (void)strcpy(&outstring[oo],"R(S,S,S)");
 
251
                        oo += 8;
 
252
                        goto main_loop;
 
253
                        }
 
254
                     }
 
255
                  }
 
256
 
 
257
               if (comma == 0) 
 
258
                  {                             /* (keyword) */
 
259
                  xp = cp;
 
260
                  for (nr=0;;nr++)              /* if (key()) */
 
261
                     {                          /* avoid P(A(S)) ... */
 
262
                     cb = *xp++;
 
263
                     if (cb == ')')
 
264
                        break;
 
265
                     else if (cb == '(')
 
266
                        {
 
267
                        mm ++;                  /* include last ')' */
 
268
                        break;
 
269
                        }
 
270
                     }
 
271
 
 
272
                  *(cp + mm) = '\0';                    
 
273
                  mycount ++;
 
274
                  latom[mycount] = CGN_COPY(atom[mycount],cp);
 
275
                  mycount ++;
 
276
                  (void)strcpy(&outstring[oo],"P(S)");
 
277
                  oo += 4;
 
278
                  }
 
279
               else
 
280
                  {
 
281
                  xp = cpp;
 
282
                  for (nr=0;;nr++)                      /* if (frame,descr()) */
 
283
                     {                          /* avoid Q(S,A(S)) ... */
 
284
                     cb = *xp++;
 
285
                     if (cb == ')')
 
286
                        break;
 
287
                     else if (cb == '(')
 
288
                        {
 
289
                        mm ++;
 
290
                        break;
 
291
                        }                               /* (frame,descr) */
 
292
                     }
 
293
 
 
294
                  *(cp + mm) = '\0';                    
 
295
                  if ((mycount+2) >= maxcnt) return(-1);
 
296
                  mycount ++;
 
297
                  latom[mycount] = CGN_COPY(atom[mycount],cp);
 
298
                  mycount ++;
 
299
                  latom[mycount] = CGN_COPY(atom[mycount],cpp);
 
300
                  mycount ++;
 
301
                  (void)strcpy(&outstring[oo],"Q(S,S)");
 
302
                  oo += 6;
 
303
                  }
 
304
 
 
305
               ii += (9+mm);                    /* skip M$VALUE(...) */
 
306
               goto main_loop;
 
307
               }
 
308
 
 
309
            else
 
310
               outstring[oo] = 'P';     /* all other are 1-arg functions */
 
311
            }
 
312
         }
 
313
      }
 
314
        
 
315
   oo ++ ;
 
316
   ii += latom[mycount++];
 
317
        
 
318
   if (minus_flag == 1)
 
319
      {
 
320
      minus_flag = 0;                   /* reset flag  */
 
321
      outstring[oo++] = ')';            /* and append closing parenthesis  */
 
322
      }
 
323
   }
 
324
 
 
325
 
 
326
/*  in second pass the delimiter only is returned  */
 
327
/*  -----------------------------------------------*/
 
328
 
 
329
else
 
330
   {
 
331
   if (delim == '-')            
 
332
      {
 
333
      if ( (oo == 0) ||                         /* test for unary minus sign  */
 
334
           (outstring[oo-1] == '(') )   /* or  (-  */
 
335
         {
 
336
         *atom[mycount] = '0';          /* if so, replace it by " 0 - "  */
 
337
         atom[mycount][1] = ' ';
 
338
         latom[mycount++] = 1;
 
339
         outstring[oo++] = 'S';
 
340
         }
 
341
      else if ( (outstring[oo-1] == '*') || (outstring[oo-1] == '/') )
 
342
         {
 
343
         outstring[oo] = '(';           /* open parenthesis  */
 
344
         *atom[mycount] = '0';          /* if so, replace it by " 0 - "   */
 
345
         *(atom[mycount]+1) = ' ';
 
346
         latom[mycount++] = 1;
 
347
         outstring[++oo] = 'S';
 
348
         oo ++;
 
349
         minus_flag = 1;        /* set minus flag, since ) still to be added */
 
350
         }
 
351
      }
 
352
        
 
353
   else if (delim == '+')
 
354
      {
 
355
      if ( (oo == 0) ||                         /* test for unary plus sign  */
 
356
           ( (oo > 0) && (outstring[oo-1] == '(') ) )
 
357
         {
 
358
         ii ++ ;                        /* if so, ignore it  */
 
359
         goto main_loop;
 
360
         }
 
361
      }
 
362
        
 
363
   outstring[oo++] = delim;
 
364
   ii ++ ;
 
365
   }
 
366
 
 
367
goto main_loop;
 
368
 
 
369
}
 
370
/*
 
371
 
 
372
*/
 
373
 
 
374
int KEXP_ATOM(input,delim,atom)
 
375
 
 
376
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
377
.PURPOSE
 
378
  extract atoms and their delimiters from an arithmetic expression
 
379
.ALGORITHM
 
380
  straight forward, but watch out for ASCII constants "..." , they may contain
 
381
  delimiters
 
382
  This is a modified version of module EXP_ATOM in express.for
 
383
.RETURNS
 
384
int   length of 'atom' 
 
385
---------------------------------------------------------------------*/
 
386
 
 
387
char    *input  /* IN: input string  */;
 
388
char    *delim  /* OUT: delimiter of returned atom  */;
 
389
char    *atom   /* OUT: extracted operand   */;
 
390
 
 
391
{
 
392
int   const_flag, ii, latm;
 
393
register int  nr;
 
394
        
 
395
register char   delm, cc;
 
396
 
 
397
static int nlimits = 7, klimits = 9;
 
398
static char   limits[9] = {'\0','*','/','(',')',',','`','+','-'};
 
399
 
 
400
 
 
401
 
 
402
*atom = ' ';
 
403
delm = input[0];
 
404
 
 
405
if (delm == '\0')
 
406
   {
 
407
   *delim = 'X';
 
408
   return (0);
 
409
   }
 
410
 
 
411
latm = 0;
 
412
ii = 0;
 
413
const_flag = 0; 
 
414
 
 
415
 
 
416
/* here is the simplified 1st execution of the main_loop below */
 
417
/* ----------------------------------------------------------- */
 
418
 
 
419
 
 
420
 
 
421
if (delm == '"')                        /* check for ASCII constants */
 
422
   {
 
423
   const_flag = 1;
 
424
   goto main_loop;
 
425
   }
 
426
else if (delm == '[') 
 
427
   {
 
428
   const_flag = 2;
 
429
   goto main_loop;                      /* raise flag to 2 */
 
430
   }
 
431
 
 
432
for (nr=1; nr<klimits; nr++)            /* we checked for '\0' already above */
 
433
   {
 
434
   if (delm == limits[nr])
 
435
      {
 
436
      *delim = delm;
 
437
      return (0);
 
438
      }
 
439
   }
 
440
 
 
441
 
 
442
 
 
443
        
 
444
main_loop:
 
445
latm++;
 
446
delm = input[++ii];
 
447
        
 
448
 
 
449
/*  check for ASCII constants  */
 
450
 
 
451
if (delm == '"') 
 
452
   {
 
453
   if (const_flag < 2)
 
454
      {
 
455
      const_flag = 1 - const_flag;              /*  1 => 0 and 0 => 1  */
 
456
      goto main_loop;                           /* skip following tests  */
 
457
      }
 
458
   }
 
459
else if (delm == '[')
 
460
   {
 
461
   if (const_flag == 0)
 
462
      {
 
463
      const_flag = 2;
 
464
      goto main_loop;                   /* raise flag to 2 */
 
465
      }
 
466
   }
 
467
else if (delm == ']') 
 
468
   {
 
469
   if (const_flag == 2)
 
470
      {
 
471
      const_flag = 0;
 
472
      goto main_loop;                   /* lower flag to 0 */
 
473
      }
 
474
   }
 
475
 
 
476
if (const_flag == 0)                    /* we're NOT inside constant  */
 
477
   {
 
478
   /*  first look for ddd.Eee numbers    */
 
479
 
 
480
   if ( (delm == '+') || (delm == '-') )
 
481
      {
 
482
      if (latm > 1)
 
483
         {
 
484
         cc = input[latm-1];
 
485
         if ( (cc == 'E') || (cc == 'e') || (cc == 'D') || (cc == 'd') )
 
486
            {
 
487
            for (nr=0; nr<latm-1; nr++)
 
488
               {
 
489
               cc = input[nr];
 
490
               if ( (cc != '.') && ((cc < '0') || (cc > '9')) )
 
491
                  goto sect_200;
 
492
               }
 
493
            goto main_loop;     /* we got such a number, continue...  */
 
494
            }
 
495
         }
 
496
   
 
497
     sect_200:    
 
498
      (void) memcpy(atom,input,(size_t)latm);
 
499
      atom[latm] = '\0';
 
500
      *delim = delm;
 
501
      return (latm);
 
502
      }
 
503
 
 
504
   for (nr=0; nr<nlimits; nr++)
 
505
      {
 
506
      if (delm == limits[nr]) 
 
507
         {
 
508
         (void) memcpy(atom,input,(size_t)latm);
 
509
         atom[latm] = '\0';
 
510
         *delim = delm;
 
511
         return (latm);
 
512
         }
 
513
      }
 
514
   }
 
515
 
 
516
goto main_loop;                 /*  no delimiter - loop more  */
 
517
}
 
518
 
 
519
/*
 
520
 
 
521
*/
 
522
 
 
523
int KEXP_REDUCE(input,output,operation)
 
524
 
 
525
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
526
.PURPOSE
 
527
  extract from a given polish expression the next binary subexpression
 
528
  and reduce the expression accordingly (replace subexpression by result)
 
529
.ALGORITHM
 
530
  look for instances of 'S S op' or 'A S )' or 'P S )' or 'Q S S )'
 
531
                                 or 'R S S S )'
 
532
  A = array, P = 1 arg function, Q = 2 arg function, R = 3 arg function
 
533
  This routine is a modified verrsion of EXP_REDUCE in express.for
 
534
.RETURNS 
 
535
int   starting index of subexpression in input string 
 
536
------------------------------------------------------------------------*/
 
537
 
 
538
char    *input  /* IN: input string (terminated by '\0') */;
 
539
char    *output /* OUT: "reduced" output string  */;
 
540
char    *operation  /* OUT: subexpression to execute next  */;
 
541
 
 
542
{       
 
543
int   kk, p1;
 
544
        
 
545
char  *t0, *t1, *t2;
 
546
register char  cr;
 
547
 
 
548
 
 
549
        
 
550
kk = (int) strlen(input);
 
551
*output = ' ';
 
552
p1 = 0;
 
553
 
 
554
        
 
555
loop:
 
556
t0 = &input[p1]; t1 = t0 + 1; t2 = t0 + 2;
 
557
cr = *t0;
 
558
 
 
559
        
 
560
/* look for 1-arg functions or arrays: P S ) or A S )  */
 
561
 
 
562
if ( (cr == 'P') || (cr == 'A') )               
 
563
   {                                    /* for functions treat specially  */
 
564
   if ( (*t2 != ')') || (*t1 != 'S') )
 
565
      goto sect_1000;
 
566
   else
 
567
      goto sect_200;
 
568
   }
 
569
        
 
570
 
 
571
/* look for 2-arg functions: Q S S )  */
 
572
 
 
573
if (cr == 'Q')
 
574
   {
 
575
   if ( (*(t0+3) != ')') || (*t1 != 'S') || (*t2 != 'S') )
 
576
      goto sect_1000;
 
577
   else
 
578
      goto sect_200;
 
579
   }
 
580
        
 
581
 
 
582
/* look for 3-arg functions: R S S S )  */
 
583
 
 
584
if (cr == 'R')
 
585
   {
 
586
   if ( (*(t0+4) != ')') || 
 
587
        (*t1 != 'S') || (*t2 != 'S') || (*(t0+3) != 'S') )
 
588
      goto sect_1000;
 
589
   else
 
590
      goto sect_200;
 
591
   }
 
592
        
 
593
 
 
594
/*  look for operation: S S op  */
 
595
 
 
596
if ( (cr != 'S') || (*t1 != 'S') ||
 
597
     (*t2 == 'S') || (*t2 == 'A') ||
 
598
     (*t2 == 'P') || (*t2 == 'Q') || (*t2 == 'R') )
 
599
   goto sect_1000;
 
600
 
 
601
 
 
602
sect_200:                               /*  valid operation found  */
 
603
if (p1 > 0)
 
604
   (void) strncpy(output,input,(size_t)p1);             /* copy 1. part  */
 
605
 
 
606
if (cr == 'R')                          /* copy last part */
 
607
   (void) strcpy(&output[p1+1],&input[p1+5]);
 
608
 
 
609
else if (cr == 'Q')                     /* copy last part */
 
610
   (void) strcpy(&output[p1+1],&input[p1+4]);
 
611
 
 
612
else
 
613
   {
 
614
   (void) strcpy(&output[p1+1],&input[p1+3]);           
 
615
   *(t0+3) = ' ';               /* make sure, we have no trailing stuff...  */
 
616
   }
 
617
 
 
618
        
 
619
/*  replace the operation by result  */
 
620
 
 
621
output[p1] = 'S';
 
622
(void) strncpy(operation,t0,(size_t)5);         /* copy task into operation  */
 
623
return (p1);
 
624
 
 
625
 
 
626
sect_1000:              /*  no valid operation, move on  */
 
627
if (++p1 < kk) goto loop;
 
628
 
 
629
return (p1);
 
630
}
 
631
 
 
632
/*
 
633
 
 
634
*/
 
635
 
 
636
#ifdef __STDC__
 
637
int KEXP_CLASSIFY(char input, int *ipr, int *spr)
 
638
#else
 
639
int KEXP_CLASSIFY(input,ipr,spr)
 
640
 
 
641
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
642
.PURPOSE
 
643
  assign an input and a stack priority to each operation
 
644
.ALGORITHM
 
645
  straight forward, since priorities are fixed
 
646
  This routine is a modified version of EXP_CLASSifY in express.for
 
647
.RETURNS
 
648
int   1 for scalar, S
 
649
      2 for operator, +,-,... ,
 
650
      3 for function or array, P,Q,R,A  
 
651
---------------------------------------------------------------------*/
 
652
 
 
653
char    input;   /* IN: input operator or operand  */
 
654
int     *ipr;    /* OUT: input priority  */
 
655
int     *spr;    /* OUT: stack priority  */
 
656
#endif
 
657
 
 
658
{
 
659
static int   inpr[8] = {1,1,2,2,4,0,0,3};               /* input precedence  */
 
660
static int   stpr[8] = {1,1,2,2,0,4,0,3};               /* stack precedence  */
 
661
register int  nr;
 
662
 
 
663
static char   oper[8] = {'+','-','*','/','(',')',',','`'};
 
664
 
 
665
        
 
666
*ipr = 0;
 
667
*spr = 0;
 
668
 
 
669
if (input == 'S')
 
670
   return (1);                                  /* scalar */
 
671
 
 
672
if ( (input == 'A') || (input == 'P') || (input == 'Q') || (input == 'R') )
 
673
   return(3);                                   /*  function or array */
 
674
        
 
675
 
 
676
/*  otherwise compare input with operators  */
 
677
 
 
678
for (nr=0; nr<8; nr++)
 
679
   {
 
680
   if (input == oper[nr])
 
681
      {
 
682
      *ipr = inpr[nr];
 
683
      *spr = stpr[nr];
 
684
      return (2);                       /* should be an operator...  */
 
685
      }
 
686
   }
 
687
 
 
688
return (2);                             /* nothing of above  */
 
689
}
 
690
 
 
691
/*
 
692
 
 
693
*/
 
694
 
 
695
int KEXP_POLISH(instring,outstring)
 
696
 
 
697
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
698
.PURPOSE
 
699
  convert an expression in "normal" algebraic notation to polish reversed notat
 
700
.ALGORITHM
 
701
  use a stack to store temporary data
 
702
  functions as P(A+B) will be converted to PAB+) to indicate range of function
 
703
.RETURNS
 
704
  status:               return status
 
705
                        = 0, o.k., else trouble...
 
706
---------------------------------------------------------------------*/
 
707
 
 
708
char    *instring  /* IN: input string  */;
 
709
char    *outstring /* OUT: output string in polish reversed notation  */;
 
710
 
 
711
{
 
712
        
 
713
int   flag, inext, inpr, kk;
 
714
int   onext, type;
 
715
int stapr, srval, stval;
 
716
        
 
717
char    nchar, stop;
 
718
        
 
719
 
 
720
 
 
721
 
 
722
kk = (int) strlen(instring);
 
723
KEXP_STACK();
 
724
inext = 0;
 
725
onext = 0;
 
726
 
 
727
        
 
728
/*  extract operators and operands from left to right  */
 
729
        
 
730
loop_more:
 
731
if (inext > kk) goto pop_next;                  /* end of string reached  */
 
732
 
 
733
nchar = instring[inext++];
 
734
type = KEXP_CLASSIFY(nchar,&inpr,&stapr);       /* classify token  */
 
735
        
 
736
 
 
737
if (type == 1)          /*  number/variable  */
 
738
   {
 
739
   outstring[onext++] = nchar;
 
740
   goto loop_more;
 
741
   }
 
742
 
 
743
else if (type == 2)     /*  operator  */
 
744
   {
 
745
  sect_200:
 
746
   if (nchar == ')')    /*  if [nchar] = closing parenthese, unwind stack   */
 
747
      {
 
748
     sect_220:
 
749
      flag = KEXP_POP(&stval,&stop);            /* pop from stack  */
 
750
      if (flag == -1) return (1);               /* missing parentheses...  */
 
751
      
 
752
      if (stop == '(') 
 
753
         goto loop_more;                   /* eliminate matching parentheses  */
 
754
      else if (stop == '[')
 
755
         {
 
756
         outstring[onext++] = nchar;       /* write ')' for end-of-function  */
 
757
         goto loop_more;
 
758
         }
 
759
      else
 
760
         {
 
761
         outstring[onext++] = stop;     /* store stack operator in output str */
 
762
         goto sect_220;
 
763
         }
 
764
      }
 
765
 
 
766
   else if (nchar == ',')
 
767
      {                    /* if nchar = closing comma, unwind stack till '[' */
 
768
     sect_250:
 
769
      flag = KEXP_PEEP(&stval,&stop);                   /* look at stack  */
 
770
      if (flag == -1) return (1);                       /* something missing  */
 
771
 
 
772
      if (stop == '[')
 
773
         goto loop_more;                                /* ok...  */
 
774
      else
 
775
         {
 
776
         flag = KEXP_POP(&srval,&stop);                 /* pop stack  */
 
777
         outstring[onext++] = stop;     /* store stack operator in output str */
 
778
         goto sect_250;
 
779
         }
 
780
      }
 
781
 
 
782
   else         /*  all other characters here...  */
 
783
      {
 
784
      flag = KEXP_PEEP(&stval,&stop);   /* look what's on top of the stack  */
 
785
      if (flag == -1)                           /* if stack empty,  */
 
786
         {
 
787
         (void) KEXP_PUSH(stapr,nchar);         /* push on stack always  */
 
788
         goto loop_more;
 
789
         }
 
790
        
 
791
      else if (inpr > stval)            /* if input precedence > stack value, */
 
792
         {
 
793
         (void) KEXP_PUSH(stapr,nchar);   /* push stack precedence on stack  */
 
794
         goto loop_more;
 
795
         }
 
796
      else
 
797
         {
 
798
         flag = KEXP_POP(&stval,&stop);
 
799
         outstring[onext++] = stop;
 
800
         goto sect_200;
 
801
         }
 
802
      }
 
803
   }
 
804
 
 
805
else                    /*  function  */
 
806
   {
 
807
   outstring[onext++] = nchar;
 
808
   (void) KEXP_PUSH(0,'[');     /* push '[' on stack to mark function start */
 
809
   inext ++;                                    /* skip following '(' ...  */
 
810
   goto loop_more;
 
811
   }
 
812
 
 
813
 
 
814
pop_next:                               /*  end of input string reached  */
 
815
while (KEXP_POP(&stval,&stop) != (-1)) 
 
816
   outstring[onext++] = stop;
 
817
 
 
818
outstring[onext] = '\0';        /* stack empty - we're done  */
 
819
return (0);
 
820
}
 
821
 
 
822
/*
 
823
 
 
824
*/
 
825
 
 
826
void KEXP_STACK()
 
827
 
 
828
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
829
.PURPOSE
 
830
  initialize stack
 
831
.ALGORITHM
 
832
  clear
 
833
.RETURNS
 
834
  nothing
 
835
---------------------------------------------------------------------*/
 
836
        
 
837
{
 
838
STACK.PNTR = -1;        /* pointer to top of stack  */
 
839
STACK.OVF = 39;         /* max. 40 operands on line of 80 characters...  */
 
840
}
 
841
 
 
842
 
 
843
 
 
844
#ifdef __STDC__
 
845
int KEXP_PUSH(int ival, char cval)
 
846
#else
 
847
int KEXP_PUSH(ival,cval)
 
848
 
 
849
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
850
.PURPOSE
 
851
  push on stack
 
852
.ALGORITHM
 
853
  clear
 
854
.RETURNS
 
855
  0 = o.k.
 
856
  1 = overflow
 
857
---------------------------------------------------------------------*/
 
858
 
 
859
int  ival    /* IN: integer value  */;
 
860
char cval    /* IN: char. value  */;
 
861
#endif
 
862
 
 
863
{
 
864
if (STACK.PNTR >= STACK.OVF)  return (1);
 
865
        
 
866
STACK.CA[++STACK.PNTR] = cval;                  /*  stack o.k.  */
 
867
STACK.IA[STACK.PNTR] = ival;
 
868
 
 
869
return (0);
 
870
}
 
871
 
 
872
/*
 
873
 
 
874
*/
 
875
 
 
876
int KEXP_POP(ival,cval)
 
877
 
 
878
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
879
.PURPOSE
 
880
  pop from stack
 
881
.ALGORITHM
 
882
  clear
 
883
.RETURNS
 
884
  0 = o.k.
 
885
  1 = underflow
 
886
---------------------------------------------------------------------*/
 
887
 
 
888
int  *ival    /* OUT: integer value  */;
 
889
char *cval    /* OUT: char. value  */;
 
890
 
 
891
{
 
892
if (STACK.PNTR < 0) return (-1);
 
893
        
 
894
*ival = STACK.IA[STACK.PNTR];                   /*  stack o.k.  */
 
895
*cval = STACK.CA[STACK.PNTR--];
 
896
 
 
897
return (0);
 
898
}
 
899
 
 
900
 
 
901
 
 
902
 
 
903
int KEXP_PEEP(ival,cval)
 
904
 
 
905
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
906
.PURPOSE
 
907
  look at stack
 
908
.ALGORITHM
 
909
  clear
 
910
.RETURNS
 
911
  0 = o.k.
 
912
  1 = underflow
 
913
---------------------------------------------------------------------*/
 
914
 
 
915
int  *ival    /* OUT: integer value  */;
 
916
char *cval    /* OUT: char. value  */;
 
917
 
 
918
{
 
919
if (STACK.PNTR < 0) return (-1);
 
920
 
 
921
*ival = STACK.IA[STACK.PNTR];                   /*  stack o.k.  */
 
922
*cval = STACK.CA[STACK.PNTR];
 
923
 
 
924
return (0);
 
925
}
 
926
 
 
927
/*
 
928
 
 
929
*/
 
930
 
 
931
int worldcnv()
 
932
 
 
933
{
 
934
int  nval, nulo, unit, imnoa, pixdim, direc, linflag, dispflg, sav;
 
935
int  k, mm, off, stat, px3, npix[3], sublo[3], subhi[3];
 
936
register int  nr;
 
937
 
 
938
char  cbuf[104], tbuf[80], auxstr[80], convstr[80], subs[3][32];
 
939
register char  cr;
 
940
 
 
941
double   dd1[3], dd2[3], dd3[6], dnul[12];
 
942
 
 
943
float   rr, rval[3];
 
944
 
 
945
void  form_sexa();
 
946
 
 
947
 
 
948
 
 
949
mm = 0;
 
950
cr = TOKEN[3].STR[0];                   /* check, if no output wanted */
 
951
 
 
952
if ((cr == 'N') || (cr == 'n'))
 
953
   {
 
954
   sav = KIWORDS[OFF_LOG+3];            /* save current settings */
 
955
   KIWORDS[OFF_LOG+3] = 1;
 
956
   dispflg = -1;
 
957
   }
 
958
else
 
959
   {
 
960
   sav = 0;
 
961
   dispflg = 1;
 
962
   }
 
963
 
 
964
(void) FRAMACC('O',TOKEN[1].STR,1,&imnoa);              /* open frame */
 
965
if (imnoa < 0)
 
966
   {
 
967
   stat = 122;
 
968
   goto end_of_it;
 
969
   }
 
970
 
 
971
npix[0] = npix[1] = npix[2] = 1;
 
972
(void) SCDRDI(imnoa,"NPIX",1,3,&nval,npix,&nulo,&unit);
 
973
 
 
974
linflag = fp2wc(0,imnoa,dd1,dd2);       /* init + test, if `real' WCS */
 
975
 
 
976
 
 
977
for (nr=0; nr<3; nr++)
 
978
  {
 
979
  dd1[nr] = 1.0;
 
980
  dd2[nr] = 0.0;
 
981
  sublo[nr] = 0;
 
982
  }
 
983
 
 
984
 
 
985
(void) strcpy(cbuf,TOKEN[2].STR);               /* coord specs */
 
986
px3 = 0;
 
987
cr = cbuf[0];
 
988
if ((cr == '@') || (cr == '>') || (cr == '<') || (cr == 'C'))
 
989
   direc = 1;                           /* frame pixels entered */
 
990
else
 
991
   {                                    /* world coords entered */
 
992
   direc = 0;
 
993
   k = CGN_INDEXC(cbuf,',');
 
994
   if (k > 0)                           /* at least 2 dim */
 
995
      {
 
996
      nr = k + 1;
 
997
      k = CGN_INDEXC(&cbuf[nr],',');
 
998
      if (k > 0)
 
999
         {
 
1000
         mm = nr + k + 1;
 
1001
         cr = cbuf[mm];
 
1002
         if ((cr == '@') || (cr == '>') || (cr == '<') || (cr == 'C'))
 
1003
            px3 = 1;                    /* we have a 3rd fpix index */
 
1004
         }
 
1005
      }
 
1006
   }    
 
1007
 
 
1008
 
 
1009
 
 
1010
/*  world coords in, frame pixels out */
 
1011
 
 
1012
if (direc == 0)                         /* world coords entered */
 
1013
   {
 
1014
   stat = Convcoo(0,imnoa,cbuf,3,&pixdim,sublo,subhi);
 
1015
   if (stat != 0) 
 
1016
      {
 
1017
      stat = 98;
 
1018
      goto end_of_it;
 
1019
      }
 
1020
 
 
1021
   if (px3 == 1)
 
1022
      {
 
1023
      (void) SCDRDD(imnoa,"START",1,3,&nval,dd1,&nulo,&unit);
 
1024
      (void) SCDRDD(imnoa,"STEP",1,3,&nval,dd2,&nulo,&unit);
 
1025
      dd1[0] = dd1[2] + sublo[2]*dd2[2];
 
1026
      (void) sprintf(tbuf,"%8.8g",dd1[0]);
 
1027
      k = 7;
 
1028
      for (nr=0; nr<7; nr++)            /* skip leading blanks */
 
1029
         {
 
1030
         if (tbuf[nr] != ' ')
 
1031
            {
 
1032
            k = nr;
 
1033
            break;
 
1034
            }
 
1035
         }
 
1036
      (void) strcpy(&cbuf[mm],&tbuf[k]);
 
1037
      }
 
1038
   (void) sprintf(auxstr,"world coords entered = %s",cbuf);
 
1039
   SCTPUT(auxstr);
 
1040
 
 
1041
   for (nr=0; nr<pixdim; nr++) sublo[nr] ++;
 
1042
   
 
1043
 
 
1044
   if (pixdim == 1)                             /* 1-dim frame */
 
1045
      {
 
1046
      (void) CGN_CNVT(cbuf,4,1,subhi,rval,dd1);
 
1047
      (void) sprintf(cbuf,"frame pixels = %d",sublo[0]);
 
1048
      }
 
1049
 
 
1050
   else if (pixdim == 2)                        /* 2-dim frame */
 
1051
      {
 
1052
      dd1[2] = 1.0;
 
1053
      if (linflag == 0)
 
1054
         {
 
1055
         (void) strcpy(convstr,cbuf);           /* prepare string for CNVT */
 
1056
         for (nr=0; nr<80; nr++)                /*  ':'  ->  ','  */
 
1057
            {
 
1058
            if (convstr[nr] == ':')
 
1059
               convstr[nr] = ',';
 
1060
            else if (convstr[nr] == '\0')
 
1061
               break;
 
1062
            }
 
1063
 
 
1064
         k = CGN_INDEXC(cbuf,',');
 
1065
         cbuf[k] = '\0';
 
1066
         off = CGN_INDEXC(cbuf,':');            /* off > 0: sexa -> dec */
 
1067
         (void) move_sxdc(off,1,cbuf,auxstr);           /* RA */
 
1068
         (void) sprintf(tbuf,"  or %s, ",auxstr);
 
1069
         k ++;
 
1070
 
 
1071
         if (off > 0)                           /* RA, DEC input */
 
1072
            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
 
1073
         else                                   /* decimal input */
 
1074
            (void) CGN_CNVT(convstr,4,2,subhi,rval,dd1);
 
1075
 
 
1076
 
 
1077
         (void) move_sxdc(off,0,&cbuf[k],auxstr);       /* DEC */
 
1078
         (void) strcat(tbuf,auxstr);
 
1079
         SCTPUT(tbuf);
 
1080
 
 
1081
         if (off > 0)                           /* tbuf holds decimal wc */
 
1082
            (void) CGN_CNVT(&tbuf[5],4,2,subhi,rval,dd1);
 
1083
         else                                   /* tbuf holds RA,DEC wc */
 
1084
            {
 
1085
            (void) strcpy(convstr,&tbuf[5]);        /* save string,  : -> ,  */
 
1086
            for (nr=0; nr<80; nr++)
 
1087
               {
 
1088
               if (convstr[nr] == ':')
 
1089
                  convstr[nr] = ',';
 
1090
               else if (convstr[nr] == '\0')
 
1091
                  break;
 
1092
               }
 
1093
 
 
1094
            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
 
1095
            }
 
1096
 
 
1097
         (void) SCKWRD("OUTPUTD",dd1,1,3,&unit);   /* save dec. coords */
 
1098
         (void) SCKWRD("OUTPUTD",dd3,4,6,&unit);   /* save hours,mins,secs */
 
1099
         }
 
1100
      (void) sprintf(cbuf,"frame pixels = %d,%d",sublo[0],sublo[1]);
 
1101
      }
 
1102
 
 
1103
   else                                         /* 3-dim frame */
 
1104
      {
 
1105
      if (linflag == 0)
 
1106
         {
 
1107
         (void) strcpy(convstr,cbuf);           /* prepare string for CNVT */
 
1108
         for (nr=0; nr<80; nr++)                /*  ':'  ->  ','  */
 
1109
            {
 
1110
            if (convstr[nr] == ':')
 
1111
               convstr[nr] = ',';
 
1112
            else if (convstr[nr] == '\0')
 
1113
               break;
 
1114
            }
 
1115
 
 
1116
         k = CGN_INDEXC(cbuf,',');
 
1117
         cbuf[k] = '\0';
 
1118
         off = CGN_INDEXC(cbuf,':');            /* off > 0: sexa -> dec */
 
1119
         (void) move_sxdc(off,1,cbuf,auxstr);           /* RA */
 
1120
         (void) sprintf(tbuf,"  or %s, ",auxstr);
 
1121
         k ++;
 
1122
 
 
1123
         if (off > 0)                           /* RA, DEC input */
 
1124
            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
 
1125
         else                                   /* decimal input */
 
1126
            (void) CGN_CNVT(convstr,4,2,subhi,rval,dd1);
 
1127
 
 
1128
         CGN_strcpy(cbuf,&cbuf[k]);             /* move to y-, z- pixel */
 
1129
         k = CGN_INDEXC(cbuf,',');
 
1130
         cbuf[k] = '\0';
 
1131
         (void) move_sxdc(off,0,cbuf,auxstr);           /* DEC */
 
1132
         (void) strcat(tbuf,auxstr);
 
1133
 
 
1134
         if (off > 0)                                   /* tbuf: dec. wc */
 
1135
            (void) CGN_CNVT(&tbuf[5],4,2,subhi,rval,dd1);
 
1136
         else                                           /* tbuf: RA,DEC wc */
 
1137
            {
 
1138
            (void) strcpy(convstr,&tbuf[5]);        /* save string,  : -> ,  */
 
1139
            for (nr=0; nr<80; nr++)
 
1140
               {
 
1141
               if (convstr[nr] == ':')
 
1142
                  convstr[nr] = ',';
 
1143
               else if (convstr[nr] == '\0')
 
1144
                  break;
 
1145
               }
 
1146
 
 
1147
            (void) CGN_CNVT(convstr,4,6,subhi,rval,dd3);
 
1148
            }
 
1149
 
 
1150
         (void) strcat(tbuf,", ");
 
1151
         k ++;
 
1152
         (void) CGN_CNVT(&cbuf[k],4,1,subhi,rval,&dd1[2]);
 
1153
         (void) strcat(tbuf,&cbuf[k]);
 
1154
         SCTPUT(tbuf);
 
1155
 
 
1156
         (void) SCKWRD("OUTPUTD",dd3,4,6,&unit);   /* save hours,mins,secs */
 
1157
         }
 
1158
 
 
1159
      (void) sprintf(cbuf,
 
1160
                     "frame pixels = %d,%d,%d",sublo[0],sublo[1],sublo[2]);
 
1161
      (void) SCKWRD("OUTPUTD",dd1,1,3,&unit);      /* save dec. wcoords */
 
1162
      }
 
1163
 
 
1164
   dd2[0] = (double) sublo[0];                  /* store frame pixels */
 
1165
   dd2[1] = (double) sublo[1];
 
1166
   dd2[2] = (double) sublo[2];
 
1167
   (void) SCKWRD("OUTPUTD",dd2,10,3,&unit); 
 
1168
   }
 
1169
 
 
1170
 
 
1171
/*  frame pixels in, world coords out */
 
1172
 
 
1173
else                                    /* pixel coords. entered */
 
1174
   {
 
1175
   off = 0;
 
1176
   pixdim = 0;
 
1177
   for (nr=0; nr<3; nr++)
 
1178
      {
 
1179
      k = CGN_EXTRSS(cbuf,(int)strlen(cbuf),',',&off,subs[nr],30);
 
1180
      if (k < 1)
 
1181
         break;
 
1182
      else
 
1183
         pixdim = nr + 1;
 
1184
      }
 
1185
 
 
1186
   for (nr=0; nr<pixdim; nr++)
 
1187
      {
 
1188
      if (subs[nr][0] == '<')
 
1189
         dd1[nr] = 1.0;
 
1190
      else if (subs[nr][0] == '>')
 
1191
         dd1[nr] = (double) npix[nr];
 
1192
      else if (subs[nr][0] == 'C')
 
1193
         {
 
1194
         k = npix[nr]/2;
 
1195
         dd1[nr] = (double) k;
 
1196
         }
 
1197
      else                              /* remains only "@" format */
 
1198
         {
 
1199
         if (CGN_CNVT(&subs[nr][1],4,1,&nval,&rr,&dd1[nr]) != 1) 
 
1200
            {
 
1201
            stat = 100;
 
1202
            goto end_of_it;
 
1203
            }
 
1204
         }
 
1205
      }
 
1206
 
 
1207
   sublo[0] = (int) dd1[0];             /* split according to NAXIS */
 
1208
   if (pixdim == 1)
 
1209
      (void) sprintf(auxstr,"frame pixel entered = %d",sublo[0]);
 
1210
 
 
1211
   else if (pixdim == 2)
 
1212
      {
 
1213
      sublo[1] = (int) dd1[1];
 
1214
      (void) sprintf(auxstr,"frame pixels entered = %d,%d",sublo[0],sublo[1]);
 
1215
      }
 
1216
   else
 
1217
      {
 
1218
      sublo[1] = (int) dd1[1];
 
1219
      sublo[2] = (int) dd1[2];
 
1220
      (void) sprintf(auxstr,"frame pixels entered = %d,%d,%d",sublo[0],sublo[1],                     sublo[2]);
 
1221
      }
 
1222
   SCTPUT(auxstr);
 
1223
   (void) SCKWRD("OUTPUTD",dd1,10,3,&unit);      /* save frame pixels */
 
1224
 
 
1225
   if (fp2wc(1,imnoa,dd1,dd2) != 0)             /* convert fp -> wc */
 
1226
      {
 
1227
      stat = 99;
 
1228
      goto end_of_it;
 
1229
      }
 
1230
 
 
1231
   /* split according to NAXIS */
 
1232
 
 
1233
   if (pixdim == 1)
 
1234
      (void) sprintf(cbuf,"world coords = %10.8g",dd2[0]);
 
1235
 
 
1236
   else if (pixdim == 2)
 
1237
      {
 
1238
      if (linflag == 0)
 
1239
         {
 
1240
         form_sexa(1,dd2[0],auxstr);                    /* RA */
 
1241
         (void) strcpy(convstr,auxstr);
 
1242
         for (nr=0; nr<80; nr++)
 
1243
            {
 
1244
            if (convstr[nr] == ':')
 
1245
               convstr[nr] = ',';
 
1246
            else if (convstr[nr] == '\0')
 
1247
               break;
 
1248
            }
 
1249
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
 
1250
         (void) SCKWRD("OUTPUTD",dd3,4,3,&unit);
 
1251
         (void) sprintf(cbuf,"world coords = %10.8g, %10.8g  or  %s, ",
 
1252
                        dd2[0],dd2[1],auxstr);
 
1253
 
 
1254
         form_sexa(0,dd2[1],auxstr);                    /* DEC */
 
1255
         (void) strcpy(convstr,auxstr);
 
1256
         for (nr=0; nr<80; nr++)
 
1257
            {
 
1258
            if (convstr[nr] == ':')
 
1259
               convstr[nr] = ',';
 
1260
            else if (convstr[nr] == '\0')
 
1261
               break;
 
1262
            }
 
1263
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
 
1264
         (void) SCKWRD("OUTPUTD",dd3,7,3,&unit);
 
1265
         (void) strcat(cbuf,auxstr);
 
1266
         }
 
1267
      else
 
1268
         (void) sprintf(cbuf,"world coords = %10.8g,%10.8g",dd2[0],dd2[1]);
 
1269
      }
 
1270
   else
 
1271
      {
 
1272
      if (linflag == 0)
 
1273
         {
 
1274
         form_sexa(1,dd2[0],auxstr);                    /* RA */
 
1275
         (void) strcpy(convstr,auxstr);
 
1276
         for (nr=0; nr<80; nr++)
 
1277
            {
 
1278
            if (convstr[nr] == ':')
 
1279
               convstr[nr] = ',';
 
1280
            else if (convstr[nr] == '\0')
 
1281
               break;
 
1282
            }
 
1283
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
 
1284
         (void) SCKWRD("OUTPUTD",dd3,4,3,&unit);
 
1285
         (void) sprintf(cbuf,"world coords = %10.8g, %10.8g, %10.8g",
 
1286
                        dd2[0],dd2[1],dd2[2]);
 
1287
 
 
1288
         SCTPUT(cbuf);
 
1289
         (void) sprintf(cbuf,"   or  %s, ",auxstr);
 
1290
         form_sexa(0,dd2[1],auxstr);                    /* DEC */
 
1291
         (void) strcpy(convstr,auxstr);
 
1292
         for (nr=0; nr<80; nr++)
 
1293
            {
 
1294
            if (convstr[nr] == ':')
 
1295
               convstr[nr] = ',';
 
1296
            else if (convstr[nr] == '\0')
 
1297
               break;
 
1298
            }
 
1299
         (void) CGN_CNVT(convstr,4,3,subhi,rval,dd3);
 
1300
         (void) SCKWRD("OUTPUTD",dd3,7,3,&unit);
 
1301
         (void) strcat(cbuf,auxstr);
 
1302
         (void) sprintf(auxstr,", %10.8g",dd2[2]);
 
1303
         (void) strcat(cbuf,auxstr);
 
1304
         }
 
1305
      else
 
1306
         (void) sprintf(cbuf,"world coords = %10.8g, %10.8g, %10.8g",
 
1307
                        dd2[0],dd2[1],dd2[2]);
 
1308
      }
 
1309
 
 
1310
   (void) SCKWRD("OUTPUTD",dd2,1,3,&unit);              /* save dec. wc */
 
1311
   }
 
1312
 
 
1313
SCTPUT(cbuf);
 
1314
stat = 0;
 
1315
 
 
1316
end_of_it:
 
1317
if (dispflg == -1) KIWORDS[OFF_LOG+3] = sav;            /* reset LOG(4) */
 
1318
if (stat != 0)
 
1319
   {                                            /* OUTPUTD(10-12)  <-  (-1) */
 
1320
   if (dispflg == 1) 
 
1321
      {
 
1322
      if (stat == 122)
 
1323
         SCTMES(M_RED_COLOR,"could not access given frame...");
 
1324
      else
 
1325
         SCTMES(M_RED_COLOR,"CONVERT/COORDS: conversion failed...");
 
1326
      }
 
1327
   for (nr=0; nr<3; nr++) dnul[nr] = -1.0;
 
1328
   (void) SCKWRD("OUTPUTD",dnul,10,3,&unit);
 
1329
   }
 
1330
return(stat);
 
1331
}
 
1332
 
 
1333