← Back to branch summary

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

« back to all changes in this revision

Viewing changes to libsrc/ftoc-new/stf.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/stf.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
/*++++++++++++++++++++++++  stf.fc +++++++++++++++++++++++++++++++++++++++
 
29
.LANGUAGE C
 
30
.IDENTIFICATION Module stf.fc
 
31
.COMMENTS
 
32
Module contains layer between the frame 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] 880415:  modified new version - the last one
 
39
.VERSION  [2.70] 890119:  add SZCFRNM
 
40
.VERSION  [2.80] 900316:  fix problem with FNAME_LEN+2 ...
 
41
.VERSION  [3.00] 901213:  Master file. CG.
 
42
 
 
43
 090611         last modif
 
44
-----------------------------------------------------------------------------*/
 
45
 
 
46
#include <ftoc_comm.h>
 
47
#include <midas_def.h>
 
48
 
 
49
#include <stdlib.h>
 
50
 
 
51
 
 
52
int   mm;
 
53
 
 
54
char *ptr1, *ptr2, *ptr3, *ptr4;
 
55
char *loc_pntr();
 
56
char *strp_pntr();
 
57
 
 
58
/*
 
59
 
 
60
*/
 
61
 
 
62
/*==========================================================================*/
 
63
 
 
64
/*** stat = SCFOPN(name,dattype,iomode,filtype,no) ***/
 
65
 
 
66
ROUTINE STF1(dattype,iomode,filtype,no,status)
 
67
int *dattype;   /* IN: data types as defined in Module header  */
 
68
int *iomode;    /* IN: I/O mode for opening */
 
69
int *filtype;   /* IN: filetype, e.g. F_IMA_TYPE, ... */
 
70
int *no;        /* OUT: file no. of the frame   */
 
71
int *status;
 
72
 
 
73
{
 
74
ptr1 = strp_pntr(1);            /* get stripped string of "name" */
 
75
 
 
76
*status = SCFOPN(ptr1,*dattype,*iomode,*filtype,no);
 
77
 
 
78
return 0;
 
79
}
 
80
 
 
81
/*==========================================================================*/
 
82
 
 
83
/*** stat = SCFCRE(name,dattype,iomode,filtype,size,no) ***/
 
84
 
 
85
ROUTINE STF2(dattype,iomode,filtype,size,no,status)
 
86
int *dattype;   /* IN: data types as defined in Module header  */
 
87
int *iomode;    /* IN: I/O mode for opening */
 
88
int *filtype;   /* IN: filetype no., e.g. F_TBL_TYPE, ... */
 
89
int *size;      /* IN: size of object = no. of data values in file */
 
90
int *no;        /* OUT: file no.  */
 
91
int *status;
 
92
 
 
93
{
 
94
ptr1 = strp_pntr(1);            /* get stripped string of "name" */
 
95
 
 
96
*status = SCFCRE(ptr1,*dattype,*iomode,*filtype,*size,no);
 
97
 
 
98
return 0;
 
99
}
 
100
 
 
101
/*==========================================================================*/
 
102
 
 
103
/*** stat = SCFXCR(name,dattype,iomode,filtype,size,optflags,no) ***/
 
104
 
 
105
ROUTINE STF3(dattype,iomode,filtype,size,optflags,no,status)
 
106
int *dattype;   /* IN: data types as defined in Module header  */
 
107
int *iomode;    /* IN: I/O mode for opening */
 
108
int *filtype;   /* IN: filetype no., e.g. F_TBL_TYPE, ... */
 
109
int *size;      /* IN: size of object = no. of data values in file */
 
110
int *optflags;  /* IN: option for cloning descriptors (int array)
 
111
                        = 0, NO (then same as SCFCRE)
 
112
                        = 1, Yes (optio(2) = imno of source frame) */
 
113
int *no;        /* OUT: file no.  */
 
114
int *status;
 
115
 
 
116
{
 
117
ptr1 = strp_pntr(1);            /* get stripped string of "name" */
 
118
 
 
119
*status = SCFXCR(ptr1,*dattype,*iomode,*filtype,*size,optflags,no);
 
120
 
 
121
return 0;
 
122
}
 
123
 
 
124
/*==========================================================================*/
 
125
 
 
126
/*** stat = SCFMAP(no,iomode,felem,size,actsize,pntr) ***/
 
