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

« back to all changes in this revision

Viewing changes to libsrc/st/middsca.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:
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2008 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
/*+++++++++++++++++++++ Module MIDDSCA +++++++++++++++++++++++++++++++++++++++
 
29
.LANGUAGE   C
 
30
.IDENTIFICATION  MIDDSCA.C
 
31
.AUTHOR   Klaus Banse           ESO - Garching
 
32
.COMMENTS
 
33
holds  INITDS, WDSCRI, WDSCRR, WDSCRC, RDSCRI, RDSCRR, RDSCRC,
 
34
       CLONEDS
 
35
.KEYWORDS MIDAs Descriptors
 
36
.ENVIRONMENT VMS and UNIX
 
37
.VERSION  [1.30]  861110: creation from FORTRAN version
 
38
.VERSION  [2.50]  910718: initialize some variables in the next_descr branch
 
39
 
 
40
 080521         last modif
 
41
 
 
42
------------------------------------------------------------------------*/
 
43
 
 
44
#include <fileexts.h>
 
45
 
 
46
#define   BIT_0   0x1
 
47
 
 
48
#define  READ         0
 
49
#define  WRITE        1
 
50
#define  READ_WRITE   2
 
51
#define  APPEND       3
 
52
 
 
53
void LDBinfo();
 
54
 
 
55
/*
 
56
 
 
57
*/
 
58
 
 
59
int MID_CLONEDS(fcbp,iochan,fctpntri)
 
60
 
 
61
/*++++++++++++++++++++++++++++++++++++++++++++++++++
 
62
.PURPOSE
 
63
clone the descr. blocks (LDBs) of imnoa to imnob
 
64
.ALGORITHM
 
65
use OSY_RVB, OSY_WVB
 
66
.RETURNS
 
67
status: I*4             return status
 
68
--------------------------------------------------*/
 
69
 
 
70
struct FCB_STRUCT  *fcbp;       /* IN: pointer to FCB of result frame */
 
71
int  iochan;                    /* IN: channel of frame */
 
72
struct FCT_STRUCT  *fctpntri;   /* IN: pointer to FCT of source data frame */
 
73
 
 
74
{
 
75
register int  nr, mr;
 
76
int  status, ichan;
 
77
int  count, firsty;
 
78
 
 
79
char  *cptr;
 
80
 
 
81
struct LDB_STRUCT  *ldbp;
 
82
 
 
83
struct FCB_STRUCT  *fcbpi;
 
84
 
 
85
 
 
86
 
 
87
status = cacheLDB(22,iochan,fcbp->PTRLDB,&ldbp);        /* create cache */
 
88
 
 
89
ichan = fctpntri->IOCHAN;
 
90
fcbpi = fctpntri->FZP;
 
91
 
 
92
fcbp->DIRENTRY = YENTRY_SIZE;     /* entry in descr. direc. = 100 chars */
 
93
fcbp->DIREXT = 6000;         /* one extension = 60 entries (6000 chars) */
 
94
 
 
95
fcbp->INLDB[0] = fcbpi->INLDB[0]; 
 
96
fcbp->INLDB[1] = fcbpi->INLDB[1]; 
 
97
fcbp->ENDLDB = fcbpi->ENDLDB; 
 
98
fcbp->ENDLDB_OFF = fcbpi->ENDLDB_OFF; 
 
99
fcbp->DSIZE = fcbpi->DSIZE;
 
100
fcbp->DFILLED = fcbpi->DFILLED;
 
101
 
 
102
cptr = (char *) ldbp;
 
103
nr = mr = fcbp->PTRLDB;
 
104
firsty = count = 0;
 
105
 
 
106
while (nr > 0)
 
107
   {
 
108
   status = OSY_RVB(ichan,cptr,LDB_SIZE,nr);
 
109
   if (status != ERR_NORMAL) goto end_of_it;
 
110
   nr = ldbp->NEXT;                             /* -> next source LDB */
 
111
 
 
112
   ldbp->BLKNUM = mr;
 
113
   status = OSY_WVB(iochan,cptr,LDB_SIZE,ldbp->BLKNUM);
 
114
   if (status != ERR_NORMAL) goto end_of_it;
 
115
   count ++;
 
116
   mr = nr;
 
117
   }
 
118
 
 
119
/*
 
120
printf("%d LDBs cloned\n",count);
 
121
*/
 
122
 
 
123
fcbp->CLONY = 1;                        /* descr. were cloned */
 
124
 
 
125
/* move 1st LDB into cache */
 
126
 
 
127
ldbp->BLKNUM = fcbp->PTRLDB;
 
128
status = OSY_RVB(iochan,cptr,LDB_SIZE,ldbp->BLKNUM);
 
129
status = cacheLDB(3,iochan,ldbp->BLKNUM,&ldbp);      /* write to disk */
 
130
if (status == ERR_NORMAL) return ERR_NORMAL;
 
131
 
 
132
 
 
133
end_of_it:
 
134
status = ERR_FRMNAC;
 
135
MID_ERROR("MIDAS","MID_CLONEDS:",status,0);
 
136
return (status);
 
137
}
 
