← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to prim/dio/libsrc/fitsckw.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:
prim/dio/libsrc/fitsckw.c
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2008 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
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
29
.IDENT     fitsckw.c
 
30
.LAUGUAGE  C
 
31
.AUTHOR    P.Grosbol   ESO/IPG
 
32
.KEYWORDS  FITS, check keyword, classify
 
33
.COMMENT   classify a FITS keyword
 
34
.VERSION   1.0  1988-Dec-10 : Creation,   PJG 
 
35
.VERSION   1.1  1989-Feb-24 : Upgrade for B-tables,   PJG 
 
36
.VERSION   1.4  1989-Oct-17 : Convert real to int in KEYWORD, PJG 
 
37
.VERSION   1.87 1990-Oct-24 : Introduce HIERARCH keywords, PJG 
 
38
.VERSION   2.25 1991-Sep-23 : Add new field types for BINTALBE, PJG 
 
39
.VERSION   2.35 1992-Aug-12 : Allow 1<PCOUNT for BINTABLE and UNKNOW, PJG 
 
40
.VERSION   2.45 1993-Mar-16 : Change TMEND/EXPTIME processing, PJG 
 
41
.VERSION   2.50 1993-Apr-01 : Move decoding of MIDAS descriptors, PJG 
 
42
.VERSION   2.80 1993-Dec-13 : Disable SC error for descriptors, PJG 
 
43
.VERSION   2.85 1994-Jan-11 : Check for zero length history, PJG 
 
44
.VERSION   3.00 1995-Feb-16 : Force GCOUNT>0 for none RG-format, PJG 
 
45
.VERSION   3.10 1996-Oct-22 : Change allowed char. and 'fitshkw' call, PJG 
 
46
.VERSION   3.15 1996-Nov-22 : Change allowed char., PJG 
 
47
 
 
48
 080617         last modif
 
49
---------------------------------------------------------------------*/
 
50
 
 
51
#include   <math.h>
 
52
#include   <osparms.h>
 
53
#include   <fitsfmt.h>
 
54
#include   <fitsdef.h>
 
55
#include   <fitskwb.h>
 
56
#include   <fitskwt.h>
 
57
#include   <midas_def.h>
 
58
#include   <fctext.h>
 
59
#include   <errext.h>
 
60
 
 
61
#include   <string.h>
 
62
#include   <stdlib.h>
 
63
#include   <stdio.h>
 
64
 
 
65
static     int         mdcnt;    /* MIDAS descriptor card count      */
 
66
static     int         mds;
 
67
static     int         ext_NAXIS=0;
 
68
static     double      tmstart;
 
69
static     ADEF        *adef;
 
70
static     PDEF        *pdef;
 
71
static     TXDEF       *txdef;
 
72
static     FDEF        *fdef;
 
73
/*
 
74
 
 
75
*/
 
76
 
 
77
int kwcmp(pk,ps)
 
78
char    *pk;
 
79
char    *ps;
 
80
 
 
81
{
 
82
register char  c, cc;
 
83
 
 
84
 
 
85
 
 
86
/* pk -> new keyword to identify,
 
87
   ps -> stored keywords with specified meaning from KWDEF */
 
88
 
 
89
 
 
90
while ((c = *ps++)) 
 
91
   {
 
92
   cc = *pk++;
 
93
   if (c != '#') 
 
94
      {
 
95
      if (c != cc) return 0;
 
96
      }
 
97
   else
 
98
      {
 
99
      if ((cc != ' ') && (cc < '0' || '9' < cc)) return 0;
 
100
      }
 
101
   }
 
102
return 1;               /* names match */
 
103
}
 
104
/*
 
105
 
 
106
*/
 
107
 
 
108
#ifdef __STDC__
 
109
int fitsckw(int mfd , BFDEF * bfdef , int htype , KWORD * kw , char fmt , 
 
110
            char hist, int *delt_flag, int Midas_flag)
 
111
#else
 
112
int fitsckw(mfd,bfdef,htype,kw,fmt,hist,delt_flag,Midas_flag)
 
113
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
114
.PURPOSE       classify and store FITS keyword
 
115
.RETURN        keyword type - 0:END, -1:not found, -2:error
 
116
---------------------------------------------------------------------*/
 
117
int        mfd;                 /* IN:  MIDAS file descriptor        */
 
118
BFDEF      *bfdef;              /* OUT: Basic FITS definitions       */
 
119
int        htype;               /* IN:  type of FITS header          */
 
120
KWORD      *kw;                 /* IN:  keyword structure            */
 
121
char       fmt;                 /* IN:  file format, No/Orig/Fp      */
 
122
char       hist;                /* IN:  history flag  No/Crypt/Yes   */
 
123
int        *delt_flag;          /* OUT:  1 if CDELT found, else 0    */
 
124
int        Midas_flag;          /* IN:  Midas flag                   */
 
125
#endif
 
