← Back to branch summary

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

« back to all changes in this revision

Viewing changes to stdred/do/src/tbfhand.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:
stdred/do/src/tbfhand.c
 
1
/* @(#)tbfhand.c        19.1 (ESO-DMD) 02/25/03 14:18:06 */
 
2
/*===========================================================================
 
3
  Copyright (C) 1995 European Southern Observatory (ESO)
 
4
 
 
5
  This program is free software; you can redistribute it and/or 
 
6
  modify it under the terms of the GNU General Public License as 
 
7
  published by the Free Software Foundation; either version 2 of 
 
8
  the License, or (at your option) any later version.
 
9
 
 
10
  This program is distributed in the hope that it will be useful,
 
11
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
  GNU General Public License for more details.
 
14
 
 
15
  You should have received a copy of the GNU General Public 
 
16
  License along with this program; if not, write to the Free 
 
17
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
18
  MA 02139, USA.
 
19
 
 
20
  Correspondence concerning ESO-MIDAS should be addressed as follows:
 
21
        Internet e-mail: midas@eso.org
 
22
        Postal address: European Southern Observatory
 
23
                        Data Management Division 
 
24
                        Karl-Schwarzschild-Strasse 2
 
25
                        D 85748 Garching bei Muenchen 
 
26
                        GERMANY
 
27
 
 
28
 010802         last modif
 
29
 
 
30
===========================================================================*/
 
31
 
 
32
#include <atype.h>
 
33
#include <tbldef.h>
 
34
#include <tblsys.h>
 
35
#include <tblerr.h>
 
36
#include <midas_def.h>
 
37
#include <macrogen.h>
 
38
#include <math.h>
 
39
#include <proto_tbl.h>
 
40
 
 
41
#define MAXBIN 1024
 
42
#define  NM 32
 
43
#define  NT 5
 
44
char *osmmget() ;
 
45
main()
 