138
 
 
139
/*
 
140
 
 
141
*/
 
142
 
 
143
int MID_INITDS(fcbp,iochan)
 
144
 
 
145
/*++++++++++++++++++++++++++++++++++++++++++++++++++
 
146
.PURPOSE
 
147
initialize the descr. directory + update the FCB accordingly
 
148
.ALGORITHM
 
149
set up the descr. directory exactly like any other descriptor
 
150
reserve already LDB's (= 12 blocks) for directory + standard descriptors
 
151
.RETURNS
 
152
status: I*4             return status
 
153
--------------------------------------------------*/
 
154
 
 
155
struct FCB_STRUCT  *fcbp;  /* IN: pointer to FCB of frame */
 
156
int  iochan;               /* IN: channel of frame */
 
157
 
 
158
{
 
159
int   kldb, nn, dscdsiz;
 
160
int   n, mm, status;
 
161
register int  nr;
 
162
 
 
163
char   *cpntrb, *dscpntr;
 
164
 
 
165
struct LDB_STRUCT  *ldbp;
 
166
 
 
167
 
 
168
 
 
169
status = cacheLDB(22,iochan,fcbp->PTRLDB,&ldbp);        /* create cache */
 
170
 
 
171
dscdsiz = fcbp->DBEGIN; 
 
172
kldb = fcbp->INLDB[0];          /* no. of LDBs needed for dscdir  */
 
173
mm = (kldb * LDB_DATA); /* size in bytes */
 
174
n = mm - dscdsiz;               /* space left in `kldb' LDBs  */
 
175
nn = (kldb << 2) - 2;           /* (*4 - 2), so blockno.s like 2, 6, 10, 14 */
 
176
 
 
177
 
 
178
/*  set up endpointers to include already 1. entry of descr. directory */
 
179
 
 
180
if (n > 0)
 
181
   {
 
182
   fcbp->ENDLDB = nn;           /* dscdir fits with extra space */
 
183
   mm -= LDB_DATA;                      /* no_bytes in full first blocks */
 
184
   n = (dscdsiz - mm) / II_SIZE;        /* move to 4-byte  words  */
 
185
   fcbp->ENDLDB_OFF = n + 1;            /* offset is in 4-byte words ...  */
 
186
   }
 
187
else
 
188
   {
 
189
   fcbp->ENDLDB = nn + 4;               /* dscdir fits with no extra space */
 
190
   fcbp->ENDLDB_OFF = 1;
 
191
   }
 
192
 
 
193
fcbp->DSIZE = dscdsiz - 12;             /* just drop the 12 byte header stuff */
 
194
 
 
195
 
 
196
/*  calculate initial no. of LDBs and initialize them  */
 
197
 
 
198
ldbp->LDBWORDS.IWORD[0] = fcbp->DSIZE;
 
199
ldbp->LDBWORDS.IWORD[1] = -1;   /* indicate that it's contiguous */
 
200
ldbp->LDBWORDS.IWORD[2] = 0;    /* no index into extension block, yet */
 
201
        
 
202
fcbp->CLONY = 0;                        /* descr. are created from scratch */
 
203
 
 
204
 
 
205
/* handle decriptor directory entries */
 
206
 
 
207
fcbp->DIRENTRY = YENTRY_SIZE;     /* entry in descr. direc. = 100 chars */
 
208
fcbp->DIREXT = 6000;            /* one extension = 60 entries (6000 chars) */
 
209
 
 
210
YDSC_PNTR->NAMELEN = 
 
211
        (short int) CGN_COPY(YDSC_PNTR->NAMESTR,"DESCRIPTOR.DIRECTORY");
 
212
YDSC_PNTR->TYPE = 'C';                          /* type of descr. */
 
213
YDSC_PNTR->HELPLEN = (short int) 0;                     /* no help text */
 
214
YDSC_PNTR->UNIT = (short int) 0;
 
215
YDSC_PNTR->BYTELEM = (short int) 1;
 
216
YDSC_PNTR->NOELEM =  fcbp->DSIZE;
 
217
YDSC_PNTR->START = fcbp->PTRLDB;          /* start in 1. LDB (block 2) */
 
218
YDSC_PNTR->INDEX = 1;                   /* in first data word  */
 
219
dscpntr = (char *) &YDSCDIR_ENTRY;
 
220
nn = fcbp->DIRENTRY;
 
221
 
 
222
fcbp->DFILLED = nn;                     /* first entry used for direc. itself */
 
223
 
 
224
cpntrb = (char *) &ldbp->LDBWORDS;
 
225
cpntrb += (3*II_SIZE);          /* skip 3 integers (= LDB.LDBWORDS.CWORD[12]) */
 
226
CGN_COPYALL(cpntrb,dscpntr,nn);           /* put chardata into word 4,5,6,... */
 
227
 
 
228
 
 
229
/*  
 
230
already reserve + link the first LDBs together from no. 2 on 
 
231
remember, 4 blocks form an LDB and block 1 = FCB
 
232
the descr directory is included
 
233
*/
 
234
 
 
235
nn = fcbp->INLDB[0] + fcbp->INLDB[1];           /* total no. of inital LDBs */
 
236
 
 
237
ldbp->BLKNUM = fcbp->PTRLDB;
 
238
for (nr=1; nr<nn; nr++)
 
239
   {
 
240
   ldbp->NEXT = ldbp->BLKNUM + 4;
 
241
   status = cacheLDB(3,iochan,ldbp->BLKNUM,&ldbp);      /* write to disk */
 
242
   if (status != ERR_NORMAL) goto end_of_it;
 
243
   ldbp->BLKNUM = ldbp->NEXT;                   /* chain LDBs */
 
244
   }
 
245
 
 
246
ldbp->NEXT = 0;                                 /* mark end of LDB list  */
 
247
status = cacheLDB(3,iochan,ldbp->BLKNUM,&ldbp); /* write last LDB to disk */
 
248
if (status == ERR_NORMAL) 
 
249
   return (status);                              /*  that's it folks... */
 
250
 
 
251
 
 
252
/*  store error codes  */
 
253
 
 
254
end_of_it:
 
255
status = ERR_FRMNAC;
 
256
MID_ERROR("MIDAS","MID_INITDS:",status,0);
 
257
return (status);
 
258
}
 
