← Back to branch summary

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

« back to all changes in this revision

Viewing changes to libsrc/ftoc-new/std.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/std.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
/*++++++++++++++++++++++++  std.fc +++++++++++++++++++++++++++++++++++++++
 
29
.LANGUAGE C
 
30
.IDENTIFICATION Module std.fc
 
31
.COMMENTS
 
32
 Module contains layer between the descriptor 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
 
 
39
 090611         last modif
 
40
-----------------------------------------------------------------------------*/
 
41
 
 
42
#include <midas_def.h>
 
43
        
 
44
#include <stdlib.h>
 
45
 
 
46
static int  dunit = 0, dnull = -1;
 
47
int   mm;
 
48
 
 
49
char *ptr1, *ptr2;
 
50
char *loc_pntr();
 
51
char *strp_pntr();
 
52
 
 
53
 
 
54
/*
 
55
 
 
56
*/
 
57
 
 
58
/*==========================================================================*/
 
59
 
 
60
/*** stat = SCDRDI(no,descr,felem,maxvals,actvals,values,dunit,dnull) ***/
 
61
 
 
62
ROUTINE STD1(no,felem,maxvals,actvals,values,status)
 
63
int  *no;            /* IN : no. of data frame */
 
64
int     *felem;         /* IN : first data item to be read */
 
65
int  *maxvals;       /* IN : max. vals to read */
 
66
int  *actvals;       /* OUT: actual no. of elements returned */
 
67
int  *values;        /* OUT: buffer for data values */
 
68
int  *status;
 
69
 
 
70
{       
 
71
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
72
 
 
73
*status = SCDRDI(*no,ptr1,*felem,*maxvals,actvals,values,&dunit,&dnull);
 
74
 
 
75
return 0;
 
76
}
 
77
 
 
78
/*==========================================================================*/
 
79
 
 
80
/*** stat = SCDRDL(no,descr,felem,maxvals,actvals,values,dunit,dnull) ***/
 
81
 
 
82
ROUTINE STD2(no,felem,maxvals,actvals,values,status)
 
83
int  *no;            /* IN : no. of data frame */
 
84
int  *felem;         /* IN : first data item to be read */
 
85
int  *maxvals;       /* IN : max. vals to read */
 
86
int  *actvals;       /* OUT: actual no. of elements returned */
 
87
int  *values;        /* OUT: buffer for data values */
 
88
int  *status;
 
89
 
 
90
{
 
91
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
92
 
 
93
*status = SCDRDL(*no,ptr1,*felem,*maxvals,actvals,values,&dunit,&dnull);
 
94
 
 
95
return 0;
 
96
}
 
97
 
 
98
/*==========================================================================*/
 
99
 
 
100
/*** stat = SCDRDR(no,descr,felem,maxvals,actvals,values,dunit,dnull) ***/
 
101
 
 
102
ROUTINE STD3(no,felem,maxvals,actvals,values,status)
 
103
int  *no;            /* IN : no. of data frame */
 
104
int  *felem;         /* IN : first data item to be read */
 
105
int  *maxvals;       /* IN : max. vals to read */
 
106
int  *actvals;       /* OUT: actual no. of elements returned */
 
107
float  *values;      /* OUT: buffer for data values */
 
108
int  *status;
 
109
 
 
110
{
 
111
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
112
 
 
113
*status = SCDRDR(*no,ptr1,*felem,*maxvals,actvals,values,&dunit,&dnull);
 
114
 
 
115
return 0;
 
116
}
 
117
 
 
118
 
 
119
/*==========================================================================*/
 
120
 
 
121
/*** stat = SCDRDD(no,descr,felem,maxvals,actvals,values,dunit,dnull) ***/
 
122
 
 
123
ROUTINE STD4(no,felem,maxvals,actvals,values,status)
 
124
int  *no;            /* IN : no. of data frame */
 
125
int  *felem;         /* IN : first data item to be read */
 
126
int  *maxvals;       /* IN : max. vals to read */
 
127
int  *actvals;       /* OUT: actual no. of elements returned */
 
128
double  *values;        /* OUT: buffer for data values */
 
129
int  *status;
 
130
 
 
131
{
 
132
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
133
 
 
134
*status = SCDRDD(*no,ptr1,*felem,*maxvals,actvals,values,&dunit,&dnull);
 
135
 
 
136
return 0;
 
137
}
 
