← Back to branch summary

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

« back to all changes in this revision

Viewing changes to prim/dio/libsrc/fitswmd.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/fitswmd.c
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2006 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
.LANGUAGE   C
 
30
.IDENTIFICATION      fitswmd.c
 
31
.AUTHOR     P.Grosbol   ESO/IPG
 
32
.KEYWORDS   MIDAS descriptor, FITS header, keywords
 
33
.COMMENT    write MIDAS descriptor in FITS header
 
34
.VERSION    1.0  1988-Dec-04 : Creation,   PJG 
 
35
.VERSION    1.1  1989-May-26 : Change format - for old-MIDAS,   PJG 
 
36
.VERSION    1.2  1989-Jun-12 : Change definition of unit+kunit, PJG 
 
37
.VERSION    1.3  1990-Feb-26 : Change format of char. desc., PJG 
 
38
.VERSION    1.4  1991-Jan-25 : Change include file, PJG 
 
39
.VERSION    1.5  1993-Oct-26 : Update to new SC + prototypes, PJG 
 
40
.VERSION    1.6  1998-Aug-19 : Change format, PJG 
 
41
.VERSION    1.7  2002-Jan-11 : Add logical type, PJG 
 
42
 
 
43
 060109         last modif
 
44
---------------------------------------------------------------------*/
 
45
 
 
46
#include   <stdio.h>
 
47
#include   <string.h>
 
48
#include   <fitsfmt.h>
 
49
#include   <fitsdef.h>
 
50
#include   <midas_def.h>
 
51
 
 
52
#define    MXFHC              80   /* characters in FITS header card */
 
53
#define    MXFCC              70   /* max. char. in FITS comment     */
 
54
/*
 
55
 
 
56
*/
 
57
 
 
58
int fitswmd(mfd,name)
 
59
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
60
.PURPOSE       write MIDAS descriptor to FITS header
 
61
.RETURN        return status  0:OK, -1:error
 
62
---------------------------------------------------------------------*/
 
63
int           mfd;             /* IN: MIDAS file number              */
 
64
char        *name;             /* IN: name of MIDAS descriptor       */
 