259
 
 
260
/*
 
261
 
 
262
*/
 
263
 
 
264
int MID_RDSCRC(iochan,start_block,start_indx,first,total,cvals,nullo)
 
265
 
 
266
/*++++++++++++++++++++++++++++++++++++++++++++++++++
 
267
.PURPOSE
 
268
read the contents of a descriptor and its extensions as 
 
269
integer/real/character data
 
270
.ALGORITHM
 
271
The values of a descriptor are returned as integer/real/char. data.
 
272
No more than MAXVAL values will be returned, but ACTVAL will
 
273
be set to the actual no. of values associated with the
 
274
descriptor, starting from the position which is specified as 1. element
 
275
.RETURNS 
 
276
nothing
 
277
--------------------------------------------------*/
 
278
 
 
279
int    iochan           /* IN : channel of frame */;
 
280
int   start_block       /* IN : start block no. of descriptor */;
 
281
int   start_indx        /* IN : start index in that block */;
 
282
int   first             /* IN : position of 1. element to be accessed */;
 
283
int   total             /* IN : no. of values to return */;
 
284
char   *cvals           /* OUT: array to hold descriptor data */;
 
285
int   *nullo            /* IO : no. of null values in data */;
 
286
  
 
287
{
 
288
int   bldb, ildb, extens[2];
 
289
int   off, begin, end, tval, rval;
 
290
int   status;
 
291
 
 
292
char    *cpntra;
 
293
 
 
294
struct LDB_STRUCT  *ldbp;
 
295
 
 
296
 
 
297
 
 
298
 
 
299
/*  set up pointers:
 
300
                 begin, end   point to begin + end of descr. data
 
301
                 off          points to offset within descr. data  */
 
302
  
 
303
end = 0;
 
304
bldb = start_block;
 
305
ildb = start_indx;
 
306
 
 
307
status = cacheLDB(1,iochan,bldb,&ldbp);         /* get starting LDB in */
 
308
 
 
309
 
 
310
/*  1. loop - look for start descriptor element  */
 
311
        
 
312
loop_1:
 
313
LDBinfo(iochan,ldbp,ildb,&rval,extens);
 
314
 
 
315
begin = end + 1;                                /* keep start index */
 
316
end += rval;                                    /* update end */
 
317
        
 
318
if (first > end) 
 
319
   {
 
320
   bldb = extens[0];
 
321
   ildb = extens[1] - 1;                   /* indices are counted in FORTRAN */
 
322
   if (bldb != ldbp->BLKNUM) 
 
323
      status = cacheLDB(1,iochan,bldb,&ldbp);
 
324
   goto loop_1;
 
325
   }
 
326
 
 
327
 
 
328
/*  2. loop - fill data with descriptor data  */
 
329
        
 
330
tval = 0;
 
331
off = first - begin + 1;
 
332
cpntra = cvals;
 
333
 
 
334
/*
 
335
nulflag = *nullo;               /. save null flag, -1 means do not check...  ./
 
336
 
 
337
                                   feature not implemented yet 
 
338
if (nulflag >= 0)
 
339
   {
 
340
   register char  *kpntr;
 
341
   register int  nr;
 
342
 
 
343
   while (tval < total)
 
344
      {
 
345
      if (bldb != ldbp->BLKNUM) 
 
346
         status = cacheLDB(1,iochan,bldb,&ldbp);
 
347
   
 
348
      rval = total - tval;
 
349
      (void) MID_RDcLDB(iochan,ldbp,ildb,cpntra,off,&rval,extens);
 
350
 
 
351
      kpntr = cpntra;                   /. handle NULL checks ./
 
352
      for (nr=0; nr<rval; nr++)
 
353
         {
 
354
         if (*kpntr++ == NUL_CVAL) (*nullo) ++;
 
355
         }
 
356
 
 
357
      tval += rval;
 
358
      cpntra += rval;                   /. update pointers  ./
 
359
      bldb = extens[0];
 
360
      ildb = extens[1] - 1;
 
361
      off = 1;
 
362
      } 
 
363
   } 
 
364
 
 
365
else
 
366
   {
 
367
*/
 
368
 
 
369
   while (tval < total)
 
370
      {
 
371
      if (bldb != ldbp->BLKNUM)
 
372
         status = cacheLDB(1,iochan,bldb,&ldbp);
 
373
 
 
374
      rval = total - tval;
 
375
      (void) MID_RDcLDB(iochan,ldbp,ildb,cpntra,off,&rval,extens);
 
376
 
 
377
      tval += rval;
 
378
      cpntra += rval;                   /* update pointers  */
 
379
      bldb = extens[0];
 
380
      ildb = extens[1] - 1;
 
381
      off = 1;
 
382
      } 
 
383
/*
 
384
   } 
 
385
*/
 
386
 
 
387
*nullo = 0;
 
388
return 0;
 
389
}
 