138
 
 
139
 
 
140
/*==========================================================================*/
 
141
 
 
142
/*** stat = SCDRDS(no,descr,felem,maxvals,actvals,values,dunit,dnull) ***/
 
143
 
 
144
ROUTINE STD4a(no,felem,maxvals,actvals,values,status)
 
145
int  *no;            /* IN : no. of data frame */
 
146
int  *felem;         /* IN : first data item to be read */
 
147
int  *maxvals;       /* IN : max. vals to read */
 
148
int  *actvals;       /* OUT: actual no. of elements returned */
 
149
size_t  *values;        /* OUT: buffer for data values */
 
150
int  *status;
 
151
 
 
152
{
 
153
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
154
 
 
155
*status = SCDRDS(*no,ptr1,*felem,*maxvals,actvals,values,&dunit,&dnull);
 
156
 
 
157
return 0;
 
158
}
 
159
 
 
160
 
 
161
/*==========================================================================*/
 
162
 
 
163
/*** stat = SCDRDC(no,descr,noelm,felem,maxvals,actvals,values,dunit,dnull) ***/
 
164
 
 
165
ROUTINE STD5(no,noelm,felem,maxvals,actvals,status)
 
166
int  *no;        /* IN : no. of data frame */
 
167
int  *noelm;     /* IN : no. of data frame */
 
168
int  *felem;     /* IN : first data item to be read */
 
169
int  *maxvals;   /* IN : max. vals to read */
 
170
int  *actvals;   /* OUT: actual no. of elements returned */
 
171
int  *status;
 
172
 
 
173
{
 
174
int  n;
 
175
 
 
176
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
177
ptr2 = loc_pntr(1,&mm);             /* get location of "values" */
 
178
 
 
179
n = *noelm;
 
180
*status = SCDRDC(*no,ptr1,n,*felem,*maxvals,actvals,ptr2,&dunit,&dnull);
 
181
 
 
182
n *= (*actvals);
 
183
if ((n > 0) && (n < mm)) *(ptr2+n) = ' ';
 
184
 
 
185
return 0;
 
186
}
 
187
 
 
188
/*==========================================================================*/
 
189
 
 
190
/*** stat = SCDRDH(no,descr,felem,maxvals,actvals,values,total) ***/
 
191
 
 
192
ROUTINE STD6(no,felem,maxvals,actvals,total,status)
 
193
int  *no;            /* IN : no. of data frame */
 
194
int  *felem;         /* IN : first data item to be read */
 
195
int  *maxvals;       /* IN : max. vals to read */
 
196
int  *actvals;       /* OUT: actual no. of elements returned */
 
197
int  *total;         /* OUT : total size of help text */
 
198
int  *status;
 
199
 
 
200
{
 
201
int  n;
 
202
  
 
203
 
 
204
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
205
ptr2 = loc_pntr(1,&mm);             /* get location of "values" */
 
206
 
 
207
*status = SCDRDH(*no,ptr1,*felem,*maxvals,actvals,ptr2,total);
 
208
 
 
209
n = *actvals;
 
210
if ((n > 0) && (n < mm)) *(ptr2+n) = ' ';
 
211
 
 
212
return 0;
 
213
}
 
214
 
 
215
/*==========================================================================*/
 
216
 
 
217
/*** stat = SCDFND(no,descr,type,noelem,bytelem) ***/
 
218
 
 
219
ROUTINE STD7(no,noelem,bytelem,status)
 
220
int  *no;            /* IN : no. of data frame */
 
221
int  *noelem;        /* OUT: no. of elements  */
 
222
int  *bytelem;       /* OUT: no. of bytes per element  */
 
223
int  *status;
 
224
 
 
225
{
 
226
int  n;
 
227
 
 
228
 
 
229
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
230
ptr2 = loc_pntr(1,&mm);             /* get location of "type" */
 
231
 
 
232
*status = SCDFND(*no,ptr1,ptr2,noelem,bytelem);
 
233
 
 
234
 
 
235
n = (int) strlen(ptr2);
 
236
if ((n > 0) && (n < mm)) *(ptr2+n) = ' ';
 
237
 
 
238
return 0;
 
239
}
 
240
 
 
241
/*==========================================================================*/
 