46
{
 
47
int dummy,i,j,k,l ;
 
48
int status,tid,nrow,kcol,nocat,otid,no,ormf ;
 
49
int *create, imno, noelem[256], noelembis,ocol[256],colf;
 
50
int *keyival[256], *ipos,ontype;
 
51
int null, nl, unit;
 
52
int naxis,npix[3];
 
53
float *keyrval[256],ms[2];
 
54
double *keydval[256],start[3],step[3];
 
55
char incata[60],intable[60],outable[60],filename[60];
 
56
char *cdummy, type,*keycval[256];
 
57
char form[1+TBL_FORLEN],*temp, *otype;
 
58
char *keyname,*label,*area,defaul[5];
 
59
char *keyword = "descr_iname";
 
60
status = SCSPRO("TDATABASE");
 
61
status = SCKGETC("IN_A",1,60,&dummy,incata);
 
62
status = SCKGETC("IN_B",1,60,&dummy,intable);
 
63
status = SCKGETC("OUT_A",1,60,&dummy,outable);
 
64
 
 
65
                       /*open table containing keywords names */
 
66
status = TCTOPN(intable,F_I_MODE,&tid)  ;
 
67
status = TCIGET(tid,&dummy,&nrow,&dummy,&dummy,&dummy);
 
68
status = SCCSHO(incata,&nocat,&dummy);
 
69
 
 
70
status = TCTINI(outable,F_TRANS,F_IO_MODE,nrow,nocat,&otid);
 
71
status = TCCINI(otid,D_C_FORMAT,60L,"A16"," ","FILENAME",&colf);
 
72
status = TCCSER(tid,keyword,&kcol);
 
73
keyname = osmmget(NM*nrow);
 
74
otype = osmmget(NT*nrow);
 
75
nl = TBL_LABLEN+1;
 
76
label = osmmget(nl*nocat);
 
77
ipos = (int *)osmmget(nrow*sizeof(int));
 
78
create = (int *)osmmget((nrow+2)*sizeof(int));
 
79
for (i=0; i<nrow; i++) {
 
80
    TCERDC(tid,i+1,kcol,keyname+i*NM,&null);
 
81
    if (null) *(keyname+i*NM) = '\0';
 
82
    TCERDC(tid,i+1,4L,otype+i*NT,&null);
 
83
    if (null) *(otype+i*NT) = '\0';
 
84
    else {
 
85
         temp = otype+i*NT + strskip(otype+i*NT,' ');
 
86
         noelem[i] = 1;
 
87
         if ((temp[0] == 'C') || (temp[0] == 'c')) 
 
88
             if (temp[1] == '*') noelem[i] = atoi(temp+2); 
 
89
         }
 
90
    TCERDI(tid,i+1,2L,ipos+i,&null);
 
91
    if (null) *(ipos+i) = 1;
 
92
    TCERDC(tid,i+1,3L,label+i*nl,&null);
 
93
    if (null) *(label+i*nl) = '\0';
 
94
    *(create+i) = 0;  
 
95
    if (*(otype+i*NT)) {
 
96
       switch (temp[0]) {
 
97
          case 'C': case 'c': 
 
98
                  ontype = D_C_FORMAT; 
 
99
                  sprintf(form,"A%d",noelem[i]);
 
100
                  keycval[i] = osmmget(noelem[i]);
 
101
                  break;
 
102
          case 'I': case 'i': 
 
103
                  ontype = D_I4_FORMAT; 
 
104
                  strcpy(form,"I8");
 
105
/*                keyival[i] = (int *)osmmget(sizeof(int)); */
 
106
                  break;
 
107
          case 'R': case 'r': 
 
108
                  ontype = D_R4_FORMAT; 
 
109
                  strcpy(form,"E12.6");
 
110
/*                  keyrval[i] = (float *)osmmget(sizeof(float)); */
 
111
                  break;
 
112
          case 'D': case 'd': 
 
113
                  ontype = D_R8_FORMAT; 
 
114
                  strcpy(form,"D24.17");
 
115
/*                  keydval[i] = (double *)osmmget(sizeof(double)); */
 
116
                  break;
 
117
          }
 
118
         if (!*(label+i*nl)) strncpy(label+i*nl,keyname+i*NM,nl);
 
119
         TCCINI(otid,ontype,noelem[i],form," ",label+i*nl,&ocol[i]);
 
120
         *(create+i) = 1;
 
121
       }
 
122
}
 
123
filename[0] = '\0';
 
124
*(create+nrow) = 0;
 
125
ormf = 0;
 
126
l =0; no = 0;
 
127
for (j=0; j<nocat; j++) {
 
128
 status = SCCGET(incata,0,filename,cdummy,&no);
 
129
 if (filename[0] != ' ') {
 
130
   ormf = MAX(ormf,strlen(filename));
 
131
   SCFOPN(filename,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,&imno);
 
132
   l++;
 
133
   TCEWRC(otid,l,colf,filename);   
 
134
   for (i=0; i<nrow; i++) {
 
135
     SCDFND(imno,keyname+i*NM,&type,&noelembis,&dummy);
 
136
     if (!*(label+i*nl)) strncmp(label+i*nl,keyname+i*NM,nl);
 
137
     switch(type) {
 
138
      case 'C':
 
139
       if (*(create+i) == 0) {
 
140
         sprintf(form,"A%d",noelembis);
 
141
         TCCINI(otid,D_C_FORMAT,noelembis,form," ",label+i*nl,&ocol[i]);
 
142
         *(create+i) = 1;
 
143
         keycval[i] = osmmget(noelembis);
 
144
         }
 
145
         SCDRDC(imno,keyname+i*NM,1L,1L,noelem[i],&dummy,
 
146
                     keycval[i],&unit,&null);
 
147
         TCEWRC(otid,l,ocol[i],keycval[i]);
 
148
         break;
 
149
      case 'I':
 
150
       if (*(create+i) == 0) {
 
151
          TCCINI(otid,D_I4_FORMAT,1,"I8"," ",label+i*nl,&ocol[i]);
 
152
          *(create+i) = 1;
 
153
          }
 
154
          keyival[i] = (int *)osmmget(sizeof(int));
 
155
          SCDRDI(imno,keyname+i*NM,*(ipos+i),1L,&dummy,keyival[i],&unit,&null);
 
156
          TCEWRI(otid,l,ocol[i],keyival[i]);
 
157
          break;
 
158
       case 'R':
 
159
       if (*(create+i) == 0) {
 
160
          TCCINI(otid,D_R4_FORMAT,1,"E12.6"," ",label+i*nl,&ocol[i]);
 
161
          *(create+i) = 1;
 
162
           }
 
163
          keyrval[i] = (float *)osmmget(sizeof(float));
 
164
          SCDRDR(imno,keyname+i*NM,*(ipos+i),1L,&dummy,keyrval[i],&unit,&null);
 
165
          TCEWRR(otid,l,ocol[i],keyrval[i]);
 
166
          break;
 
167
        case 'D':
 
168
        if (*(create+i) == 0) {
 
169
          TCCINI(otid,D_R8_FORMAT,1,"D24.17"," ",label+i*nl,&ocol[i]);
 
170
          *(create+i) = 1;
 
171
          }
 
172
          keydval[i] = (double *)osmmget(sizeof(double));
 
173
          SCDRDD(imno,keyname+i*NM,*(ipos+i),1L,&dummy,keydval[i],&unit,&null);
 
174
          TCEWRD(otid,l,ocol[i],keydval[i]);
 
175
          break;
 
176
         case ' ':
 
177
        if (*(create+i) != 0) TCEDEL(otid,l,ocol[i]); 
 
178
      }
 
179
    }
 
180
   }
 
181
   if (*(create+nrow) == 0) {
 
182
       TCCINI(otid,D_R4_FORMAT,1,"E15.6"," ","MEAN",&ocol[nrow]);
 
183
       TCCINI(otid,D_R4_FORMAT,1,"E15.6"," ","SIGMA",&ocol[nrow+1]);
 
184
       *(create+nrow) = 1;
 
185
       }
 
186
   strcpy(defaul,"YNSNY");
 
187
   SCDRDI(imno,"NAXIS",1L,1L,&dummy,&naxis,&unit,&null);
 
188
   SCDRDI(imno,"NPIX",1L,naxis,&dummy,npix,&unit,&null);
 
189
/*   measig(imno,area,naxis,npix,start,step,defaul,&ms[0],&ms[1]); */
 
190
   TCEWRR(otid,l,ocol[nrow],&ms[0]);
 
191
   TCEWRR(otid,l,ocol[nrow+1],&ms[1]);
 
192
   SCFCLO(imno);
 
193
}
 
194
sprintf(form,"A%d",ormf);
 
195
status = TCFPUT(otid,colf,form);
 
196
status = SCSEPI();
 
197
}
 
198