390
 
 
391
/*
 
392
 
 
393
*/
 
394
 
 
395
int MID_RDSCRI(iochan,start_block,start_indx,first,total,ivals,nullo)
 
396
 
 
397
/*++++++++++++++++++++++++++++++++++++++++++++++++++
 
398
.PURPOSE
 
399
read the contents of a descriptor and its extensions as
 
400
integer/real/character data
 
401
.ALGORITHM
 
402
The values of a descriptor are returned as integer/real/char. data.
 
403
No more than MAXVAL values will be returned, but ACTVAL will
 
404
be set to the actual no. of values associated with the
 
405
descriptor, starting from the position which is specified as   1. element
 
406
.RETURNS 
 
407
nothing
 
408
--------------------------------------------------*/
 
409
 
 
410
int   iochan            /* IN : channel of frame */;
 
411
int   start_block       /* IN : start bldb no. of descriptor */;
 
412
int   start_indx        /* IN : start index in that bldb */;
 
413
int   first             /* IN : position of 1. element to be accessed */;
 
414
int   total             /* IN : no. of values to return */;
 
415
int   *ivals            /* OUT: array to hold descriptor data */;
 
416
int   *nullo            /* IO : no. of null values in data */;
 
417
 
 
418
{
 
419
int   bldb, ildb, extens[2];
 
420
int   off, begin, end, tval, rval;
 
421
int   status;
 
422
int   *ipntr;
 
423
 
 
424
float   rdummy;
 
425
 
 
426
struct LDB_STRUCT  *ldbp;
 
427
 
 
428
 
 
429
 
 
430
 
 
431
/*  set up pointers:
 
432
                 begin, end   point to begin + end of descr. data
 
433
                 off          points to offset within descr. data  */
 
434
  
 
435
end = 0;
 
436
bldb = start_block;
 
437
ildb = start_indx;
 
438
 
 
439
status = cacheLDB(1,iochan,bldb,&ldbp);
 
440
 
 
441
 
 
442
/*  1. loop - look for start descriptor element  */
 
443
        
 
444
loop_1:
 
445
LDBinfo(iochan,ldbp,ildb,&rval,extens);
 
446
 
 
447
begin = end + 1;                                /* keep start index */
 
448
end += rval;                                    /* update end */
 
449
        
 
450
if (first > end) 
 
451
   {
 
452
   bldb = extens[0];
 
453
   ildb = extens[1] - 1;                   /* indices are counted in FORTRAN */
 
454
   if (bldb != ldbp->BLKNUM) 
 
455
      status = cacheLDB(1,iochan,bldb,&ldbp);
 
456
   goto loop_1;
 
457
   }
 
458
 
 
459
 
 
460
/*  2. loop - fill data with descriptor data  */
 
461
        
 
462
tval = 0;
 
463
off = first - begin + 1;
 
464
ipntr = ivals;
 
465
 
 
466
/*
 
467
nulflag = *nullo;               /. save null flag, -1 means do not check...  ./
 
468
 
 
469
                                   feature not implemented yet 
 
470
if (nulflag >= 0)
 
471
   {
 
472
   register int nr;
 
473
   register int *hpntr;
 
474
 
 
475
   while (tval < total)
 
476
      {
 
477
      if (bldb != ldbp->BLKNUM)
 
478
         status = cacheLDB(1,iochan,bldb,&ldbp);
 
479
 
 
480
      rval = total - tval;
 
481
      (void) MID_RDLDB(iochan,ldbp,ildb,1,ipntr,&rdummy,off,
 
482
                       &rval,extens);
 
483
 
 
484
      hpntr = ipntr;
 
485
      for (nr=0; nr<rval; nr++)
 
486
         {
 
487
         if (*hpntr++ == NUL_IVAL) (*nullo) ++;
 
488
         }
 
489
 
 
490
      tval += rval;
 
491
      ipntr += rval;                       /. update pointers  ./
 
492
      bldb = extens[0];
 
493
      ildb = extens[1] - 1;
 
494
      off = 1;
 
495
      }
 
496
   }
 
497
 
 
498
else
 
499
   {
 
500
*/
 
501
 
 
502
  loop2:
 
503
   if (bldb != ldbp->BLKNUM) status = cacheLDB(1,iochan,bldb,&ldbp);
 
504
 
 
505
   rval = total - tval;
 
506
   (void) MID_RDLDB(iochan,ldbp,ildb,1,ipntr,&rdummy,off,
 
507
                    &rval,extens);
 
508
 
 
509
   tval += rval;
 
510
   if (tval < total)
 
511
      {
 
512
      ipntr += rval;                    /* update pointers  */
 
513
      bldb = extens[0];
 
514
      ildb = extens[1] - 1;
 
515
      off = 1;
 
516
      goto loop2;
 
517
      } 
 
518
/*
 
519
   } 
 
520
*/
 
521
 
 
522
*nullo = 0;
 
523
return 0;
 
524
}
 