126
 
 
127
 
 
128
{
 
129
char       c, *ps, *pc, line[80];
 
130
register char  dfmt, ckw;
 
131
 
 
132
int        ktype, n, m, i, err;
 
133
int        kwdsize, unit[4];
 
134
int        eco, elo, edi;
 
135
 
 
136
int  SCTMES(), hdr_tbl_M(), SCDHWL();
 
137
float      f;
 
138
 
 
139
double     d;
 
140
 
 
141
KWDEF      *kwd, ndkw;
 
142
 
 
143
TXDEF      *hdr_tbl();
 
144
 
 
145
 
 
146
char  *cptr, lastchar;
 
147
int   kk;
 
148
 
 
149
 
 
150
 
 
151
if (!kw->kw) return (-2);
 
152
 
 
153
kwd = bkw; ktype = -1; *delt_flag = 0;
 
154
kwdsize = sizeof(KWDEF);
 
155
 
 
156
/*
 
157
 printf("fitsckw: kw = %s\n",kw->kw); 
 
158
*/
 
159
 
 
160
ckw = kw->kw[0];
 
161
if (ckw == 'H')
 
162
   {
 
163
   if (strcmp(kw->kw,"HIERARCH") == 0)
 
164
      {
 
165
      memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
 
166
      goto next_step;
 
167
      }
 
168
   else if (strcmp(kw->kw,"HISTORY ") == 0)
 
169
      {
 
170
      kwd ++;
 
171
      memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
 
172
      goto next_step;
 
173
      }
 
174
   }
 
175
 
 
176
if (ckw == ' ')
 
177
   {                                            /* check if all blanks */
 
178
   if (strcmp(kw->kw,"        ") == 0)
 
179
      {
 
180
      kwd += 11;                                /* point to COMMENT entry */
 
181
      memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
 
182
      goto next_step;
 
183
      }
 
184
   }
 
185
else
 
186
   {                            /* compare with basic keyword list */
 
187
   kwd += 2;                    /* point to first entry after HISTORY */
 
188
   while (kwd->kw) 
 
189
      {
 
190
      if (ckw < kwd->kw[0]) break;      /* kwd is alphabetically sorted! */
 
191
 
 
192
      if (ckw == kwd->kw[0])
 
193
         {
 
194
         if (kwcmp(kw->kw,kwd->kw)) 
 
195
            {
 
196
            memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
 
197
            goto next_step;
 
198
            }
 
199
         }
 
200
 
 
201
      kwd++;
 
202
      }
 
203
   }
 
204
 
 
205
 
 
206
/* not found - check list for tables   */
 
207
 
 
208
if ((htype != IMAGE) && (ckw == 'T'))
 
209
   {                            /* use 2nd char, all keywords start with 'T' */
 
210
   ckw = kw->kw[1];     
 
211
 
 
212
   kwd = tkw;                           /* go through table keywords */
 
213
   while (kwd->kw) 
 
214
      {
 
215
      if (ckw < kwd->kw[1]) break;      /* kwd is alphabetically sorted! */
 
216
 
 
217
      if (ckw == kwd->kw[1])
 
218
         {
 
219
         if (kwcmp(kw->kw,kwd->kw)) 
 
220
            {
 
221
            memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
 
222
            goto next_step;
 
223
            }
 
224
         }
 
225
 
 
226
      kwd++;
 
227
      }
 
228
   }
 
229
 
 
230
 
 
231
/* not found in any list           */
 
232
 
 
233
ndkw.kw = kw->kw;
 
234
ndkw.group = WDESC; ndkw.type = '\0';
 
235
ndkw.fmt = 'N'; ndkw.action = 0;
 
236
ndkw.idx = (kw->fmt=='C') ? -1 : 1;
 
237
ndkw.fac = 1.0; ndkw.unit = (char *) 0; 
 
238
ndkw.desc = kw->kw; pc = kw->kw;                 /* convert to legal name  */
 
239
while ((c = *pc))
 
240
   {
 
241
   *pc++ = (('A'<=c && c<='Z') || ('0'<=c && c<='9') ||
 
242
            ('a'<=c && c<='z') || c=='-' || c==' ')
 
243
    ? c : '_';
 
244
   }
 
245
 
 
246
 
 
247
next_step:
 
248
kwd = &ndkw;
 
249
 
 
250
if (kwd->group==WDESC && kwd->action==HIERARCH) 
 
251
   {
 
252
   int  reto;
 
253
 
 
254
 
 
255
   if (FCT.PARM[3] == 1)        /* should we ignore ESO.xyz keywords? */
 
256
      return ktype;
 
257
     
 
258
   i = (hist == 'C');
 
259
   reto = fitshkw(kw,kwd,i);
 
260
   if (reto) 
 
261
      {
 
262
      (void) sprintf
 
263
           (line,"Warning: hierachical keyword not known (retval = %d)",reto);
 
264
      SCTMES(M_BLUE_COLOR,line); 
 
265
      return 1;
 
266
      }
 
267
   }
 
268
 
 
269
if (!(kwd->type))
 
270
   {
 
271
   switch (kw->fmt) 
 
272
      {
 
273
      case 'L'  : kwd->type = 'L'; break;
 
274
      case 'I'  : kwd->type = 'I'; break;
 
275
 
 
276
      case 'X'  :
 
277
      case 'R'  : kwd->type = 'D'; break;
 
278
 
 
279
      case 'C'  :
 
280
      case 'S'  : kwd->type = 'S'; break;
 
281
      }
 
282
   }
 
283
 
 
284
if (kwd->group==WDESC &&                /* skip blank keyword cards */
 
285
   kw->fmt=='C' && !(*kw->val.pc) && !(mds && mdcnt)) return 1;
 
286
 
 
287
dfmt = kwd->fmt;
 
288
if ((kw->fmt != dfmt) && (dfmt != 'H') && (dfmt != 'N') && (dfmt != '\0'))
 
289
   {
 
290
   if (fitstkw(kw,kwd->fmt)) 
 
291
      {                                 /* convert data format      */
 
292
      (void) sprintf(line,"Warning: Inconsistent data types [%c-%c] for >%s< !",
 
293
              kwd->fmt,kw->fmt,kw->kw);
 
294
      SCTMES(M_BLUE_COLOR,line);
 
295
      return 1;
 
296
      }
 
297
   }
 
298
 
 
299
ktype = 1;
 
300
switch (kwd->group) 
 
301
   {                            /* goto keyword group for action   */
 
302
   case NOACT : break;
 
303
 
 
304
 
 
305
   case BFCTL :                 /* basic FITS control */
 
306
    if (kw->kno && bfdef->naxis<kw->kno && *(kw->kw)!='P') 
 
307
       {
 
308
       sprintf(line,"Warning: keyword %s - axis-index > NAXIS (= %d)",kw->kw,bfdef->naxis);
 
309
       SCTMES(M_BLUE_COLOR,line);
 
310
       ktype = -1; break;
 
311
       }
 
312
 
 
313
    n = kw->kno - 1;
 
314
    switch (kwd->action) 
 
315
       {
 
316
       case BITPIX   : 
 
317
        bfdef->bitpix = kw->val.i;
 
318
        mds = 0; tmstart = -1.0;
 
319
        break;
 
320
 
 
321
       case NAXIS    :
 
322
        if (n<0) 
 
323
           {
 
324
           bfdef->naxis = kw->val.i;
 
325
           if ((htype==BFITS || htype==RGROUP || htype==IMAGE) && fmt!='N') 
 
326
              bfdef->cflag = 0;
 
327
           adef = bfdef->data;
 
328
 
 
329
           if (MIDAS_MXDIM < bfdef->naxis) 
 
330
              {
 
331
              if (MXDIM < bfdef->naxis)
 
332
                 {
 
333
                 char txt[48];
 
334
 
 
335
                 (void) sprintf(txt,"NAXIS = %d, Max. NAXIS (%d) exceeded!",
 
336
                                kw->val.i,MXDIM);
 
337
                 SCTMES(M_RED_COLOR,txt);
 
338
                 return -2;
 
339
                 }
 
340
 
 
341
              if (ext_NAXIS == 0)
 
342
                 {
 
343
                 for (i=MIDAS_MXDIM; i<MXDIM; i++)      /* init also the rest */
 
344
                    {
 
345
                    adef[i].naxis = 0;
 
346
                    adef[i].crval = 1.0;
 
347
                    adef[i].crpix = 1.0;
 
348
                    adef[i].cdelt = 1.0;
 
349
                    adef[i].crota = 0.0;
 
350
                    adef[i].ctype[0] = '\0';
 
351
                    }
 
352
                 ext_NAXIS = 1;                 /* set switch */
 
353
                 }
 
354
              }
 
355
           pdef = bfdef->parm;
 
356
           bfdef->crflag = 0;                   /* indicate no CROTA there */
 
357
           }
 
358
        else 
 
359
           {
 
360
           if (htype==RGROUP) n--;
 
361
           adef[n].naxis = kw->val.i;
 
362
           }
 
363
        break;
 
364
 
 
365
       case CRVAL    :
 
366
        if (htype==RGROUP) n--;
 
367
        if (n<0) 
 
368
           SCTPUT("superfluous CRVAL ... not stored");
 
369
        else
 
370
           adef[n].crval = kw->val.d[0];
 
371
        break;
 
372
 
 
373
       case CRPIX    :
 
374
        if (htype==RGROUP) n--;
 
375
        if (n<0) 
 
376
           SCTPUT("superfluous CRPIX ... not stored");
 
377
        else
 
378
           adef[n].crpix = kw->val.d[0];
 
379
        break;
 
380
 
 
381
       case CDELT    :
 
382
        if (htype==RGROUP) n--;
 
383
        if (n<0) 
 
384
           SCTPUT("superfluous CDELT ... not stored");
 
385
        else
 
386
           adef[n].cdelt = kw->val.d[0];
 
387
        *delt_flag = 1;
 
388
        break;
 
389
 
 
390
       case CTYPE    :
 
391
        if (htype==RGROUP) n--;
 
392
        if (n<0) 
 
393
           SCTPUT("superfluous CTYPE ... not stored");
 
394
        else
 
395
           {
 
396
           pc = kw->val.pc; ps = adef[n].ctype; i = MXS;
 
397
           while (--i && (*ps++ = *pc++)); *ps = '\0';
 
398
           }
 
399
        break;
 
400
 
 
401
       case CROTA    :
 
402
        if (htype==RGROUP) n--;
 
403
        if (n<0) 
 
404
           SCTPUT("superfluous CROTA ... not stored");
 
405
        else
 
406
           {
 
407
           bfdef->crflag = 1;
 
408
           adef[n].crota = kw->val.d[0];
 
409
           }
 
410
        break;
 
411
 
 
412
       case BSCALE   :
 
413
        bfdef->bscale = kw->val.d[0];
 
414
        bfdef->sflag = bfdef->sflag || (bfdef->bscale != 1.0);
 
415
        break;
 
416
 
 
417
       case BZERO    :
 
418
        bfdef->bzero = kw->val.d[0];
 
419
        bfdef->sflag = bfdef->sflag || (bfdef->bzero != 0.0);
 
420
        break;
 
421
 
 
422
       case BUNIT    :
 
423
        pc = kw->val.pc; ps = bfdef->bunit; i = MXS;
 
424
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
425
        if (*bfdef->bunit == '\0')
 
426
           {
 
427
           memset((void *)bfdef->bunit,32,(size_t)16);
 
428
           *(bfdef->bunit + 16) = '\0';
 
429
           }
 
430
        break;
 
431
 
 
432
       case BLANK    :
 
433
        bfdef->blank = kw->val.i; bfdef->bflag = 1;
 
434
        break;
 
435
 
 
436
       case PCOUNT   :
 
437
        bfdef->pcount = kw->val.i;
 
438
        bfdef->kwflag |= 1;
 
439
        if (htype==RGROUP && MXPAR<bfdef->pcount) 
 
440
           {
 
441
           SCTPUT("Error: Max. PCOUNT exceeded!");
 
442
           return -2;
 
443
           }
 
444
        if (htype!=RGROUP && htype!=BTABLE && bfdef->pcount!=0)
 
445
           SCTMES(M_BLUE_COLOR,"Warning: PCOUNT not zero");
 
446
        break;
 
447
 
 
448
       case GCOUNT   :
 
449
        bfdef->gcount = kw->val.i;
 
450
        bfdef->kwflag |= 2;
 
451
        if (htype!=RGROUP && bfdef->gcount!=1) 
 
452
           {
 
453
           if (bfdef->gcount<1) 
 
454
              {
 
455
              SCTMES(M_BLUE_COLOR,"Warning: GCOUNT < 1, changed to 1");
 
456
              bfdef->gcount = 1;
 
457
              }
 
458
           else 
 
459
              SCTMES(M_BLUE_COLOR,"Warning: GCOUNT > 1");
 
460
           }
 
461
        break;
 
462
 
 
463
       case RGPTYPE  :
 
464
        pc = kw->val.pc; ps = pdef[n].ptype; i = MXS;
 
465
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
466
        break;
 
467
 
 
468
       case RGPSCAL  :
 
469
        pdef[n].pscal = kw->val.d[0];
 
470
        break;
 
471
 
 
472
       case RGPZERO  :
 
473
        pdef[n].pzero = kw->val.d[0];
 
474
        break;
 
475
 
 
476
       case EXTNAME  :
 
477
        pc = kw->val.pc; ps = bfdef->extname; i = MXS;
 
478
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
479
        ps = bfdef->extname;
 
480
        for (i=0; i<16; i++)
 
481
           {                            /* cut off trailing blanks */
 
482
           if (*ps == ' ')
 
483
              {
 
484
              *ps = '\0';
 
485
              break;
 
486
              }
 
487
           ps ++;
 
488
           }
 
489
        break;
 
490
 
 
491
       case OBJECT   :
 
492
        pc = kw->val.pc; ps = bfdef->ident; i = MXIDNT;
 
493
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
494
        if (*bfdef->ident == '\0')
 
495
           {
 
496
           memset((void *)bfdef->ident,32,(size_t)71);
 
497
           *(bfdef->ident + 72) = '\0';
 
498
           }
 
499
        break;
 
500
 
 
501
       case EXTVER   :
 
502
        bfdef->extver = kw->val.i;
 
503
        break;
 
504
 
 
505
       case EXTLEVEL :
 
506
        bfdef->extlevel = kw->val.i;
 
507
        break;
 
508
 
 
509
       case EXTEND :
 
510
        bfdef->xflag = kw->val.i;
 
511
        break;
 
512
 
 
513
       case MIDASFTP :
 
514
        if (!strncmp(kw->val.pc,"IMAGE",5))
 
515
           bfdef->mtype = F_IMA_TYPE;
 
516
        else if (!strncmp(kw->val.pc,"TABLE",5))
 
517
           bfdef->mtype = F_TBL_TYPE;
 
518
        else if (!strncmp(kw->val.pc,"FIT",3)) 
 
519
           {
 
520
           bfdef->mtype = F_FIT_TYPE;
 
521
           bfdef->cflag = 1;
 
522
           }
 
523
        break;
 
524
 
 
525
       case DATAMIN  :
 
526
        bfdef->dmin = kw->val.d[0];
 
527
        bfdef->mflag |= 1;
 
528
        break;
 
529
 
 
530
       case DATAMAX  :
 
531
        bfdef->dmax = kw->val.d[0];
 
532
        bfdef->mflag |= 2;
 
533
        break;
 
534
 
 
535
       case END      : 
 
536
        ktype = 0;
 
537
        break;
 
538
 
 
539
       default       : 
 
540
        SCTMES(M_BLUE_COLOR,"Warning: Undef. basic action");
 
541
       }
 
542
    break;                      /* end - case BFCTL */
 
543
 
 
544
 
 
545
   case TXCTL :
 
546
    if (kw->kno && bfdef->extd && txdef->tfields<kw->kno) 
 
547
       {
 
548
       SCTMES(M_BLUE_COLOR,"Warning: column index larger than TFIELD");
 
549
       ktype = -1; break;
 
550
       }
 
551
 
 
552
    n = kw->kno - 1;
 
553
    switch (kwd->action) 
 
554
       {
 
555
       case TFIELDS  :
 
556
        bfdef->mtype = F_TBL_TYPE;
 
557
        if (fmt!='N') bfdef->cflag = 0;
 
558
        if (MXF<kw->val.i) 
 
559
           {
 
560
           SCTMES(M_RED_COLOR,"Error: Max. TFIELDS exceeded");
 
561
           return -2;
 
562
           }
 
563
        if (Midas_flag == 0)
 
564
           txdef = hdr_tbl(kw->val.i);
 
565
        else
 
566
           {
 
567
           m = hdr_tbl_M(bfdef,kw->val.i);
 
568
           if (m != 0) return (-9);
 
569
 
 
570
           txdef = (TXDEF *)bfdef->extd;
 
571
           }
 
572
        fdef = txdef->col;
 
573
        break;
 
574
       case THEAP    :
 
575
        txdef->theap = kw->val.i;
 
576
        break;
 
577
       case TBCOL    :
 
578
        fdef[n].tbcol = kw->val.i - 1;
 
579
        break;
 
580
       case TFORM    :
 
581
        pc = kw->val.pc; ps = fdef[n].tform; i = MXS;
 
582
        while (--i && (*ps++ = *pc++)); if (i) *ps = '\0';
 
583
        pc = kw->val.pc;
 
584
        if (dcffmt(pc,&fdef[n].trepn,&c,&fdef[n].twdth,&fdef[n].tdfdd))
 
585
           SCTMES(M_RED_COLOR,"Error: invalid FORTRAN format");
 
586
        fdef[n].tncpf = 1;
 
587
        switch (c) 
 
588
           {
 
589
           case 'A' :
 
590
            fdef[n].tdfmt = 'A';
 
591
            (void) sprintf(fdef[n].tform,"A%d",fdef[n].trepn*fdef[n].twdth);
 
592
            break;
 
593
           case 'I' :
 
594
            fdef[n].tdfmt = (htype==ATABLE) ? 'I' : 'S';
 
595
            (void) strcpy(fdef[n].tform,"I11");
 
596
            break;
 
597
           case 'F' :
 
598
            fdef[n].tdfmt = 'E';
 
599
            (void) strcpy(fdef[n].tform,"E15.5");
 
600
            break;
 
601
           case 'E' :
 
602
            fdef[n].tdfmt = 'E';
 
603
            (void) strcpy(fdef[n].tform,"E15.5");
 
604
            break;
 
605
           case 'D' :
 
606
            fdef[n].tdfmt = 'D';
 
607
            (void) strcpy(fdef[n].tform,"E15.5");
 
608
            break;
 
609
           case 'J' :
 
610
            fdef[n].tdfmt = 'I';
 
611
            (void) strcpy(fdef[n].tform,"I11");
 
612
            break;
 
613
           case 'L' :
 
614
            fdef[n].tdfmt = 'L';
 
615
            (void) sprintf(fdef[n].tform,"A%d",fdef[n].trepn);
 
616
            break;
 
617
           case 'B' : 
 
618
            fdef[n].tdfmt = 'B';
 
619
            strcpy(fdef[n].tform,"I4");
 
620
            break;
 
621
           case 'X' :
 
622
            fdef[n].tdfmt = 'X';
 
623
            strcpy(fdef[n].tform,"I4");
 
624
            break;
 
625
           case 'C' :
 
626
            fdef[n].tdfmt = 'C';
 
627
            fdef[n].tncpf = 2;
 
628
            strcpy(fdef[n].tform,"E15.5");
 
629
            break;
 
630
           case 'M' : 
 
631
            fdef[n].tdfmt = 'M';
 
632
            fdef[n].tncpf = 2;
 
633
            strcpy(fdef[n].tform,"E15.5");
 
634
            break;
 
635
           case 'P' :
 
636
            fdef[n].tdfmt = 'P';
 
637
            fdef[n].tncpf = 2;
 
638
            strcpy(fdef[n].tform,"I11");
 
639
            break;
 
640
           default  :
 
641
            fdef[n].tdfmt = '\0'; break;
 
642
           }
 
643
        break;
 
644
 
 
645
       case TTYPE    :
 
646
        pc = kw->val.pc; ps = fdef[n].ttype; i = MXS;
 
647
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
648
        break;
 
649
       case TUNIT    :
 
650
        pc = kw->val.pc; ps = fdef[n].tunit; i = MXS;
 
651
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
652
        break;
 
653
       case TSCAL    :
 
654
        fdef[n].tscal = kw->val.d[0];
 
655
        if (fdef[n].tscal!=1.0) fdef[n].sflag = 1;
 
656
        break;
 
657
       case TZERO    :
 
658
        fdef[n].tzero = kw->val.d[0];
 
659
        if (fdef[n].tzero!=0.0) fdef[n].sflag = 1;
 
660
        break;
 
661
       case TNULL    :
 
662
        if (htype==ATABLE && kw->fmt=='S') 
 
663
           {
 
664
           fdef[n].nflag = 1;
 
665
           pc = kw->val.pc; ps = fdef[n].tnull; i = MXS;
 
666
           while (--i && (*ps++ = *pc++)); *ps = '\0';
 
667
           }
 
668
        else if (htype==BTABLE && kw->fmt=='I') 
 
669
           {
 
670
           fdef[n].nflag = 1;
 
671
           fdef[n].tnnul = kw->val.i;
 
672
           }
 
673
        break;
 
674
       case TDISP    :
 
675
        pc = kw->val.pc; ps = fdef[n].tdisp; i = MXS;
 
676
        while (--i && (*ps++ = *pc++)); *ps = '\0';
 
677
        break;
 
678
       default       : 
 
679
        SCTMES(M_BLUE_COLOR,"Warning: Undefined table action");
 
680
       }
 
681
    break;                      /* end - case TXCTL */
 
682
 
 
683
 
 
684
   case WDESC :                         /* store keyword in descriptor */
 
685
    if (fmt=='N') break;                /* skip if NO file option      */
 
686
 
 
687
    switch (kwd->action) 
 
688
       {                                /* special actions             */
 
689
       case TMSTART  : 
 
690
        kw->val.d[0] /= 3600;
 
691
        tmstart = kw->val.d[0]; break;
 
692
       case TMEND    : 
 
693
        if (tmstart<0.0) 
 
694
           kw->val.d[0] = 0;
 
695
        else 
 
696
           {
 
697
           kw->val.d[0] -= 3600*tmstart;
 
698
           if (kw->val.d[0]<0.0) kw->val.d[0] += 86400.0;
 
699
           }
 
700
        break;
 
701
       case TEXTFILE :
 
702
        bfdef->tflag = 1;
 
703
        if (text_open(kw->val.pc,WRITE)) 
 
704
           {
 
705
           (void) sprintf(line,"Warning: cannot create textfile <%s>",
 
706
                          kw->val.pc);
 
707
           SCTMES(M_BLUE_COLOR,line);
 
708
           }
 
709
        else 
 
710
           return ktype;
 
711
        break;
 
712
       case MJDOBS   :
 
713
        if (mfd < 0) break;        
 
714
 
 
715
        err = SCDRDD(mfd,"O_TIME",5,1,&i,&d,unit,&i);
 
716
        if (d==0.0) 
 
717
           {
 
718
           d = 24.0*fmod(kw->val.d[0],1.0);
 
719
           err = SCDWRD(mfd,"O_TIME",&d,5,1,unit);
 
720
           }
 
721
        break;
 
722
       }
 
723
 
 
724
    if (bfdef->tflag && !strcmp(kw->kw,"COMMENT ")) 
 
725
       {
 
726
       text_put(kw->pcom);
 
727
       return ktype; 
 
728
       }
 
729
    if (hist=='N' && kwd->fmt=='C') break;     /* skip HIST+COMM */
 
730
    if (!(*kwd->desc)) break;     /* no associated descriptor    */
 
731
 
 
732
    if (0<=mfd)                 /* MIDAS file exists           */
 
733
       {                                /* check for MIDAS descriptors */
 
734
 
 
735
       /* *** instead of: n = 1; i = 0; SCECNT("PUT",&n,&i,&i); *** */
 
736
       eco = ERRO_CONT; elo = ERRO_LOG; edi = ERRO_DISP;
 
737
       ERRO_CONT = 1;   /* disable SC-error handling   */
 
738
       ERRO_LOG = ERRO_DISP = 0;
 
739
       err = ERR_NORMAL;
 
740
           
 
741
       if (kwd->fmt=='C' && !strncmp(kw->kw,"HISTORY ",8)) 
 
742
          {
 
743
          if (mds == 0)
 
744
             {
 
745
             if (strncmp(kw->val.pc,"ESO-DESCRIPTORS START",21) == 0)
 
746
                {
 
747
                mds = 1; mdcnt = 0;
 
748
                ERRO_CONT = eco; ERRO_LOG = elo; ERRO_DISP = edi;
 
749
                break;
 
750
                }
 
751
             }
 
752
          else
 
753
             {              /* decode MIDAS descriptors    */
 
754
             if (strncmp(kw->val.pc,"ESO-DESCRIPTORS END",19) == 0)
 
755
                mds = 0;
 
756
             else 
 
757
                {
 
758
                err = fitsrmd(mfd,kw,&mdcnt);
 
759
                if (err != ERR_NORMAL) 
 
760
                   {
 
761
                   char   badname[MXMDN];
 
762
                   void  fitsrmdbad();
 
763
 
 
764
                   fitsrmdbad(badname);
 
765
                   (void) sprintf(line,"bad ESO descriptor %s",badname);
 
766
                   SCTMES(M_BLUE_COLOR,line);
 
767
                   }
 
768
                }
 
769
             ERRO_CONT = eco; ERRO_LOG = elo; ERRO_DISP = edi;
 
770
             break;
 
771
             }
 
772
          }
 
773
 
 
774
       switch (kwd->type) 
 
775
          {                             /* save value in MIDAS desc.   */
 
776
          case 'S' :
 
777
           if (!kw->val.pc) break;
 
778
           i = (int) strlen(kw->val.pc);
 
779
           if (i <1 )
 
780
              {
 
781
              (void) strcat(kw->val.pc," \n"); 
 
782
              i = 1;
 
783
              }
 
784
           else
 
785
              {
 
786
              if (kwd->idx<1) 
 
787
                 {
 
788
                 if (i<72 || kw->val.pc[71]!='\\') 
 
789
                    {
 
790
                    (void) strcat(kw->val.pc,"\n"); i++;
 
791
                    }
 
792
                 else
 
793
                    {
 
794
                    kw->val.pc[71] = '\0'; i = 72; 
 
795
                    }
 
796
                 }
 
797
              }
 
798
 
 
799
            if (strcmp(kwd->desc,"CONTINUE") == 0) 
 
800
               mdb_cont(mfd,2,kwd->desc,kw->val.pc);
 
801
 
 
802
            else
 
803
               {
 
804
               cptr = kw->val.pc;
 
805
               kk = (int)strlen(cptr) - 1;        /* index of last char. */
 
806
               lastchar = *(cptr+kk);
 
807
               if (lastchar == '&')
 
808
                  mdb_cont(mfd,1,kwd->desc,kw->val.pc);
 
809
               else
 
810
                  {
 
811
                  if ((strcmp(kwd->desc,"HISTORY") != 0) &&
 
812
                      (strcmp(kwd->desc,"COMMENT") != 0))
 
813
                     err = xSCDHWC(mfd,kwd->desc,1,kw->val.pc,kwd->idx,
 
814
                                      i,unit,kw->pcom);
 
815
                  else
 
816
                     err = SCDHWC(mfd,kwd->desc,1,kw->val.pc,kwd->idx,
 
817
                                     i,unit,kw->pcom);
 
818
                  }
 
819
               }
 
820
           break;
 
821
          case 'L' :
 
822
            err = SCDHWL(mfd,kwd->desc,&kw->val.i,kwd->idx,
 
823
                         1,unit,kw->pcom);
 
824
           break;
 
825
          case 'I' :
 
826
           if (strncmp(kwd->desc,"O_",2) != 0)
 
827
              err = xSCDHWI(mfd,kwd->desc,&kw->val.i,kwd->idx,
 
828
                                      1,unit,kw->pcom);
 
829
           else
 
830
              err = SCDHWI(mfd,kwd->desc,&kw->val.i,kwd->idx,
 
831
                                     1,unit,kw->pcom);
 
832
           break;
 
833
          case 'R' :
 
834
           f = kw->val.d[0];
 
835
           if (strncmp(kwd->desc,"O_",2) != 0)
 
836
              err = xSCDHWR(mfd,kwd->desc,&f,kwd->idx,
 
837
                                      1,unit,kw->pcom);
 
838
           else
 
839
              err = SCDHWR(mfd,kwd->desc,&f,kwd->idx,
 
840
                                     1,unit,kw->pcom);
 
841
           break;
 
842
          case 'D' :
 
843
           if (strncmp(kwd->desc,"O_",2) != 0)
 
844
              err = xSCDHWD(mfd,kwd->desc,kw->val.d,kwd->idx,
 
845
                                      1,unit,kw->pcom);
 
846
           else
 
847
              err = SCDHWD(mfd,kwd->desc,kw->val.d,kwd->idx,
 
848
                                     1,unit,kw->pcom);
 
849
           break;
 
850
 
 
851
          default :                     /* everything else is bad type... */
 
852
           err = 999;
 
853
          }
 
854
 
 
855
       ERRO_CONT = eco;         /* reset directly */
 
856
       ERRO_LOG = elo;
 
857
       ERRO_DISP = edi;         /* instead of SCECNT("PUT",...) */
 
858
 
 
859
       if (err!=ERR_NORMAL) 
 
860
          {
 
861
          if (err == 999)
 
862
             (void) sprintf(line,"Warning: <%s> of invalid type - not stored",
 
863
                    kwd->desc);
 
864
          else
 
865
             (void) sprintf(line,"Warning: <%s> of type <%c> - not stored",
 
866
                    kwd->desc,kwd->type);
 
867
          SCTMES(M_BLUE_COLOR,line);
 
868
          }
 
869
       }
 
870
 
 
871
    else
 
872
       mdb_put(kw,kwd);          /* no MIDAS file - buffer KW   */
 
873
    break;                      /* end - case WDESC */
 
874
 
 
875
 
 
876
   default    : 
 
877
    SCTMES(M_BLUE_COLOR,"Warning: Undefined keyword group");
 
878
   }
 
879
 
 
880
 
 
881
if (!bfdef->cflag)              /* check if data file can be created */
 
882
   {
 
883
   switch (htype) 
 
884
      {
 
885
      case BFITS  : 
 
886
       if (kwd->action==NAXIS && kw->kno==bfdef->naxis) bfdef->cflag = 1;
 
887
       break;
 
888
      case IMAGE  :
 
889
      case RGROUP : 
 
890
       if ((bfdef->kwflag & 3) == 3) bfdef->cflag = 1;
 
891
       break;
 
892
      case ATABLE :
 
893
       n = 1;
 
894
       for (i=0; i<txdef->tfields; i++)
 
895
          n = n && 0<=fdef[i].tbcol && fdef[i].tdfmt;
 
896
       bfdef->cflag = (n) ? 1 : 0;
 
897
       break;
 
898
      case BTABLE :
 
899
       n = 1;
 
900
       for (i=0; i<txdef->tfields; i++) n = n && fdef[i].tdfmt;
 
901
       bfdef->cflag = (n) ? 1 : 0;
 
902
       break;
 
903
      default     :
 
904
       bfdef->cflag = -1;
 
905
      }
 
906
   }
 
907
 
 
908
 
 
909
return ktype;
 
910
}
 