127
 
 
128
ROUTINE STF4(no,iomode,felem,size,actsize,pntr,status)
 
129
int *no;        /* IN: file no */
 
130
int *iomode;    /* IN: I/O mode for opening */
 
131
int *felem;     /* IN : 1st pixel to be accessed in data space */
 
132
int *size;      /* IN : number of data values (pixels) to be mapped */
 
133
int *actsize;   /* OUT: actual no. of pixels mapped */
 
134
long int *pntr; /* OUT: pointer to data in memory */
 
135
int *status;
 
136
 
 
137
{
 
138
char *mypntr;
 
139
 
 
140
int  lowmadr;
 
141
long  int diff;
 
142
 
 
143
 
 
144
*status = SCFMAP(*no,*iomode,*felem,*size,actsize,&mypntr);
 
145
 
 
146
lowmadr = (int) IS_HIGH(mypntr);
 
147
diff = (long int) COMMON_INDEX(mypntr);
 
148
if (lowmadr == 1)
 
149
   *pntr = diff;
 
150
else
 
151
   *pntr = -diff;
 
152
 
 
153
return 0;
 
154
}
 
155
 
 
156
/*==========================================================================*/
 
157
 
 
158
/*** stat = SCFCLO(no)  ***/
 
159
 
 
160
ROUTINE STFCLO(no,status)
 
161
int *no;             /* IN: file no. of data frame */
 
162
int *status;
 
163
 
 
164
{
 
165
*status = SCFCLO(*no);
 
166
 
 
167
return 0;
 
168
}
 
169
 
 
170
/*==========================================================================*/
 
171
 
 
172
/*** stat = SCFUNM(no) ***/
 
173
 
 
174
ROUTINE STFUNM(no,status)
 
175
int *no;             /* IN: file of data frame */
 
176
int *status;
 
177
 
 
178
{
 
179
*status = SCFUNM(*no);
 
180
 
 
181
return 0;
 
182
}
 
183
 
 
184
/*==========================================================================*/
 
185
 
 
186
/*** stat = SCFDEL(name) ***/
 
187
 
 
188
ROUTINE STF5(status)
 
189
int *status;            
 
190
 
 
191
{
 
192
ptr1 = strp_pntr(1);            /* get stripped string of "name" */
 
193
 
 
194
*status = SCFDEL(ptr1);
 
195
 
 
196
return 0;
 
197
}
 
198
 
 
199
 
 
200
/*==========================================================================*/
 
201
 
 
202
/*** stat = SCFRNM(oldname,newname) ***/
 
203
 
 
204
ROUTINE STF6(status)
 
205
int *status;
 
206
 
 
207
{
 
208
ptr1 = strp_pntr(1);            /* get stripped string of "oldname" */
 
209
ptr2 = strp_pntr(2);            /* get stripped string of "newname" */
 
210
 
 
211
*status = SCFRNM(ptr1,ptr2);
 
212
 
 
213
return 0;
 
214
}
 
215
 
 
216
/*==========================================================================*/
 
217
 
 
218
/*** stat = SCFGET(no,felem,size,actsize,bufadr) ***/
 
219
 
 
220
ROUTINE STFGET(no,felem,size,actsize,bufadr,status)
 
221
int *no;                /* IN : file no. of data frame */
 
222
int *felem;             /* IN : 1st pixel to be accessed in data space */
 
223
int *size;              /* IN : number of data values (pixels) to be read */
 
224
int *actsize;           /* OUT: actual no. of pixels read */
 
225
long int *bufadr;       /* IN: address of data buffer  */
 
226
int *status;
 
227
 
 
228
{
 
229
*status = SCFGET(*no,*felem,*size,actsize,(char *)bufadr);
 
230
 
 
231
return 0;
 
232
}
 
233
 
 
234
 
 
235
/*==========================================================================*/
 
236
 
 
237
/*** stat = SCFPUT(no,felem,size,bufadr) ***/
 
238
 
 
239
ROUTINE STFPUT(no,felem,size,bufadr,status)
 
240
int *no;                /* IN : file no. of data frame */
 
241
int *felem;             /* IN : 1st pixel to be accessed in data space */
 
242
int *size;              /* IN : number of data values (pixels) to be written  */
 
243
long int *bufadr;               /* IN: address of data buffer  */
 
244
int *status;
 