525
 
 
526
/*
 
527
 
 
528
*/
 
529
 
 
530
int MID_RDSCRR(iochan,start_block,start_indx,first,total,rvals,nullo)
 
531
 
 
532
/*++++++++++++++++++++++++++++++++++++++++++++++++++
 
533
.PURPOSE
 
534
read the contents of a descriptor and its extensions as
 
535
integer/real/character data
 
536
.ALGORITHM
 
537
The values of a descriptor are returned as integer/real/char. data.
 
538
No more than MAXVAL values will be returned, but ACTVAL will
 
539
be set to the actual no. of values associated with the
 
540
descriptor, starting from the position which is specified as   1. element
 
541
.RETURNS 
 
542
nothing
 
543
--------------------------------------------------*/
 
544
 
 
545
int   iochan            /* IN : channel of frame */;
 
546
int   start_block       /* IN : start bldb no. of descriptor */;
 
547
int   start_indx        /* IN : start index in that bldb */;
 
548
int   first             /* IN : position of 1. element to be accessed */;
 
549
int   total             /* IN : no. of values to return */;
 
550
float  *rvals           /* OUT: array to hold descriptor data */;
 
551
int   *nullo            /* IO : no. of null values in data */;
 
552
  
 
553
{
 
554
int   bldb, ildb, extens[2];
 
555
int   off, begin, end, tval, rval;
 
556
int   status, idummy;
 
557
 
 
558
float   *rpntr;
 
559
 
 
560
struct LDB_STRUCT  *ldbp;
 
561
 
 
562
 
 
563
 
 
564
 
 
565
/*  set up pointers:
 
566
                 begin, end   point to begin + end of descr. data
 
567
                 off          points to offset within descr. data  */
 
568
  
 
569
end = 0;
 
570
bldb = start_block;
 
571
ildb = start_indx;
 
572
 
 
573
status = cacheLDB(1,iochan,bldb,&ldbp);
 
574
 
 
575
 
 
576
/*  1. loop - look for start descriptor element  */
 
577
        
 
578
loop_1:
 
579
LDBinfo(iochan,ldbp,ildb,&rval,extens);
 
580
 
 
581
begin = end + 1;                                /* keep start index */
 
582
end += rval;                            /* update end */
 
583
        
 
584
if (first > end) 
 
585
   {
 
586
   bldb = extens[0];
 
587
   ildb = extens[1] - 1;                    /* indices are counted in FORTRAN */
 
588
   if (bldb != ldbp->BLKNUM) 
 
589
      status = cacheLDB(1,iochan,bldb,&ldbp);
 
590
   goto loop_1;
 
591
   }
 
592
 
 
593
 
 
594
/*  2. loop - fill data with descriptor data  */
 
595
        
 
596
tval = 0;
 
597
off = first - begin + 1;
 
598
rpntr = rvals;
 
599
 
 
600
/*
 
601
nulflag = *nullo;               /. save null flag, -1 means do not check...  ./
 
602
 
 
603
                                   feature not implemented yet 
 
604
if (nulflag >= 0)
 
605
   {
 
606
   register int nr;
 
607
   register float *fpntr;
 
608
 
 
609
   while (tval < total)
 
610
      {
 
611
      if (bldb != ldbp->BLKNUM)
 
612
         status = cacheLDB(1,iochan,bldb,&ldbp);
 
613
 
 
614
      rval = total - tval;
 
615
      (void) MID_RDLDB(iochan,ldbp,ildb,2,&idummy,rpntr,
 
616
                       off,&rval,extens);
 
617
 
 
618
      fpntr = rpntr;
 
619
      for (nr=0; nr<rval; nr++)
 
620
         {
 
621
         if (*fpntr++ == NUL_RVAL) (*nullo) ++;
 
622
         }
 
623
 
 
624
      tval += rval;
 
625
      rpntr += rval;                       /. update pointers  ./
 
626
      bldb = extens[0];
 
627
      ildb = extens[1] - 1;
 
628
      off = 1;
 
629
      }
 
630
   }
 
631
 
 
632
else
 
633
   {
 
634
*/
 
635
 
 
636
  loop2:
 
637
   if (bldb != ldbp->BLKNUM) status = cacheLDB(1,iochan,bldb,&ldbp);
 
638
 
 
639
   rval = total - tval;
 
640
   (void) MID_RDLDB(iochan,ldbp,ildb,2,&idummy,rpntr,off,
 
641
                    &rval,extens);
 
642
 
 
643
   tval += rval;
 
644
   if (tval < total)
 
645
      {
 
646
      rpntr += rval;                    /* update pointers  */
 
647
      bldb = extens[0];
 
648
      ildb = extens[1] - 1;
 
649
      off = 1;
 
650
      goto loop2;
 
651
      } 
 
652
/*
 
653
   } 
 
654
*/
 
655
 
 
656
*nullo = 0;
 
657
return 0;
 
658
}
 