911
/*
 
912
 
 
913
*/
 
914
 
 
915
#ifdef __STDC__
 
916
int fitsXckw(int mfd , BFDEF * bfdef , int htype , KWORD * kw)
 
917
#else
 
918
int fitsXckw(mfd,bfdef,htype,kw)
 
919
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
920
.PURPOSE       classify and store FITS keyword
 
921
.RETURN        keyword type - 0:END, -1:not found, -2:error
 
922
---------------------------------------------------------------------*/
 
923
int        mfd;                 /* IN:  MIDAS file descriptor        */
 
924
BFDEF      *bfdef;              /* OUT: Basic FITS definitions       */
 
925
int        htype;               /* IN:  type of FITS header          */
 
926
KWORD      *kw;                 /* IN:  keyword structure            */
 
927
#endif
 
928
 
 
929
 
 
930
 
 
931
/*
 
932
in this routine we have Midas_flag == -2
 
933
which means we just need some basic FITS keywords
 
934
all other keywords are ignored 
 
935
*/
 
936
 
 
937
 
 
938
 
 
939
 
 
940
{
 
941
char        *ps, *pc;
 
942
register char  ckw;
 
943
 
 
944
int        ktype, n, i, kwdsize;
 
945
int   SCTMES();
 
946
 
 
947
KWDEF      *kwd, ndkw;
 
948
 
 
949
TXDEF      *hdr_tbl();
 
950
 
 
951
 
 
952
 
 
953
 
 
954
 
 
955
/*
 
956
 printf("fitsXckw: kw = %s\n",kw->kw); 
 
957
*/
 
958
 
 
959
 
 
960
if (!kw->kw) return (-2);
 
961
 
 
962
kwd = bkw; ktype = -1; 
 
963
kwdsize = sizeof(KWDEF);
 
964
 
 
965
 
 
966
ckw = kw->kw[0];
 
967
if ((ckw == 'H') || (ckw == ' ')) return ktype;
 
968
 
 
969
                                /* compare with basic keyword list */
 
970
kwd += 2;                       /* point to first entry after HISTORY */
 
971
while (kwd->kw) 
 
972
   {
 
973
   if (ckw < kwd->kw[0]) break; /* kwd is alphabetically sorted! */
 
974
 
 
975
   if (ckw == kwd->kw[0])
 
976
      {
 
977
      if (kwcmp(kw->kw,kwd->kw)) 
 
978
         {
 
979
         memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
 
980
         goto next_step;
 
981
         }
 
982
      }
 
983
   kwd++;
 
984
   }
 
985
 
 
986
return ktype;           /* not found - so we don't have to care! */
 
987
 
 
988
 
 
989
 
 
990
 
 
991
next_step:
 
992
kwd = &ndkw;
 
993
 
 
994
if (kwd->group != BFCTL) return ktype;
 
995
 
 
996
 
 
997
ktype = 1;              /* BFCTL: basic FITS control */
 
998
if (kw->kno && bfdef->naxis<kw->kno && *(kw->kw)!='P') return ktype;
 
999
 
 
1000
n = kw->kno - 1;
 
1001
switch (kwd->action) 
 
1002
   {
 
1003
  case BITPIX   : 
 
1004
   bfdef->bitpix = kw->val.i;
 
1005
   mds = 0; 
 
1006
   break;
 
1007
 
 
1008
  case NAXIS    :
 
1009
   if (n<0) 
 
1010
      {
 
1011
      bfdef->naxis = kw->val.i;
 
1012
      adef = bfdef->data;
 
1013
 
 
1014
      if (MIDAS_MXDIM < bfdef->naxis) 
 
1015
         {
 
1016
         if (MXDIM < bfdef->naxis)
 
1017
            {
 
1018
            char txt[48];
 
1019
 
 
1020
            (void) sprintf(txt,"NAXIS = %d, Max. NAXIS (%d) exceeded!",
 
1021
                                kw->val.i,MXDIM);
 
1022
            SCTMES(M_RED_COLOR,txt);
 
1023
            return -2;
 
1024
            }
 
1025
 
 
1026
         if (ext_NAXIS == 0)
 
1027
            {
 
1028
            for (i=MIDAS_MXDIM; i<MXDIM; i++)   /* init also the rest */
 
1029
               {
 
1030
               adef[i].naxis = 0;
 
1031
               adef[i].crval = 1.0;
 
1032
               adef[i].crpix = 1.0;
 
1033
               adef[i].cdelt = 1.0;
 
1034
               adef[i].crota = 0.0;
 
1035
               adef[i].ctype[0] = '\0';
 
1036
               }
 
1037
            ext_NAXIS = 1;                      /* set switch */
 
1038
            }
 
1039
         }
 
1040
      pdef = bfdef->parm;
 
1041
      bfdef->crflag = 0;                        /* indicate no CROTA there */
 
1042
      }
 
1043
   else 
 
1044
      {
 
1045
      if (htype==RGROUP) n--;
 
1046
      adef[n].naxis = kw->val.i;
 
1047
      }
 
1048
   break;
 
1049
 
 
1050
 
 
1051
  case BSCALE   :
 
1052
   bfdef->bscale = kw->val.d[0];
 
1053
   bfdef->sflag = bfdef->sflag || (bfdef->bscale != 1.0);
 
1054
   break;
 
1055
 
 
1056
  case BZERO    :
 
1057
   bfdef->bzero = kw->val.d[0];
 
1058
   bfdef->sflag = bfdef->sflag || (bfdef->bzero != 0.0);
 
1059
   break;
 
1060
 
 
1061
  case PCOUNT   :
 
1062
   bfdef->pcount = kw->val.i;
 
1063
   bfdef->kwflag |= 1;
 
1064
   break;
 
1065
 
 
1066
  case GCOUNT   :
 
1067
   bfdef->gcount = kw->val.i;
 
1068
   bfdef->kwflag |= 2;
 
1069
   if (htype!=RGROUP && bfdef->gcount!=1) 
 
1070
      {
 
1071
      if (bfdef->gcount<1) bfdef->gcount = 1;
 
1072
      }
 
1073
   break;
 
1074
 
 
1075
  case RGPTYPE  :
 
1076
   pc = kw->val.pc; ps = pdef[n].ptype; i = MXS;
 
1077
   while (--i && (*ps++ = *pc++)); *ps = '\0';
 
1078
   break;
 
1079
 
 
1080
  case RGPSCAL  :
 
1081
   pdef[n].pscal = kw->val.d[0];
 
1082
   break;
 
1083
 
 
1084
  case RGPZERO  :
 
1085
   pdef[n].pzero = kw->val.d[0];
 
1086
   break;
 
1087
 
 
1088
  case END      : 
 
1089
   ktype = 0;
 
1090
   break;
 
1091
 
 
1092
  default       : 
 
1093
   ;
 
1094
   }
 
1095
 
 
1096
 
 
1097
return ktype;
 
1098
}
 
1099