242
 
 
243
/*** stat = SCDINF(no,npos,field,buf,numbuf) ***/
 
244
 
 
245
ROUTINE STD8(no,npos,field,numbuf,status)
 
246
int  *no;           /* IN : no. of data frame */
 
247
int  *npos;         /* IN: position of descr */
 
248
int  *field;        /* IN: specify info,1 = NAME, 2 = TYPE, 3 = SIZE */
 
249
int  *numbuf;       /* IN : return buffer for numerical data  */
 
250
int  *status;
 
251
 
 
252
{
 
253
int  n;
 
254
 
 
255
ptr1 = loc_pntr(1,&mm);             /* get location of "buf", available space */
 
256
 
 
257
n = *field; 
 
258
*status = SCDINF(*no,*npos,n,ptr1,(mm-1),numbuf);
 
259
 
 
260
if (n != 3)                     /* treat char. result buffer */
 
261
   {
 
262
   n = (int) strlen(ptr1);
 
263
   if ((n > 0) && (n < mm)) *(ptr1+n) = ' ';
 
264
   }
 
265
 
 
266
return 0;
 
267
}
 
268
 
 
269
/*==========================================================================*/
 
270
 
 
271
/*** stat = SCDRDX(no,flag,descr,type,bytel,noel,hnc) ***/
 
272
 
 
273
ROUTINE STD9(no,flag,bytel,noel,hnc,status)
 
274
int *no;        /* IN: imno of data frame */
 
275
int *flag;      /* IN: action flag
 
276
                       = 0,  free space again
 
277
                       = 1,  read in complete descr. directory
 
278
                       = 2,  as 1 and also return total no. of descriptors
 
279
                       = 10, return descr. info of next descr. */
 
280
int *bytel;     /* OUT: no. of bytes per element */
 
281
int *noel;      /* OUT: no. of elements */
 
282
int *hnc;       /* OUT: no. of help text chars */
 
283
int  *status;
 
284
 
 
285
{
 
286
int  n, m1, m2;
 
287
 
 
288
ptr1 = loc_pntr(1,&m1);             /* get location of "name" */
 
289
ptr2 = loc_pntr(2,&m2);             /* get location of "ident" */
 
290
 
 
291
*status = SCDRDX(*no,*flag,ptr1,ptr2,bytel,noel,hnc);
 
292
 
 
293
n = (int) strlen(ptr1);
 
294
if ((n > 0) && (n < m1)) *(ptr1+n) = ' ';
 
295
 
 
296
n = (int) strlen(ptr2);
 
297
if ((n > 0) && (n < m1)) *(ptr2+n) = ' ';
 
298
 
 
299
return 0;
 
300
}
 
301
 
 
302
/*==========================================================================*/
 
303
 
 
304
/*** stat = SCDWRC(no,descr,noelm,values,felem,maxvals,dunit)  ***/
 
305
 
 
306
ROUTINE STD10(no,noelm,felem,maxvals,status)
 
307
int *no;        /* IN: imno of data frame */
 
308
int *noelm;     /* IN: no. of chars (bytes) per data value */
 
309
int *felem;     /* IN : first data item to be read */
 
310
int *maxvals;   /* IN : max. vals to read */
 
311
int *status;
 
312
 
 
313
{       
 
314
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
315
ptr2 = loc_pntr(1,&mm);         /* get location of "values" */
 
316
 
 
317
 
 
318
*status = SCDWRC(*no,ptr1,*noelm,ptr2,*felem,*maxvals,&dunit);
 
319
 
 
320
return 0;
 
321
}
 
322
 
 
323
/*==========================================================================*/
 
324
 
 
325
/*** stat = SCDWRD(no,descr,values,felem,maxvals,dunit)  ***/
 
326
 
 
327
ROUTINE STD11(no,values,felem,maxvals,status)
 
328
int *no;        /* IN: imno of data frame */
 
329
double *values; /* IN: data values */
 
330
int *felem;     /* IN : first data item to be read */
 
331
int *maxvals;   /* IN : max. vals to read */
 
332
int *status;
 
333
 
 
334
{       
 
335
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
336
 
 
337
*status = SCDWRD(*no,ptr1,values,*felem,*maxvals,&dunit);
 
338
 
 
339
return 0;
 
340
}
 
