← Back to branch summary

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

« back to all changes in this revision

Viewing changes to libsrc/ftoc-new/stk.fc

  • 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:
libsrc/ftoc-new/stk.fc
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2009 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
/*++++++++++++++++++++++++  stk.fc +++++++++++++++++++++++++++++++++++++++
 
29
.LANGUAGE C
 
30
.IDENTIFICATION Module stk.fc
 
31
.COMMENTS
 
32
Module contains layer between the keyword related FORTRAN STxxxx interfaces
 
33
and the SC_interfaces written in (hopefully independent) C
 
34
.AUTHOR         K. Banse        ESO - Garching
 
35
.KEYWORDS       standard interfaces.
 
36
.ENVIRONMENT    FORTRAN and C standards
 
37
.VERSION  [1.00] 871207:  created from SXFTOC.C
 
38
.VERSION  [2.60] 880411:  modified new version - the last one
 
39
.VERSION  [2.70] 900316:  fix problems with TEXT_LEN+2
 
40
 
 
41
 090331         last modif
 
42
-----------------------------------------------------------------------------*/
 
43
 
 
44
 
 
45
#include <midas_def.h>
 
46
 
 
47
#include <stdlib.h>
 
48
 
 
49
 
 
50
static int  kunit = 0, knull = -1;
 
51
 
 
52
int   mm;
 
53
char *ptr1, *ptr2, *ptr3, *ptr4;
 
54
char *loc_pntr();
 
55
char *strp_pntr();
 
56
 
 
57
/*
 
58
 
 
59
*/
 
60
 
 
61
/*==========================================================================*/
 
62
 
 
63
/*** stat = SCKRDI(key,felem,maxvals,actvals,values,kunit,knull) ***/
 
64
 
 
65
ROUTINE STK1(felem,maxvals,actvals,values,status)
 
66
int  *felem;         /* IN : first data item to be read */
 
67
int  *maxvals;       /* IN : max. vals to read */
 
68
int  *actvals;       /* OUT: actual no. of elements returned */
 
69
int  *values;        /* OUT: buffer for data values */
 
70
int  *status;
 
71
 
 
72
{
 
73
ptr1 = strp_pntr(1);            /* get stripped string of "key" */
 
74
 
 
75
*status = SCKRDI(ptr1,*felem,*maxvals,actvals,values,&kunit,&knull);
 
76
 
 
77
return 0;
 
78
}
 
79
 
 
80
 
 
81
/*==========================================================================*/
 
82
 
 
83
/*** stat = SCKRDR(key,felem,maxvals,actvals,values,kunit,knull) ***/
 
84
 
 
85
ROUTINE STK2(felem,maxvals,actvals,values,status)
 
86
int  *felem;       /* IN : first data item to be read */
 
87
int  *maxvals;     /* IN : max. vals to read */
 
88
int  *actvals;     /* OUT: actual no. of elements returned */
 
89
float  *values;    /* OUT: buffer for data values */
 
90
int  *status;
 
91
 
 
92
{
 
93
ptr1 = strp_pntr(1);            /* get stripped string of "key" */
 
94
 
 
95
*status = SCKRDR(ptr1,*felem,*maxvals,actvals,values,&kunit,&knull);
 
96
 
 
97
return 0;
 
98
}
 
99
 
 
100
 
 
101
/*==========================================================================*/
 
102
 
 
103
/*** stat = SCKRDD(key,felem,maxvals,actvals,values,kunit,knull) ***/
 
104
 
 
105
ROUTINE STK3(felem,maxvals,actvals,values,status)
 
106
int  *felem;        /* IN : first data item to be read */
 
107
int  *maxvals;      /* IN : max. vals to read */
 
108
int  *actvals;      /* OUT: actual no. of elements returned */
 
109
double  *values;    /* OUT: buffer for data values */
 
110
int  *status;
 
111
 
 
112
{
 
113
ptr1 = strp_pntr(1);            /* get stripped string of "key" */
 
114
 
 
115
*status = SCKRDD(ptr1,*felem,*maxvals,actvals,values,&kunit,&knull);
 
116
 
 
117
return 0;
 
118
}
 
119
 
 
120
 
 
121
/*==========================================================================*/
 
122
 
 
123
/*** stat = SCKRDC(key,noelm,felem,maxvals,actvals,values,kunit,knull) ***/
 
124
 
 
125
ROUTINE STK4(noelm,felem,maxvals,actvals,status)
 
126
int  *noelm;     /* IN : no. of bytes (chars) per element */
 
127
int  *felem;         /* IN : first data item to be read */
 
128
int  *maxvals;       /* IN : max. vals to read */
 
129
int  *actvals;       /* OUT: actual no. of elements returned */
 
130
int  *status;
 