65
{
 
66
char      *pc, c, type;
 
67
char      fhc[MXFHC+1], buf[MXFCC+1], chc[MXFHC+1];
 
68
 
 
69
int       ne, nbpe, n, nv, nf, no, epl, null, net;
 
70
int       i, idx, ival[7], unit[2];
 
71
int   SCTMES(), SCDRDL();
 
72
 
 
73
float     fval[5];
 
74
 
 
75
double    dval[3];
 
76
 
 
77
 
 
78
 
 
79
 
 
80
 
 
81
if (MXMDN <= (int)strlen(name)) 
 
82
   {
 
83
   (void)sprintf(fhc,"Error: descriptor >%s< skipped - name too long",
 
84
                 name);
 
85
    SCTMES(M_RED_COLOR,fhc);
 
86
    return (-1);
 
87
   }
 
88
 
 
89
if (SCDFND(mfd,name,&type,&ne,&nbpe)) return (-1);
 
90
 
 
91
nf = 1;                         /* first element */
 
92
 
 
93
/* instead of:  fitswkc("HISTORY",fhc);
 
94
   we use: dwrite("HISTORY "//fhc,MXFHC);  directly */
 
95
 
 
96
switch (type) 
 
97
   {
 
98
  case 'L' :
 
99
   n = sprintf(fhc,"HISTORY  '%s','L*%d',1,%d,'35I2'",name,nbpe,ne);
 
100
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
101
   dwrite(fhc,MXFHC);   
 
102
 
 
103
   epl = 35;
 
104
   while (ne) 
 
105
      {                  /* go through all elements   */
 
106
      no = (epl<ne) ? epl : ne;
 
107
      SCDRDL(mfd,name,nf,no,&nv,ival,unit,&null);
 
108
      nf += nv; ne -= nv; n = 0; 
 
109
      idx = 9; pc = &fhc[idx];          /* position after 'HISTORY  ' */
 
110
      while (nv--)
 
111
         {             /* write one HISTORY card    */
 
112
         i = sprintf(pc,"%2d",ival[n]);
 
113
         pc += i; idx += i;
 
114
         n++;
 
115
         }
 
116
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
 
117
      dwrite(fhc,MXFHC);        
 
118
      }
 
119
   break;
 
120
 
 
121
  case 'I' :
 
122
   if (strcmp(name,"SELIDX") == 0)      /* Selection Index table */
 
123
      {                 
 
124
      char      seltab[66];
 
125
 
 
126
      ival[0] = -99;
 
127
      SCDRDI(mfd,"SELIDX",1,1,&nv,ival,unit,&null);
 
128
      ne = ival[0] + 1;                 /* get actually used size */ 
 
129
      if (ne < 2) return 0;             /* nothing to do... */
 
130
 
 
131
      (void) SCDGETC(mfd,"TSELTABL",1,64,&nv,seltab);
 
132
      if (nv > 0)
 
133
         {
 
134
         n = sprintf(fhc,"HISTORY  'XTSELTABL','C*1',1,%d,'70A1'",nv);
 
135
         while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
136
         dwrite(fhc,MXFHC);     
 
137
         n = sprintf(fhc,"HISTORY  %s",seltab);
 
138
         while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
139
         dwrite(fhc,MXFHC);     
 
140
         }
 
141
      }
 
142
 
 
143
   n = sprintf(fhc,"HISTORY  '%s','I*%d',1,%d,'7I10'",name,nbpe,ne);
 
144
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
145
   dwrite(fhc,MXFHC);   
 
146
 
 
147
   epl = 7;
 
148
   while (ne)
 
149
      {                         /* go through all elements   */
 
150
      no = (epl<ne) ? epl : ne;
 
151
      SCDRDI(mfd,name,nf,no,&nv,ival,unit,&null);
 
152
      nf += nv; ne -= nv; n = 0; 
 
153
      idx = 9; pc = &fhc[idx];          /* position after 'HISTORY  ' */
 
154
      while (nv--) 
 
155
         {                              /* write one HISTORY card    */
 
156
         i = sprintf(pc,"%10d",ival[n]);
 
157
         pc += i; idx += i;
 
158
         n++;
 
159
         }
 
160
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
 
161
      dwrite(fhc,MXFHC);        
 
162
      }
 
163
   break;
 
164
 
 
165
  case 'R' :
 
166
   n = sprintf(fhc,"HISTORY  '%s','R*%d',1,%d,'5E14.7'",name,nbpe,ne);
 
167
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
168
   dwrite(fhc,MXFHC);   
 
169
 
 
170
   epl = 5;
 
171
   while (ne) 
 
172
      {                         /* go through all elements   */
 
173
      no = (epl<ne) ? epl : ne;
 
174
      SCDRDR(mfd,name,nf,no,&nv,fval,unit,&null);
 
175
      nf += nv; ne -= nv; n = 0; 
 
176
      idx = 9; pc = &fhc[idx];          /* position after 'HISTORY  ' */
 
177
      while (nv--) 
 
178
         {             /* write one HISTORY card    */
 
179
         i = sprintf(pc,"%14.7E",fval[n]); 
 
180
         pc += i; idx += i;
 
181
         n++;
 
182
         }
 
183
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
 
184
      dwrite(fhc,MXFHC);        
 
185
      }
 
186
   break;
 
187
 
 
188
  case 'D' :
 
189
   n = sprintf(fhc,"HISTORY  '%s','R*%d',1,%d,'3E23.15'",name,nbpe,ne);
 
190
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
191
   dwrite(fhc,MXFHC);   
 
192
 
 
193
   epl = 3;
 
194
   while (ne) 
 
195
      {                         /* go through all elements   */
 
196
      no = (epl<ne) ? epl : ne;
 
197
      SCDRDD(mfd,name,nf,no,&nv,dval,unit,&null);
 
198
      nf += nv; ne -= nv; n = 0; 
 
199
      idx = 9; pc = &fhc[idx];          /* position after 'HISTORY  ' */
 
200
      while (nv--) 
 
201
         {             /* write one HISTORY card    */
 
202
         i = sprintf(pc,"%23.15E",dval[n]);
 
203
         pc += i; idx += i;
 
204
         n++;
 
205
         }
 
206
      while (idx<MXFHC) fhc[idx++] = ' '; fhc[idx] = '\0';
 
207
      dwrite(fhc,MXFHC);        
 
208
      }
 
209
   break;
 
210
 
 
211
  case 'C' :
 
212
   if (strcmp(name,"XTSELTABL") == 0)   /* don't write it again... */
 
213
      return 0;
 
214
 
 
215
   if (MXFCC<=nbpe)
 
216
      {
 
217
      sprintf(chc,"Warning: descriptor >%s< skipped - too long C*%d",
 
218
                  name,nbpe);
 
219
      SCTPUT(chc);
 
220
      break;
 
221
      }
 
222
 
 
223
   epl = (MXFCC < ne*nbpe) ? MXFCC : ne*nbpe;
 
224
   n = sprintf(fhc,"HISTORY  '%s','C*%d',1,%d,'%dA1'",name,nbpe,ne,epl);
 
225
   while (n<MXFHC) fhc[n++] = ' '; fhc[n] = '\0';
 
226
   dwrite(fhc,MXFHC);   
 
227
 
 
228
   for (n=0; n<MXFHC; n++) chc[n] = ' '; chc[n] = '\0';
 
229
 
 
230
   n = 1; net = ne*nbpe;
 
231
   while (net)
 
232
      {                 /* go through all elements   */
 
233
      if (nbpe==1) no = (epl<net) ? epl : net; else no = 1;
 
234
      pc = buf;
 
235
      SCDRDC(mfd,name,nbpe,nf,no,&nv,pc,unit,&null);
 
236
      if (nv<=0) break;
 
237
      nf += nv; nv *= nbpe; net -= nv;
 
238
      while (nv--) 
 
239
         {
 
240
         c = *pc++;
 
241
         if (c=='\\' || c=='\n')
 
242
            {
 
243
            chc[n++] = '\\';
 
244
            if (MXFCC<n) 
 
245
               {
 
246
               chc[n] = '\0'; fitswkc("HISTORY",chc); n = 1;
 
247
               }
 
248
            if (c=='\\') chc[n++] = '\\';
 
249
            else if (c=='\n') chc[n++] = 'n';
 
250
            }
 
251
         else if (' '<=c && c<='~') 
 
252
            chc[n++] = c;
 
253
         else 
 
254
            chc[n++] = ' ';
 
255
         if (MXFCC<n) 
 
256
            {
 
257
            chc[n] = '\0'; fitswkc("HISTORY",chc); n = 1;
 
258
            }
 
259
         }
 
260
      }
 
261
   if (1<n) 
 
262
      { 
 
263
      chc[n] = '\0'; fitswkc("HISTORY",chc);
 
264
      }
 
265
   break;
 
266
   }
 
267
 
 
268
 
 
269
for (n=9; n<MXFHC; n++) fhc[n] = ' '; fhc[n] = '\0';
 
270
dwrite(fhc,MXFHC);      
 
271
 
 
272
return 0;
 
273
}