245
 
 
246
{
 
247
*status = SCFPUT(*no,*felem,*size,(char *)bufadr);
 
248
 
 
249
return 0;
 
250
}
 
251
 
 
252
 
 
253
/*==========================================================================*/
 
254
 
 
255
/*** stat = SCFINF(name,fno,ibuf) ***/
 
256
 
 
257
ROUTINE STF7(fno,ibuf,status)
 
258
int *fno;       /* IN: specify desired info,*/
 
259
                /*     0 = FCT_number   */
 
260
                /*     1 = version_no.,file_type,FCB.SWPSHORT */
 
261
                /*         FCB.SWPLONG,FCB.FLOTFMT */
 
262
                /*      2 = nobyte,format,pixpbl,stblok,lastblk */
 
263
                /*      3 = FCB.PTRLDB,LEXBDF,PEXBDF,ENDLDB, */
 
264
                /*      INDLDB,DBEGIN,DFILLED,DSIZE */
 
265
                /*      99 = just check, if frame exists */
 
266
int *ibuf;      /* OUT: buffer with desired info  */
 
267
int *status;
 
268
 
 
269
{
 
270
ptr1 = strp_pntr(1);            /* get stripped string of "name" */
 
271
 
 
272
*status = SCFINF(ptr1,*fno,ibuf);
 
273
 
 
274
return 0;
 
275
}
 
276
 
 
277
 
 
278
/*==========================================================================*/
 
279
 
 
280
/*** stat = SCFNAM(no,name,namlen) ***/
 
281
 
 
282
ROUTINE STF8(no,namlen,status)
 
283
int *no;            /* IN : no. of data frame */
 
284
int *namlen;    /* IN: max. length of name */
 
285
int *status;
 
286
 
 
287
{
 
288
int  n;
 
289
 
 
290
 
 
291
ptr1 = loc_pntr(1,&mm);         /* get location of "name", available space */
 
292
 
 
293
*status = SCFNAME(*no,ptr1,*namlen);
 
294
 
 
295
n = (int) strlen(ptr1);
 
296
if ((n > 0) && (n < *namlen)) *(ptr1+n) = ' ';
 
297
 
 
298
return 0;
 
299
}
 
300
 
 
301
/*==========================================================================*/
 
302
 
 
303
/*** stat = SCFXMP(nopix,datform,pntr) ***/
 
304
 
 
305
ROUTINE STFXMP(nopix,datform,pntr,status)
 
306
int     *nopix;         /* IN: no. of pixels we need memory for */
 
307
int     *datform;       /* IN: data format of */
 
308
long int *pntr;         /* OUT: pointer to mapped data */
 
309
int     *status;
 
310
 
 
311
{
 
312
char *mypntr;
 
313
 
 
314
int  lowmadr;
 
315
long  int diff;
 
316
 
 
317
 
 
318
 
 
319
*status = SCFXMP(*nopix,*datform,&mypntr);
 
320
 
 
321
lowmadr = (int) IS_HIGH(mypntr);
 
322
diff = (long int) COMMON_INDEX(mypntr);
 
323
if (lowmadr == 1)
 
324
   *pntr = diff;
 
325
else
 
326
   *pntr = -diff;
 
327
 
 
328
return 0;
 
329
}
 
330
 
 
331
 
 
332
/*==========================================================================*/
 
333
 
 
334
/*** stat = SCFYMP(nopix,datform,imno,pntr) ***/
 
335
 
 
336
ROUTINE STFYMP(nopix,datform,imno,pntr,status)
 
337
int     *nopix;         /* IN: no. of pixels we need memory for */
 
338
int     *datform;       /* IN: data format of */
 
339
int     *imno;          /* OUT: file id */
 
340
long int *pntr;         /* OUT: pointer to mapped data */
 
341
int     *status;
 
342
 
 
343
{
 
344
char *mypntr;
 
345
 
 
346
int  lowmadr;
 
347
long  int diff;
 
348
 
 
349
*status = SCFYMP(*nopix,*datform,imno,&mypntr);
 
350
 
 
351
lowmadr = (int) IS_HIGH(mypntr);
 
352
diff = (long int) COMMON_INDEX(mypntr);
 
353
if (lowmadr == 1)
 
354
   *pntr = diff;
 
355
else
 
356
   *pntr = -diff;
 
357
 
 
358
return 0;
 
359
}
 
360
 
 
361
 
 
362