131
 
 
132
{
 
133
int  n;
 
134
 
 
135
ptr1 = strp_pntr(1);            /* get stripped string of "key" */
 
136
ptr2 = loc_pntr(1,&mm);         /* get location of "values" */
 
137
 
 
138
*status = SCKRDC(ptr1,*noelm,*felem,*maxvals,actvals,ptr2,&kunit,&knull);
 
139
 
 
140
n = *actvals;
 
141
if ((n > 0) && (n < mm)) *(ptr2+n) = ' ';
 
142
 
 
143
return 0;
 
144
}
 
145
 
 
146
 
 
147
/*==========================================================================*/
 
148
 
 
149
/*** stat = SCKPRC(prompt,key,noelm,felem,maxvals,actvals,values,kunit,knull) ***/
 
150
 
 
151
ROUTINE STK5(noelm,felem,maxvals,actvals,status)
 
152
int  *noelm;     /* IN : no. of bytes (chars) per element */
 
153
int  *felem;     /* IN : first data item to be read */
 
154
int  *maxvals;   /* IN : max. vals to read */
 
155
int  *actvals;   /* OUT: actual no. of elements returned */
 
156
int  *status;
 
157
 
 
158
{
 
159
int  n;
 
160
 
 
161
ptr1 = strp_pntr(1);            /* get stripped string of "key" */
 
162
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
163
ptr2 = strp_pntr(2);                    /* get stripped string of "prompt" */
 
164
ptr3 = loc_pntr(1,&mm);                 /* get location of "values" */
 
165
 
 
166
 
 
167
*status = SCKPRC(ptr2,ptr1,*noelm,*felem,*maxvals,actvals,ptr3,&kunit,&knull);
 
168
 
 
169
n = *actvals;
 
170
if ((n > 0) && (n < mm)) *(ptr3+n) = ' ';
 
171
 
 
172
return 0;
 
173
}
 
174
 
 
175
 
 
176
/*==========================================================================*/
 
177
 
 
178
/*** stat = SCKPRI(prompt,key,felem,maxvals,actvals,values,kunit,knull) ***/
 
179
 
 
180
ROUTINE STK6(felem,maxvals,actvals,values,status)
 
181
int  *felem;         /* IN : first data item to be read */
 
182
int  *maxvals;       /* IN : max. vals to read */
 
183
int  *actvals;       /* OUT: actual no. of elements returned */
 
184
int  *values;        /* OUT: buffer for data values */
 
185
int  *status;
 
186
 
 
187
{
 
188
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
189
ptr2 = strp_pntr(2);                    /* get stripped string of "prompt" */
 
190
 
 
191
*status = SCKPRI(ptr2,ptr1,*felem,*maxvals,actvals,values,&kunit,&knull);
 
192
 
 
193
return 0;
 
194
}
 
195
 
 
196
 
 
197
/*==========================================================================*/
 
198
 
 
199
/*** stat = SCKPRR(prompt,key,felem,maxvals,actvals,values,kunit,knull) ***/
 
200
 
 
201
ROUTINE STK7(felem,maxvals,actvals,values,status)
 
202
int  *felem;         /* IN : first data item to be read */
 
203
int  *maxvals;       /* IN : max. vals to read */
 
204
int  *actvals;       /* OUT: actual no. of elements returned */
 
205
float  *values;      /* OUT: buffer for data values */
 
206
int  *status;
 
207
 
 
208
{
 
209
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
210
ptr2 = strp_pntr(2);                    /* get stripped string of "prompt" */
 
211
 
 
212
*status = SCKPRR(ptr2,ptr1,*felem,*maxvals,actvals,values,&kunit,&knull);
 
213
 
 
214
return 0;
 
215
}
 
216
 
 
217
/*==========================================================================*/
 
218
 
 
219
/*** stat = SCKPRD(prompt,key,felem,maxvals,actvals,values,kunit,knull) ***/
 
220
 
 
221
ROUTINE STK8(felem,maxvals,actvals,values,status)
 
222
int  *felem;         /* IN : first data item to be read */
 
223
int  *maxvals;       /* IN : max. vals to read */
 
224
int  *actvals;       /* OUT: actual no. of elements returned */
 
225
double  *values;     /* OUT: buffer for data values */
 
226
int  *status;
 
227
 
 
228
{
 
229
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
230
ptr2 = strp_pntr(2);                    /* get stripped string of "prompt" */
 
231
 
 
232
*status = SCKPRD(ptr2,ptr1,*felem,*maxvals,actvals,values,&kunit,&knull);
 
233
 
 
234
return 0;
 
235
}
 
236
 
 
237
/*==========================================================================*/
 
238
 
 
239
/*** stat = SCKWRC(key,noelm,values,felem,maxvals,kunit)  ***/
 