659
 
 
660
/*
 
661
 
 
662
*/
 
663
 
 
664
int MID_WDSCRI(iochan,start_block,start_indx,ivals,conflg,first,nval)
 
665
 
 
666
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
667
.PURPOSE
 
668
Write a descriptor + its values as integer/real/character data
 
669
to the LDB.
 
670
.ALGORITHM
 
671
Descriptor data is written into atoms which are already created -
 
672
so no checks for overflow are necessary.
 
673
.RETURNS 
 
674
nothing
 
675
------------------------------------------------------------------*/
 
676
 
 
677
int   iochan            /* IN : channel no of frame */;
 
678
int   start_block       /* IN : start LDB no */;
 
679
int   start_indx        /* IN : starting index in bldb */;
 
680
int   *ivals            /* IN : integer descriptor data */;
 
681
int   conflg            /* IN : constant flag = 1/0 (Yes/No) */;
 
682
int   first             /* IN : pos. of 1st desc. value to be accessed \
 
683
                                if 1st = -1, desc. values are appended \
 
684
                                to existing ones */;
 
685
int   nval              /* IN : no. of data values */;
 
686
 
 
687
{
 
688
int   *ipntr;
 
689
int   bldb, ildb, extens[2];
 
690
int   off, begin, end, tval, rval;
 
691
int   status;
 
692
 
 
693
char  cdummy[4];
 
694
 
 
695
float   rdummy;
 
696
 
 
697
struct LDB_STRUCT  *ldbp;
 
698
 
 
699
 
 
700
 
 
701
 
 
702
/*  get starting LDB  */
 
703
 
 
704
bldb = start_block;
 
705
ildb = start_indx;
 
706
end = 0;
 
707
 
 
708
status = cacheLDB(1,iochan,bldb,&ldbp);
 
709
 
 
710
 
 
711
/*  1. loop - look for start descriptor element  */
 
712
        
 
713
loop_1:
 
714
LDBinfo(iochan,ldbp,ildb,&rval,extens);
 
715
 
 
716
begin = end + 1;                                /* keep start index */
 
717
end += rval;                                    /* update end */
 
718
        
 
719
if (first > end) 
 
720
   {
 
721
   bldb = extens[0];
 
722
   ildb = extens[1] - 1;                   /* indices are counted in FORTRAN */
 
723
   if (bldb != ldbp->BLKNUM) 
 
724
      status = cacheLDB(1,iochan,bldb,&ldbp);
 
725
   goto loop_1;
 
726
   }
 
727
 
 
728
 
 
729
/*  2. loop - fill descriptor data  */
 
730
        
 
731
tval = 0;
 
732
off = first - begin + 1;
 
733
ipntr = ivals;
 
734
 
 
735
loop2:
 
736
if (bldb != ldbp->BLKNUM) status = cacheLDB(1,iochan,bldb,&ldbp);
 
737
 
 
738
rval = nval - tval;
 
739
(void) MID_WRLDB(iochan,ldbp,ildb,1,ipntr,&rdummy,cdummy,
 
740
                 conflg,off,&rval,extens);
 
741
 
 
742
tval += rval;
 
743
if (tval < nval)
 
744
   {
 
745
   if (conflg == 0) ipntr += rval;              /* update pointer */
 
746
   bldb = extens[0];
 
747
   ildb = extens[1] - 1;
 
748
   off = 1;
 
749
   goto loop2;
 
750
   } 
 
751
 
 
752
return 0;
 
753
}
 