341
 
 
342
/*==========================================================================*/
 
343
 
 
344
/*** stat = SCDWRH(no,descr,values,felem,maxvals)  ***/
 
345
 
 
346
ROUTINE STD12(no,felem,maxvals,status)
 
347
int *no;        /* IN: imno of data frame */
 
348
int *felem;     /* IN : first data item to be read */
 
349
int *maxvals;   /* IN : max. vals to read */
 
350
int *status;
 
351
 
 
352
{
 
353
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
354
ptr2 = strp_pntr(2);            /* get stripped string of "values" */
 
355
 
 
356
*status = SCDWRH(*no,ptr1,ptr2,*felem,*maxvals);
 
357
 
 
358
return 0;
 
359
}
 
360
 
 
361
/*==========================================================================*/
 
362
 
 
363
/*** stat = SCDWRI(no,descr,values,felem,maxvals,dunit)  ***/
 
364
 
 
365
ROUTINE STD13(no,values,felem,maxvals,status)
 
366
int *no;        /* IN: imno of data frame */
 
367
int *values;    /* IN: data values */
 
368
int *felem;     /* IN : first data item to be read */
 
369
int *maxvals;   /* IN : max. vals to read */
 
370
int *status;
 
371
 
 
372
{       
 
373
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
374
 
 
375
*status = SCDWRI(*no,ptr1,values,*felem,*maxvals,&dunit);
 
376
 
 
377
return 0;
 
378
}
 
379
 
 
380
 
 
381
/*==========================================================================*/
 
382
 
 
383
/*** stat = SCDWRL(no,descr,values,felem,maxvals,dunit)  ***/
 
384
 
 
385
ROUTINE STD14(no,values,felem,maxvals,status)
 
386
int *no;        /* IN: imno of data frame */
 
387
int *values;    /* IN: data values */
 
388
int *felem;     /* IN : first data item to be read */
 
389
int *maxvals;   /* IN : max. vals to read */
 
390
int *status;
 
391
 
 
392
{
 
393
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
394
 
 
395
*status = SCDWRL(*no,ptr1,values,*felem,*maxvals,&dunit);
 
396
 
 
397
return 0;
 
398
}
 
399
 
 
400
/*==========================================================================*/
 
401
 
 
402
/*** stat = SCDWRR(no,descr,values,felem,maxvals,dunit)  ***/
 
403
 
 
404
ROUTINE STD15(no,values,felem,maxvals,status)
 
405
int *no;        /* IN: imno of data frame */
 
406
float *values;  /* IN: data values */
 
407
int *felem;     /* IN : first data item to be read */
 
408
int *maxvals;   /* IN : max. vals to read */
 
409
int *status;
 
410
 
 
411
{
 
412
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
413
 
 
414
*status = SCDWRR(*no,ptr1,values,*felem,*maxvals,&dunit);
 
415
 
 
416
return 0;
 
417
}
 
418
 
 
419
 
 
420
ROUTINE STD16(no,status)
 
421
int  *no;            /* IN: no. of data frame */
 
422
int  *status;
 
423
 
 
424
{
 
425
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
426
 
 
427
*status = SCDDEL(*no,ptr1);
 
428
 
 
429
return 0;
 
430
}
 
431
 
 
432
ROUTINE STD17(from,to,mask,status)
 
433
int  *from;          /* IN: no. of source frame  */
 
434
int  *to;            /* IN: no. of destination frame  */
 
435
int  *mask;          /* IN: copy_mask  */
 
436
int  *status;
 
437
 
 
438
{
 
439
ptr1 = strp_pntr(1);            /* get stripped string of "descr" */
 
440
 
 
441
*status = SCDCOP(*from,*to,*mask,ptr1);
 
442
 
 
443
return 0;
 
444
}
 
445
 
 
446
 
 
447
ROUTINE STDRDZ(no,dirsize,direlem,status)
 
448
int  *no;            /* IN : no. of data frame */
 
449
int  *dirsize;       /* OUT : no. of chars used by descr-directory */
 
450
int  *direlem;       /* OUT : no. of descr. (incl directory) */
 
451
int  *status;
 
452
 
 
453
{
 
454
*status = SCDRDZ(*no,dirsize,direlem);
 
455
 
 
456
return 0;
 
457
}
 
458
 
 
459