240
 
 
241
ROUTINE STK9(noelm,felem,maxvals,status)
 
242
int *noelm;     /* IN: no. of chars (bytes) per data value */
 
243
int  *felem;         /* IN : first data item to be read */
 
244
int  *maxvals;       /* IN : max. vals to read */
 
245
int  *status;
 
246
 
 
247
{
 
248
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
249
ptr2 = loc_pntr(1,&mm);                 /* get location of "values" */
 
250
 
 
251
*status = SCKWRC(ptr1,*noelm,ptr2,*felem,*maxvals,&kunit);
 
252
 
 
253
return 0;
 
254
}
 
255
 
 
256
/*==========================================================================*/
 
257
 
 
258
/*** stat = SCKWRI(key,values,felem,maxvals,kunit)  ***/
 
259
 
 
260
ROUTINE STK10(values,felem,maxvals,status)
 
261
int  *values;     /* IN : buffer with data values */
 
262
int  *felem;      /* IN : first data item to be read */
 
263
int  *maxvals;    /* IN : max. vals to read */
 
264
int  *status;
 
265
 
 
266
{
 
267
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
268
 
 
269
*status = SCKWRI(ptr1,values,*felem,*maxvals,&kunit);
 
270
 
 
271
return 0;
 
272
}
 
273
 
 
274
/*==========================================================================*/
 
275
 
 
276
/*** stat = SCKWRD(key,values,felem,maxvals,kunit)  ***/
 
277
 
 
278
ROUTINE STK11(values,felem,maxvals,status)
 
279
double  *values;  /* IN : buffer with data values */
 
280
int  *felem;      /* IN : first data item to be read */
 
281
int  *maxvals;    /* IN : max. vals to read */
 
282
int  *status;
 
283
 
 
284
{
 
285
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
286
 
 
287
*status = SCKWRD(ptr1,values,*felem,*maxvals,&kunit);
 
288
 
 
289
return 0;
 
290
}
 
291
 
 
292
/*==========================================================================*/
 
293
 
 
294
/*** stat = SCKWRR(key,values,felem,maxvals,kunit)  ***/
 
295
 
 
296
ROUTINE STK12(values,felem,maxvals,status)
 
297
float  *values;   /* IN : buffer with data values */
 
298
int  *felem;      /* IN : first data item to be read */
 
299
int  *maxvals;    /* IN : max. vals to read */
 
300
int  *status;
 
301
 
 
302
{
 
303
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
304
 
 
305
*status = SCKWRR(ptr1,values,*felem,*maxvals,&kunit);
 
306
 
 
307
return 0;
 
308
}
 
309
 
 
310
/*==========================================================================*/
 
311
 
 
312
/*** stat = SCKFND(key,type,noelem,bytelem,status)  ***/
 
313
 
 
314
ROUTINE STK13(noelem,bytelem,status)
 
315
int  *noelem;        /* OUT: no. of elements  */
 
316
int  *bytelem;       /* OUT: no. of bytes per element  */
 
317
int  *status;
 
318
 
 
319
{
 
320
int  n;
 
321
 
 
322
ptr1 = strp_pntr(1);            /* get stripped string of "key" */
 
323
ptr1 = strp_pntr(1);                    /* get stripped string of "key" */
 
324
ptr2 = loc_pntr(1,&mm);                 /* get location of "type" */
 
325
 
 
326
*status = SCKFND(ptr1,ptr2,noelem,bytelem);
 
327
 
 
328
n = (int) strlen(ptr2);
 
329
if ((n > 0) && (n < mm)) *(ptr2+n) = ' ';
 
330
 
 
331
return 0;
 
332
}
 
333
 
 
334
/*==========================================================================*/
 
335
 
 
336
/*** stat = SCKINF(npos,field,buf,numbuf)  ***/
 
337
 
 
338
ROUTINE STK14(npos,field,numbuf,status)
 
339
int  *npos;      /* IN : position of keyword */
 
340
int  *field;     /* IN :specifies desired info, */
 
341
                 /*     1 = NAME, 2 = TYPE, 3 = SIZE  */
 
342
int  *numbuf;    /* IN : max. length of buffer above  */
 
343
int  *status;
 
344
 
 
345
{
 
346
int  n;
 
347
 
 
348
ptr1 = loc_pntr(1,&mm);                 /* get location of "buf" */
 
349
 
 
350
n = *field;
 
351
*status = SCKINF(*npos,*field,ptr1,(mm-1),numbuf);
 
352
 
 
353
if (n != 3)                    /* treat char. result buffer */
 
354
   {
 
355
   n = (int) strlen(ptr1);
 
356
   if ((n > 0) && (n < mm)) *(ptr1+n) = ' ';
 
357
   }
 
358
 
 
359
return 0;
 
360
}
 
361
 
 
362
 
 
363