754
 
 
755
/*
 
756
 
 
757
*/
 
758
 
 
759
int MID_WDSCRR(iochan,start_block,start_indx,rvals,conflg,first,nval)
 
760
 
 
761
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
762
.PURPOSE
 
763
  Write a descriptor + its values as integer/real/character data
 
764
  to the LDB.
 
765
.ALGORITHM
 
766
  Descriptor data is written into atoms which are already created -
 
767
 so no checks for overflow are necessary.
 
768
.RETURNS 
 
769
nothing
 
770
--------------------------------------------------------------------------*/
 
771
 
 
772
int   iochan            /* IN : channel no of frame */;
 
773
int   start_block       /* IN : start LDB no */;
 
774
int   start_indx        /* IN : starting index in bldb */;
 
775
float  *rvals           /* IN : real descriptor data */;
 
776
int   conflg            /* IN : constant flag = 1/0 (Yes/No) */;
 
777
int   first             /* IN : pos. of 1st desc. value to be accessed \
 
778
                                if 1st = -1, desc. values are appended \
 
779
                                to existing ones */;
 
780
int   nval              /* IN : no. of data values */;
 
781
 
 
782
{
 
783
int   bldb, ildb, extens[2];
 
784
int   off, begin, end, tval, rval;
 
785
int   status, idummy;
 
786
 
 
787
char  cdummy[4];
 
788
 
 
789
float  *rpntr;
 
790
 
 
791
struct LDB_STRUCT  *ldbp;
 
792
 
 
793
 
 
794
 
 
795
 
 
796
bldb = start_block;                             /*  get starting LDB  */
 
797
ildb = start_indx;
 
798
end = 0;
 
799
 
 
800
status = cacheLDB(1,iochan,bldb,&ldbp);
 
801
 
 
802
 
 
803
/*  1. loop - look for start descriptor element  */
 
804
        
 
805
loop_1:
 
806
LDBinfo(iochan,ldbp,ildb,&rval,extens);
 
807
 
 
808
begin = end + 1;                                /* keep start index */
 
809
end += rval;                                    /* update end */
 
810
        
 
811
if (first > end) 
 
812
   {
 
813
   bldb = extens[0];
 
814
   ildb = extens[1] - 1;                   /* indices are counted in FORTRAN */
 
815
   if (bldb != ldbp->BLKNUM) 
 
816
      status = cacheLDB(1,iochan,bldb,&ldbp);
 
817
   goto loop_1;
 
818
   }
 
819
 
 
820
 
 
821
/*  2. loop - fill descriptor data  */
 
822
        
 
823
tval = 0;
 
824
off = first - begin + 1;
 
825
rpntr = rvals;
 
826
 
 
827
loop2:
 
828
if (bldb != ldbp->BLKNUM) status = cacheLDB(1,iochan,bldb,&ldbp);
 
829
 
 
830
rval = nval - tval;
 
831
(void) MID_WRLDB(iochan,ldbp,ildb,2,&idummy,rpntr,cdummy,
 
832
                 conflg,off,&rval,extens);
 
833
 
 
834
tval += rval;
 
835
if (tval < nval)
 
836
   {
 
837
   if (conflg == 0) rpntr += rval;              /* update pointer */
 
838
   bldb = extens[0];
 
839
   ildb = extens[1] - 1;
 
840
   off = 1;
 
841
   goto loop2;
 
842
   } 
 
843
 
 
844
return 0;
 
845
}
 
846
 
 
847
/*
 
848
 
 
849
*/
 
850
 
 
851
int MID_WDSCRC(iochan,start_block,start_indx,cvals,conflg,first,nval)
 
852
 
 
853
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
854
.PURPOSE
 
855
  Write a descriptor + its values as integer/real/character data
 
856
  to the LDB.
 
857
.ALGORITHM
 
858
  Descriptor data is written into atoms which are already created -
 
859
 so no checks for overflow are necessary.
 
860
.RETURNS 
 
861
nothing
 
862
-------------------------------------------------------------------*/
 
863
 
 
864
int   iochan            /* IN : channel no of frame */;
 
865
int   start_block       /* IN : start LDB no */;
 
866
int   start_indx        /* IN : starting index in bldb */;
 
867
char   *cvals           /* IN : character descriptor data */;
 
868
int   conflg            /* IN : constant flag = 1/0 (Yes/No) */;
 
869
int   first             /* IN : pos. of 1st desc. value to be accessed \
 
870
                                if 1st = -1, desc. values are appended \
 
871
                                to existing ones */;
 
872
int   nval              /* IN : no. of data values */;
 
873
 
 
874
{
 
875
int   bldb, ildb, extens[2];
 
876
int   off, begin, end, tval, rval;
 
877
int   status, idummy;
 
878
 
 
879
char   *cpntra;
 
880
 
 
881
float   rdummy;
 
882
 
 
883
struct LDB_STRUCT  *ldbp;
 
884
 
 
885
 
 
886
 
 
887
 
 
888
/*  get starting LDB  */
 
889
 
 
890
bldb = start_block;
 
891
ildb = start_indx;
 
892
end = 0;
 
893
 
 
894
status = cacheLDB(1,iochan,bldb,&ldbp);
 
895
 
 
896
 
 
897
/*  1. loop - look for start descriptor element  */
 
898
        
 
899
loop_1:
 
900
LDBinfo(iochan,ldbp,ildb,&rval,extens);
 
901
 
 
902
begin = end + 1;                                /* keep start index */
 
903
end += rval;                                    /* update end */
 
904
        
 
905
if (first > end) 
 
906
   {
 
907
   bldb = extens[0];
 
908
   ildb = extens[1] - 1;                   /* indices are counted in FORTRAN */
 
909
   if (bldb != ldbp->BLKNUM) 
 
910
      status = cacheLDB(1,iochan,bldb,&ldbp);
 
911
   goto loop_1;
 
912
   }
 
913
 
 
914
 
 
915
/*  2. loop - fill descriptor data  */
 
916
        
 
917
tval = 0;
 
918
off = first - begin + 1;
 
919
cpntra = cvals;
 
920
 
 
921
loop2:
 
922
if (bldb != ldbp->BLKNUM) status = cacheLDB(1,iochan,bldb,&ldbp);
 
923
 
 
924
rval = nval - tval;
 
925
(void) MID_WRLDB(iochan,ldbp,ildb,3,&idummy,&rdummy,cpntra,
 
926
                 conflg,off,&rval,extens);
 
927
 
 
928
tval += rval;
 
929
if (tval < nval)
 
930
   {
 
931
   if (conflg == 0) cpntra += rval;             /* update pointer */
 
932
   bldb = extens[0];
 
933
   ildb = extens[1] - 1;
 
934
   off = 1;
 
935
   goto loop2;
 
936
   } 
 
937
 
 
938
return 0;
 
939
}