1 /* dasa2l.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static integer c__1 = 1;
11 static integer c__256 = 256;
12 static integer c__2 = 2;
13
14 /* $Procedure DASA2L ( DAS, address to physical location ) */
dasa2l_(integer * handle,integer * type__,integer * addrss,integer * clbase,integer * clsize,integer * recno,integer * wordno)15 /* Subroutine */ int dasa2l_(integer *handle, integer *type__, integer *
16 addrss, integer *clbase, integer *clsize, integer *recno, integer *
17 wordno)
18 {
19 /* Initialized data */
20
21 static integer next[3] = { 2,3,1 };
22 static logical prvok = FALSE_;
23 static integer tbbase[60] /* was [3][20] */ = { -1,-1,-1,-1,-1,-1,-1,-1,
24 -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
25 -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
26 -1,-1,-1,-1,-1,-1,-1,-1 };
27 static logical tbfast[20] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
28 FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
29 FALSE_,FALSE_,FALSE_,FALSE_,FALSE_ };
30 static integer tbfwrd[20] = { -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
31 -1,-1,-1,-1,-1,-1 };
32 static integer tbhan[20] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
33 static integer tbmxad[60] /* was [3][20] */ = { -1,-1,-1,-1,-1,-1,-1,-1,
34 -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
35 -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
36 -1,-1,-1,-1,-1,-1,-1,-1 };
37 static logical tbrdon[20] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
38 FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
39 FALSE_,FALSE_,FALSE_,FALSE_,FALSE_ };
40 static integer tbsize[60] /* was [3][20] */ = { -1,-1,-1,-1,-1,-1,-1,-1,
41 -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
42 -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
43 -1,-1,-1,-1,-1,-1,-1,-1 };
44 static integer prev[3] = { 3,1,2 };
45 static integer nw[3] = { 1024,128,256 };
46 static integer rngloc[3] = { 3,5,7 };
47 static logical fast = FALSE_;
48 static integer fidx = 0;
49 static logical known = FALSE_;
50 static integer nfiles = 0;
51 static integer prvhan = 0;
52
53 /* System generated locals */
54 integer i__1, i__2, i__3;
55
56 /* Builtin functions */
57 integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
58 ftnlen, ftnlen);
59
60 /* Local variables */
61 static integer free, nrec, i__, j, range[2];
62 extern /* Subroutine */ int chkin_(char *, ftnlen);
63 static integer ncomc;
64 static logical segok;
65 static integer ncomr, ndirs;
66 extern logical failed_(void);
67 static integer ub, hiaddr;
68 extern /* Subroutine */ int dasham_(integer *, char *, ftnlen);
69 static integer baserc;
70 static char access[10];
71 static integer dscloc, dirrec[256];
72 extern /* Subroutine */ int dashfs_(integer *, integer *, integer *,
73 integer *, integer *, integer *, integer *, integer *, integer *);
74 static logical samfil;
75 static integer mxaddr;
76 extern integer isrchi_(integer *, integer *, integer *);
77 static integer lstrec[3];
78 extern /* Subroutine */ int errhan_(char *, integer *, ftnlen), sigerr_(
79 char *, ftnlen);
80 static integer nresvc, nxtrec;
81 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
82 integer *, ftnlen), chkout_(char *, ftnlen), dasrri_(integer *,
83 integer *, integer *, integer *, integer *);
84 static integer lstwrd[3], nresvr, ntypes, curtyp, prvtyp;
85
86 /* $ Abstract */
87
88 /* Map a DAS address to a physical location in a specified DAS file. */
89
90 /* $ Disclaimer */
91
92 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
93 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
94 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
95 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
96 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
97 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
98 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
99 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
100 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
101 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
102
103 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
104 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
105 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
106 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
107 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
108 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
109
110 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
111 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
112 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
113 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
114
115 /* $ Required_Reading */
116
117 /* DAS */
118
119 /* $ Keywords */
120
121 /* DAS */
122 /* FILES */
123 /* TRANSFORMATION */
124 /* UTILITY */
125
126 /* $ Declarations */
127 /* $ Brief_I/O */
128
129 /* Variable I/O Description */
130 /* -------- --- -------------------------------------------------- */
131 /* HANDLE I DAS file handle. */
132 /* TYPE I Data type specifier. */
133 /* ADDRSS I DAS address of a word of data type TYPE. */
134 /* CLBASE, */
135 /* CLSIZE O Cluster base record number and size. */
136 /* RECNO, */
137 /* WORDNO O Record/word pair corresponding to ADDRSS. */
138 /* CHAR P Parameter indicating character data type. */
139 /* INT P Parameter indicating integer data type. */
140
141 /* $ Detailed_Input */
142
143 /* HANDLE is the file handle of an open DAS file. */
144
145 /* TYPE is a data type specifier. TYPE may be any of */
146 /* the parameters */
147
148 /* CHAR */
149 /* DP */
150 /* INT */
151
152 /* which indicate `character', `double precision', */
153 /* and `integer' respectively. */
154
155
156 /* ADDRSS is the address in a DAS of a word of data */
157 /* type TYPE. For each data type (double precision, */
158 /* integer, or character), addresses range */
159 /* from 1 to the maximum current value for that type, */
160 /* which is available from DAFRFR. */
161
162 /* $ Detailed_Output */
163
164 /* CLBASE, */
165 /* CLSIZE are, respectively, the base record number and */
166 /* size, in records, of the cluster containing the */
167 /* word corresponding to ADDRSS. The cluster spans */
168 /* records numbered CLBASE through CLBASE + */
169 /* CLSIZE - 1. */
170
171 /* RECNO, */
172 /* WORD are, respectively, the number of the physical */
173 /* record and the number of the word within the */
174 /* record that correspond to ADDRSS. Word numbers */
175 /* start at 1 and go up to NC, ND, or NI in */
176 /* character, double precision, or integer records */
177 /* respectively. */
178
179 /* $ Parameters */
180
181 /* CHAR, */
182 /* DP, */
183 /* INT are data type specifiers which indicate */
184 /* `character', `double precision', and `integer' */
185 /* respectively. These parameters are used in */
186 /* all DAS routines that require a data type */
187 /* specifier as input. */
188
189 /* $ Exceptions */
190
191 /* 1) If TYPE is not recognized, the error SPICE(DASINVALIDTYPE) */
192 /* will be signaled. */
193
194 /* 2) ADDRSS must be between 1 and LAST inclusive, where LAST */
195 /* is last address in the DAS for a word of the specified */
196 /* type. If ADDRSS is out of range, the error */
197 /* SPICE(DASNOSUCHADDRESS) will be signaled. */
198
199 /* 3) If this routine doesn't find an expected cluster descriptor */
200 /* in a directory record, the error SPICE(BADDASDIRECTORY) is */
201 /* signaled. */
202
203 /* 4) If the input handle is invalid, the error will be diagnosed */
204 /* by routines called by this routine. */
205
206 /* If any of the above exceptions occur, the output arguments may */
207 /* contain bogus information. */
208
209 /* $ Files */
210
211 /* See the description of the argument HANDLE in $Detailed_Input. */
212
213 /* $ Particulars */
214
215 /* The DAS architecture allows a programmer to think of the data */
216 /* within a DAS file as three one-dimensional arrays: one of */
217 /* double precision numbers, one of integers, and one of characters. */
218 /* This model allows a programmer to ask the DAS system for the */
219 /* `nth double precision number (or integer, or character) in the */
220 /* file'. */
221
222 /* DAS files are Fortran direct access files, so to find the */
223 /* `nth double precision number', you must have the number of the */
224 /* record containing it and the `word number', or position, within */
225 /* the record of the double precision number. This routine finds */
226 /* the record/word number pair that specify the physical location */
227 /* in a DAS file corresponding to a DAS address. */
228
229 /* As opposed to DAFs, the mapping of addresses to physical */
230 /* locations for a DAS file depends on the organization of data in */
231 /* the file. For example, given a fixed set of DAS file summary */
232 /* parameters, the physical location of the nth double precision */
233 /* number can depend on how many integer and character records have */
234 /* been written prior to the record containing that double precision */
235 /* number. */
236
237 /* The cluster information output from this routine allows the */
238 /* caller to substantially reduce the number of directory reads */
239 /* required to read a from range of addresses that spans */
240 /* multiple physical records; the reading program only need call */
241 /* this routine once per cluster read, rather than once per */
242 /* physical record read. */
243
244 /* $ Examples */
245
246 /* 1) Use this routine to read integers from a range of */
247 /* addresses. This is done in the routine DASRDI. */
248
249 /* C */
250 /* C Decide how many integers to read. */
251 /* C */
252 /* NUMINT = LAST - FIRST + 1 */
253 /* NREAD = 0 */
254
255 /* C */
256 /* C Find out the physical location of the first */
257 /* C integer. If FIRST is invalid, DASA2L will take care */
258 /* C of the problem. */
259 /* C */
260 /* CALL DASA2L ( HANDLE, INT, FIRST, */
261 /* . CLBASE, CLSIZE, RECNO, WORDNO ) */
262
263 /* C */
264 /* C Read as much data from record RECNO as necessary. */
265 /* C */
266 /* N = MIN ( NUMINT, NWI - WORDNO + 1 ) */
267
268 /* CALL DASRRI ( HANDLE, RECNO, WORDNO, WORDNO + N-1, */
269 /* . DATA ) */
270
271 /* NREAD = N */
272 /* RECNO = RECNO + 1 */
273
274 /* C */
275 /* C Read from as many additional records as necessary. */
276 /* C */
277 /* DO WHILE ( NREAD .LT. NUMINT ) */
278 /* C */
279 /* C At this point, RECNO if RECNO refers to */
280 /* C a record in the current cluster, RECNO */
281 /* C is the correct number of the record to read */
282 /* C from next. Otherwise, the next cluster of */
283 /* C records containing integer data must be located. */
284 /* C CLBASE is the number of the first record of */
285 /* C the cluster we're about to read from. */
286 /* C */
287 /* IF ( RECNO .LT. ( CLBASE + CLSIZE ) ) THEN */
288 /* C */
289 /* C We can continue reading from the current */
290 /* C cluster. */
291 /* C */
292 /* N = MIN ( NUMINT - NREAD, NWI ) */
293
294 /* CALL DASRRI ( HANDLE, */
295 /* . RECNO, */
296 /* . 1, */
297 /* . N, */
298 /* . DATA ( NREAD + 1 ) ) */
299
300 /* NREAD = NREAD + N */
301 /* RECNO = RECNO + 1 */
302
303
304 /* ELSE */
305 /* C */
306 /* C We must find the next integer cluster to */
307 /* C read from. The first integer in this */
308 /* C cluster has address FIRST + NREAD. */
309 /* C */
310 /* CALL DASA2L ( HANDLE, */
311 /* . INT, */
312 /* . FIRST + NREAD, */
313 /* . CLBASE, */
314 /* . CLSIZE, */
315 /* . RECNO, */
316 /* . WORDNO ) */
317
318 /* END IF */
319
320 /* END DO */
321
322
323 /* $ Restrictions */
324
325 /* None. */
326
327 /* $ Literature_References */
328
329 /* None. */
330
331 /* $ Author_and_Institution */
332
333 /* K.R. Gehringer (JPL) */
334 /* N.J. Bachman (JPL) */
335 /* W.L. Taber (JPL) */
336
337 /* $ Version */
338
339 /* - SPICELIB Version 3.0.0 FEB-09-2015 (NJB) */
340
341 /* Updated to use DAF/DAS handle manager subsystem. */
342
343 /* - SPICELIB Version 2.0.0 APR-15-2014 (NJB) */
344
345 /* Previous update was 25-FEB-2014 */
346
347 /* Bug fix: value of variable FAST for "unknown" files with one */
348 /* directory record is now stored in TBFAST. The routine */
349 /* previously computed correct outputs but did so more slowly */
350 /* than necessary when multiple "fast" files were accessed. */
351
352 /* Functional change: new entries in the file attribute table are */
353 /* now inserted at index 1; the existing part of the table is */
354 /* shifted to make room. Old entries drop off the end of the */
355 /* list. The previous algorithm simply overwrote the first entry */
356 /* once the table became full. */
357
358 /* The file attribute table was expanded to store values of a */
359 /* "read only" flag for each file. This enables the routine to */
360 /* avoid look up of maximum addresses for known, read-only, */
361 /* non-segregated files. */
362
363 /* Tests of FAILED and backup loop termination checks */
364 /* were added. Logic was introduced to prevent reliance on */
365 /* previous values of logical flags unless those flags were */
366 /* set on a successful call. On any call that fails, the */
367 /* table entry for the current file is marked as unused by */
368 /* setting the handle entry to zero. */
369
370 /* The state variables FIRST and RDONLY have been removed. */
371
372 /* Unneeded declarations were removed. */
373
374 /* The code was re-structured to improve clarity. */
375
376 /* - SPICELIB Version 1.2.1 20-NOV-2001 (NJB) */
377
378 /* Comment fix: diagram showing directory record pointers */
379 /* incorrectly showed element 2 of the record as a backward */
380 /* pointer. The element is actually a forward pointer. */
381
382 /* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */
383
384 /* Bug fix: calculation to determine whether file is segregated */
385 /* has been fixed. */
386
387 /* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
388
389 /* Corrected title of permuted index entry section. */
390
391 /* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */
392
393 /* Re-written to optimize address calculations for segregated, */
394 /* read-only files. */
395
396 /* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */
397
398 /* Fixed a typo in the $ Brief_I/O section of the header. */
399
400 /* Removed references to specific DAS file open routines in the */
401 /* $ Detailed_Input section of the header. This was done in order */
402 /* to minimize documentation changes if the DAS open routines ever */
403 /* change. */
404
405 /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
406
407 /* -& */
408 /* $ Index_Entries */
409
410 /* map DAS logical address to physical location */
411
412 /* -& */
413 /* $ Revisions */
414
415 /* - SPICELIB Version 1.2.0 03-JUL-1996 (NJB) */
416
417 /* Bug fix: calculation to determine whether file is segregated */
418 /* has been fixed. An incorrect variable name used in a bound */
419 /* calculation resulted in an incorrect determination of whether */
420 /* a file was segregated, and caused arithmetic overflow for */
421 /* files with large maximum addresses. */
422
423 /* In the previous version, the number of DAS words in a cluster */
424 /* was incorrectly calculated as the product of the maximum */
425 /* address of the cluster's data type and the number of words of */
426 /* that data type in a DAS record. The correct product involves */
427 /* the number of records in the cluster and the number of words of */
428 /* that data type in a DAS record. */
429
430 /* - SPICELIB Version 1.1.0, 03-NOV-1995 (NJB) */
431
432 /* Re-written to optimize address calculations for segregated, */
433 /* read-only files. */
434
435 /* - SPICELIB Version 1.0.1, 26-OCT-1993 (KRG) */
436
437 /* Fixed a typo in the $ Brief_I/O section of the header. */
438
439 /* Removed references to specific DAS file open routines in the */
440 /* $ Detailed_Input section of the header. This was done in order */
441 /* to minimize documentation changes if the DAS open routines ever */
442 /* change. */
443
444 /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
445
446 /* -& */
447
448 /* Programmer's note: the TSPICE routine P_DASA2L must be */
449 /* kept in sync with this routine. Current version of that */
450 /* routine is */
451
452 /* TSPICE Version 1.0.0 APR-11-2014 (NJB) */
453
454
455 /* SPICELIB functions */
456
457
458 /* Local parameters */
459
460
461 /* Words per data record, for each data type: */
462
463
464 /* Directory forward pointer location */
465
466
467 /* Directory address range locations */
468
469
470 /* Index of highest address in a `range array': */
471
472
473 /* Location of first type descriptor */
474
475
476 /* Access word length */
477
478
479 /* File table size */
480
481
482 /* Local variables */
483
484
485 /* Saved variables */
486
487
488 /* Initial values */
489
490
491 /* NEXT and PREV map the DAS data type codes to their */
492 /* successors and predecessors, respectively. */
493
494
495 /* Discovery check-in is used in this routine, even though */
496 /* this routine calls routines that can signal errors. This */
497 /* routine is a special case, because fast operation is very */
498 /* important. */
499
500
501 /* DAS files have the following general structure: */
502
503 /* +------------------------+ */
504 /* | file record | */
505 /* +------------------------+ */
506 /* | reserved records | */
507 /* | | */
508 /* +------------------------+ */
509 /* | comment records | */
510 /* | | */
511 /* | | */
512 /* | | */
513 /* +------------------------+ */
514 /* | first data directory | */
515 /* +------------------------+ */
516 /* | data records | */
517 /* | | */
518 /* | | */
519 /* | | */
520 /* | | */
521 /* +------------------------+ */
522 /* . */
523 /* . */
524 /* +------------------------+ */
525 /* | last data directory | */
526 /* +------------------------+ */
527 /* | data records | */
528 /* | | */
529 /* | | */
530 /* +------------------------+ */
531
532
533 /* Within each DAS data record, word numbers start at one and */
534 /* increase up to NWI, NWD, or NWC: the number of words in an */
535 /* integer, double precision, or character data record. */
536
537
538 /* +--------------------------------+ */
539 /* | | | ... | | */
540 /* +--------------------------------+ */
541 /* 1 2 NWD */
542
543 /* +--------------------------------+ */
544 /* | | | ... | | */
545 /* +--------------------------------+ */
546 /* 1 2 NWI */
547
548 /* +------------------------------------+ */
549 /* | | | ... | | */
550 /* +------------------------------------+ */
551 /* 1 2 NWC */
552
553
554 /* Directories are single records that describe the data */
555 /* types of data records that follow. The directories */
556 /* in a DAS file form a doubly linked list: each directory */
557 /* contains forward and backward pointers to the next and */
558 /* previous directories. */
559
560 /* Each directory also contains, for each data type, the lowest */
561 /* and highest logical address occurring in any of the records */
562 /* described by the directory. */
563
564 /* Following the pointers and address range information is */
565 /* a sequence of data type descriptors. These descriptors */
566 /* indicate the data type of data records following the */
567 /* directory record. Each descriptor gives the data type */
568 /* of a maximal set of contiguous data records, all having the */
569 /* same type. By `maximal set' we mean that no data records of */
570 /* the same type bound the set of records in question. */
571
572 /* Pictorially, the structure of a directory is as follows: */
573
574 /* +----------------------------------------------------+ */
575 /* | <pointers> | <address ranges> | <type descriptors> | */
576 /* +----------------------------------------------------+ */
577
578 /* where the <pointers> section looks like */
579
580 /* +-----------------------------------------+ */
581 /* | <backward pointer> | <forward pointer> | */
582 /* +-----------------------------------------+ */
583
584 /* the <address ranges> section looks like */
585
586 /* +-------------------------------------------+ */
587 /* | <char range> | <d.p. range> | <int range> | */
588 /* +-------------------------------------------+ */
589
590 /* and each range looks like one of: */
591
592 /* +------------------------------------------------+ */
593 /* | <lowest char address> | <highest char address> | */
594 /* +------------------------------------------------+ */
595
596 /* +------------------------------------------------+ */
597 /* | <lowest d.p. address> | <highest d.p. address> | */
598 /* +------------------------------------------------+ */
599
600 /* +------------------------------------------------+ */
601 /* | <lowest int address> | <highest int address> | */
602 /* +------------------------------------------------+ */
603
604 /* The type descriptors implement a run-length encoding */
605 /* scheme. The first element of the series of descriptors */
606 /* occupies two integers: it contains a type code and a count. */
607 /* The rest of the descriptors are just signed counts; the data */
608 /* types of the records they describe are deduced from the sign */
609 /* of the count and the data type of the previous descriptor. */
610 /* The method of finding the data type for a given descriptor */
611 /* in terms of its predecessor is as follows: if the sign of a */
612 /* descriptor is positive, the type of that descriptor is the */
613 /* successor of the type of the preceding descriptor in the */
614 /* sequence of types below. If the sign of a descriptor is */
615 /* negative, the type of the descriptor is the predecessor of the */
616 /* type of the preceding descriptor. */
617
618 /* C --> D --> I --> C */
619
620 /* For example, if the preceding type is `I', and a descriptor */
621 /* contains the number 16, the type of the descriptor is `C', */
622 /* whereas if the descriptor contained the number -800, the type */
623 /* of the descriptor would be `D'. */
624
625
626 /* Logic cases */
627 /* =========== */
628
629 /* There are three kinds of file attributes that this */
630 /* routine distinguishes: */
631
632 /* Attributes */
633 /* ---------- */
634 /* "FAST" read-only and segregated */
635 /* "READONLY" read-only and unsegregated */
636 /* "WRITABLE" writable */
637
638 /* There are three kinds of file histories that this */
639 /* routine distinguishes: */
640
641 /* History */
642 /* ------- */
643 /* "SAME" file is the same as seen on */
644 /* the previous call */
645
646 /* "KNOWN" file is not the same as seen */
647 /* on the previous call, but file */
648 /* information is buffered */
649
650 /* "UNKNOWN" file information is not buffered. */
651
652 /* All combinations of attributes and history are possible, */
653 /* so there are nine cases. */
654
655 /* Mapping actions to cases */
656 /* ======================== */
657
658 /* Action Cases */
659 /* ------ ----- */
660 /* Set SAMFIL, PRVOK ALL */
661 /* Data type check ALL */
662 /* Set KNOWN not (FAST and SAME) */
663 /* Get access method UNKNOWN */
664 /* Buffer insertion UNKNOWN */
665 /* Set */
666 /* TBHAN */
667 /* TBRDON */
668 /* TBFAST */
669 /* TBFWRD UNKNOWN */
670 /* Get file summary UNKNOWN or WRITABLE */
671 /* Set TBMXAD UNKNOWN or WRITABLE */
672 /* Segregation check UNKNOWN and not WRITABLE */
673 /* Set TBBASE, TBSIZE FAST and UNKNOWN */
674 /* Set FAST not SAME */
675 /* Address range check ALL */
676 /* Address search READONLY or WRITABLE */
677 /* Set CLBASE, CLSIZE ALL */
678
679 /* ======================== */
680
681
682 /* Make sure the data type is valid. */
683
684 if (*type__ < 1 || *type__ > 3) {
685 chkin_("DASA2L", (ftnlen)6);
686 setmsg_("Invalid data type: #. File was #", (ftnlen)32);
687 errint_("#", type__, (ftnlen)1);
688 errhan_("#", handle, (ftnlen)1);
689 sigerr_("SPICE(DASINVALIDTYPE)", (ftnlen)21);
690 chkout_("DASA2L", (ftnlen)6);
691 return 0;
692 }
693
694 /* Decide whether we're looking at the same file as we did on the */
695 /* last call. We can use data from the previous call only if that */
696 /* call succeeded. */
697
698 samfil = *handle == prvhan && prvok;
699
700 /* PRVOK defaults to .FALSE. and will be reset if this call */
701 /* succeeds. */
702
703 prvok = FALSE_;
704
705 /* Fast files get priority handling. If we have a fast file */
706 /* that we saw on the previous call, skip directly to the */
707 /* address range check. */
708
709 if (! (fast && samfil)) {
710
711 /* Is this a file we recognize? */
712
713 if (samfil) {
714 known = TRUE_;
715 } else {
716 fidx = isrchi_(handle, &nfiles, tbhan);
717 known = fidx > 0;
718 }
719 if (known) {
720 fast = tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
721 "tbfast", i__1, "dasa2l_", (ftnlen)779)];
722 } else {
723
724 /* This file is not in our list. We'll buffer information */
725 /* about this file. */
726
727 /* Shift the table and insert the new entry at the front. The */
728 /* entry at the back will be lost if the table is full. */
729
730 /* Note that unused entries (those for which the DAS handle is */
731 /* 0) will drop out of the list automatically. */
732
733 ub = min(nfiles,19);
734 for (i__ = ub; i__ >= 1; --i__) {
735 tbhan[(i__1 = i__) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbhan",
736 i__1, "dasa2l_", (ftnlen)796)] = tbhan[(i__2 = i__ -
737 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tbhan", i__2,
738 "dasa2l_", (ftnlen)796)];
739 tbrdon[(i__1 = i__) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbrdon"
740 , i__1, "dasa2l_", (ftnlen)797)] = tbrdon[(i__2 = i__
741 - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tbrdon", i__2,
742 "dasa2l_", (ftnlen)797)];
743 tbfast[(i__1 = i__) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfast"
744 , i__1, "dasa2l_", (ftnlen)798)] = tbfast[(i__2 = i__
745 - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tbfast", i__2,
746 "dasa2l_", (ftnlen)798)];
747 tbfwrd[(i__1 = i__) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfwrd"
748 , i__1, "dasa2l_", (ftnlen)799)] = tbfwrd[(i__2 = i__
749 - 1) < 20 && 0 <= i__2 ? i__2 : s_rnge("tbfwrd", i__2,
750 "dasa2l_", (ftnlen)799)];
751 for (j = 1; j <= 3; ++j) {
752 tbbase[(i__1 = j + (i__ + 1) * 3 - 4) < 60 && 0 <= i__1 ?
753 i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)
754 802)] = tbbase[(i__2 = j + i__ * 3 - 4) < 60 && 0
755 <= i__2 ? i__2 : s_rnge("tbbase", i__2, "dasa2l_",
756 (ftnlen)802)];
757 tbsize[(i__1 = j + (i__ + 1) * 3 - 4) < 60 && 0 <= i__1 ?
758 i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)
759 803)] = tbsize[(i__2 = j + i__ * 3 - 4) < 60 && 0
760 <= i__2 ? i__2 : s_rnge("tbsize", i__2, "dasa2l_",
761 (ftnlen)803)];
762 tbmxad[(i__1 = j + (i__ + 1) * 3 - 4) < 60 && 0 <= i__1 ?
763 i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)
764 804)] = tbmxad[(i__2 = j + i__ * 3 - 4) < 60 && 0
765 <= i__2 ? i__2 : s_rnge("tbmxad", i__2, "dasa2l_",
766 (ftnlen)804)];
767 }
768 }
769
770 /* Insert the new table entry at index 1. */
771
772 /* Computing MIN */
773 i__1 = nfiles + 1;
774 nfiles = min(i__1,20);
775 fidx = 1;
776 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbhan",
777 i__1, "dasa2l_", (ftnlen)813)] = *handle;
778
779 /* Set FAST to .FALSE. until we find out whether the file */
780 /* is read-only and segregated. */
781
782 fast = FALSE_;
783 tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfa"
784 "st", i__1, "dasa2l_", (ftnlen)819)] = fast;
785
786 /* FIDX is now set whether or not the current file is known. */
787
788 /* TBRDON(FIDX) and TBFAST(FIDX) are set. */
789
790 /* Find out whether the file is open for read or write access. */
791 /* We consider the file to be `slow' until we find out */
792 /* otherwise. The contents of the arrays TBBASE, TBSIZE, and */
793 /* TBMXAD are left undefined for slow files. */
794
795 dasham_(handle, access, (ftnlen)10);
796 if (failed_()) {
797
798 /* Make sure the current table entry won't be found */
799 /* on a subsequent search. */
800
801 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
802 "tbhan", i__1, "dasa2l_", (ftnlen)837)] = 0;
803 return 0;
804 }
805
806 /* TBRDON(FIDX) indicates whether the file is read-only. */
807
808 tbrdon[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbrd"
809 "on", i__1, "dasa2l_", (ftnlen)845)] = s_cmp(access, "READ"
810 , (ftnlen)10, (ftnlen)4) == 0;
811 }
812
813 /* FIDX, KNOWN and TBRDON( FIDX ) are set. */
814
815 /* Get the file summary if it isn't known already. */
816
817 if (! (known && tbrdon[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 :
818 s_rnge("tbrdon", i__1, "dasa2l_", (ftnlen)854)])) {
819
820 /* The file is new or it's writable; in either case the */
821 /* maximum addresses are unknown. Get the current address */
822 /* range for the file. */
823
824 dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, &tbmxad[(
825 i__1 = fidx * 3 - 3) < 60 && 0 <= i__1 ? i__1 : s_rnge(
826 "tbmxad", i__1, "dasa2l_", (ftnlen)860)], lstrec, lstwrd);
827 if (failed_()) {
828
829 /* Make sure the current table entry won't be found */
830 /* on a subsequent search. */
831
832 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
833 "tbhan", i__1, "dasa2l_", (ftnlen)875)] = 0;
834 return 0;
835 }
836
837 /* Set the forward cluster pointer. */
838
839 tbfwrd[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfw"
840 "rd", i__1, "dasa2l_", (ftnlen)883)] = nresvr + ncomr + 2;
841 }
842
843 /* TBMXAD is set. */
844
845 /* If this is an unknown file and is read-only, determine */
846 /* whether the file is segregated */
847
848 if (! known && tbrdon[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 :
849 s_rnge("tbrdon", i__1, "dasa2l_", (ftnlen)893)]) {
850
851 /* The file is read-only; we need to know whether it is */
852 /* segregated. If so, there are at most three cluster */
853 /* descriptors, and the first directory record's maximum */
854 /* address for each type matches the last logical address for */
855 /* that type. */
856
857 /* FAST has been initialized to .FALSE. above. */
858
859 /* NREC is the record number of the first directory record. */
860
861 nrec = tbfwrd[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
862 "tbfwrd", i__1, "dasa2l_", (ftnlen)905)];
863 dasrri_(handle, &nrec, &c__1, &c__256, dirrec);
864 nxtrec = dirrec[1];
865 if (nxtrec <= 0) {
866
867 /* If this file is segregated, there are at most three */
868 /* cluster descriptors, and each one points to a cluster */
869 /* containing all records of the corresponding data type. */
870 /* For each data type having a non-zero maximum address, */
871 /* the size of the corresponding cluster must be large */
872 /* enough to hold all addresses of that type. */
873
874 ntypes = 0;
875 for (i__ = 1; i__ <= 3; ++i__) {
876 if (tbmxad[(i__1 = i__ + fidx * 3 - 4) < 60 && 0 <= i__1 ?
877 i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)
878 924)] > 0) {
879 ++ntypes;
880 }
881 }
882
883 /* Now look at the first NTYPES cluster descriptors, */
884 /* collecting cluster bases and sizes as we go. */
885
886 baserc = nrec + 1;
887 prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 :
888 s_rnge("prev", i__1, "dasa2l_", (ftnlen)935)];
889 dscloc = 10;
890 segok = TRUE_;
891 while(dscloc <= ntypes + 9 && segok) {
892
893 /* Find the type of the current descriptor. */
894
895 if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 :
896 s_rnge("dirrec", i__1, "dasa2l_", (ftnlen)944)]
897 > 0) {
898 curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ?
899 i__1 : s_rnge("next", i__1, "dasa2l_", (
900 ftnlen)945)];
901 } else {
902 curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ?
903 i__1 : s_rnge("prev", i__1, "dasa2l_", (
904 ftnlen)947)];
905 }
906 prvtyp = curtyp;
907 tbbase[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ?
908 i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)
909 951)] = baserc;
910 tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <= i__1 ?
911 i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)
912 952)] = (i__3 = dirrec[(i__2 = dscloc - 1) < 256
913 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2,
914 "dasa2l_", (ftnlen)952)], abs(i__3));
915 baserc += tbsize[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0
916 <= i__1 ? i__1 : s_rnge("tbsize", i__1, "dasa2l_",
917 (ftnlen)953)];
918 segok = tbmxad[(i__1 = curtyp + fidx * 3 - 4) < 60 && 0 <=
919 i__1 ? i__1 : s_rnge("tbmxad", i__1, "dasa2l_", (
920 ftnlen)956)] <= tbsize[(i__2 = curtyp + fidx * 3
921 - 4) < 60 && 0 <= i__2 ? i__2 : s_rnge("tbsize",
922 i__2, "dasa2l_", (ftnlen)956)] * nw[(i__3 =
923 curtyp - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge(
924 "nw", i__3, "dasa2l_", (ftnlen)956)];
925 ++dscloc;
926
927 /* This loop will terminate after at most 3 */
928 /* iterations. No further checks are needed. */
929
930 }
931
932 /* Update FAST and TBFAST based on the segregation check. */
933
934 fast = segok;
935 tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
936 "tbfast", i__1, "dasa2l_", (ftnlen)970)] = fast;
937
938 /* If the file is FAST, */
939
940 /* TBBASE */
941 /* TBSIZE */
942
943 /* have been updated as well. */
944
945 }
946 }
947
948 /* End of the segregation check. */
949
950 }
951
952 /* End of the NOT FAST or NOT SAME case. */
953
954 /* At this point we have the logical address ranges for the */
955 /* file. Check the input address against them. */
956
957 mxaddr = tbmxad[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ? i__1 :
958 s_rnge("tbmxad", i__1, "dasa2l_", (ftnlen)992)];
959 if (*addrss < 1 || *addrss > mxaddr) {
960
961 /* Make sure the current table entry won't be found on a */
962 /* subsequent search. */
963
964 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbhan",
965 i__1, "dasa2l_", (ftnlen)999)] = 0;
966 chkin_("DASA2L", (ftnlen)6);
967 setmsg_("ADDRSS was #; valid range for type # is # to #. File was #",
968 (ftnlen)59);
969 errint_("#", addrss, (ftnlen)1);
970 errint_("#", type__, (ftnlen)1);
971 errint_("#", &c__1, (ftnlen)1);
972 errint_("#", &mxaddr, (ftnlen)1);
973 errhan_("#", handle, (ftnlen)1);
974 sigerr_("SPICE(DASNOSUCHADDRESS)", (ftnlen)23);
975 chkout_("DASA2L", (ftnlen)6);
976 return 0;
977 }
978
979 /* If we're looking at a "fast" file, we know the cluster base and */
980 /* size. HIADDR is the highest address (not necessarily in use) in */
981 /* the cluster. */
982
983 if (tbfast[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbfast",
984 i__1, "dasa2l_", (ftnlen)1020)]) {
985
986 /* The current file is "fast": read-only and segregated. */
987
988 *clbase = tbbase[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ?
989 i__1 : s_rnge("tbbase", i__1, "dasa2l_", (ftnlen)1024)];
990 *clsize = tbsize[(i__1 = *type__ + fidx * 3 - 4) < 60 && 0 <= i__1 ?
991 i__1 : s_rnge("tbsize", i__1, "dasa2l_", (ftnlen)1025)];
992 hiaddr = *clsize * nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 :
993 s_rnge("nw", i__1, "dasa2l_", (ftnlen)1026)];
994 } else {
995
996 /* If we're not looking at a "fast" file, find the cluster */
997 /* containing the input address, for the input data type. */
998
999 /* Find out which directory describes the cluster containing this */
1000 /* word. To do this, we must traverse the directory list. The */
1001 /* first directory record comes right after the last comment */
1002 /* record. (Don't forget the file record when counting the */
1003 /* predecessors of the directory record.) */
1004
1005 /* Note that we don't need to worry about not finding a directory */
1006 /* record that contains the address we're looking for, since */
1007 /* we've already checked that the address is in range. */
1008
1009 nrec = tbfwrd[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
1010 "tbfwrd", i__1, "dasa2l_", (ftnlen)1043)];
1011 ndirs = 1;
1012 i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge(
1013 "rngloc", i__2, "dasa2l_", (ftnlen)1046)] + 1;
1014 dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ?
1015 i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen)1046)], &
1016 i__3, range);
1017 while(range[1] < *addrss) {
1018
1019 /* The record number of the next directory is the forward */
1020 /* pointer in the current directory record. Update NREC with */
1021 /* this pointer. Get the address range for the specified type */
1022 /* covered by this next directory record. */
1023
1024 dasrri_(handle, &nrec, &c__2, &c__2, &nxtrec);
1025 nrec = nxtrec;
1026 ++ndirs;
1027 i__3 = rngloc[(i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 :
1028 s_rnge("rngloc", i__2, "dasa2l_", (ftnlen)1065)] + 1;
1029 dasrri_(handle, &nrec, &rngloc[(i__1 = *type__ - 1) < 3 && 0 <=
1030 i__1 ? i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen)
1031 1065)], &i__3, range);
1032 if (failed_()) {
1033
1034 /* Make sure the current table entry won't be found */
1035 /* on a subsequent search. */
1036
1037 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
1038 "tbhan", i__1, "dasa2l_", (ftnlen)1076)] = 0;
1039 return 0;
1040 }
1041 }
1042
1043 /* NREC is now the record number of the directory that contains */
1044 /* the type descriptor for the address we're looking for. */
1045
1046 /* Our next task is to find the descriptor for the cluster */
1047 /* containing the input address. To do this, we must examine the */
1048 /* directory record in `left-to-right' order. As we do so, we'll */
1049 /* keep track of the highest address of type TYPE occurring in */
1050 /* the clusters whose descriptors we've seen. The variable HIADDR */
1051 /* will contain this address. */
1052
1053 dasrri_(handle, &nrec, &c__1, &c__256, dirrec);
1054 if (failed_()) {
1055
1056 /* Make sure the current table entry won't be found on a */
1057 /* subsequent search. */
1058
1059 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge("tbhan",
1060 i__1, "dasa2l_", (ftnlen)1102)] = 0;
1061 return 0;
1062 }
1063
1064 /* In the process of finding the physical location corresponding */
1065 /* to ADDRSS, we'll find the record number of the base of the */
1066 /* cluster containing ADDRSS. We'll start out by initializing */
1067 /* this value with the number of the first data record of the */
1068 /* next cluster. */
1069
1070 *clbase = nrec + 1;
1071
1072 /* We'll initialize HIADDR with the value preceding the lowest */
1073 /* address of type TYPE described by the current directory. */
1074
1075 hiaddr = dirrec[(i__2 = rngloc[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ?
1076 i__1 : s_rnge("rngloc", i__1, "dasa2l_", (ftnlen)1121)] - 1)
1077 < 256 && 0 <= i__2 ? i__2 : s_rnge("dirrec", i__2, "dasa2l_",
1078 (ftnlen)1121)] - 1;
1079
1080 /* Initialize the number of records described by the last seen */
1081 /* type descriptor. This number, when added to CLBASE, should */
1082 /* yield the number of the first record of the current cluster; */
1083 /* that's why it's initialized to 0. */
1084
1085 *clsize = 0;
1086
1087 /* Now find the descriptor for the cluster containing ADDRSS. */
1088 /* Read descriptors until we get to the one that describes the */
1089 /* record containing ADDRSS. Keep track of descriptor data */
1090 /* types as we go. Also count the descriptors. */
1091
1092 /* At this point, HIADDR is less than ADDRSS, so the loop will */
1093 /* always be executed at least once. */
1094
1095 prvtyp = prev[(i__1 = dirrec[8] - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
1096 "prev", i__1, "dasa2l_", (ftnlen)1140)];
1097 dscloc = 10;
1098 while(hiaddr < *addrss) {
1099 if (dscloc > 256) {
1100
1101 /* This situation shouldn't occur, but it might if the */
1102 /* DAS file is corrupted. */
1103
1104 /* Make sure the current table entry won't be found */
1105 /* on a subsequent search. */
1106
1107 tbhan[(i__1 = fidx - 1) < 20 && 0 <= i__1 ? i__1 : s_rnge(
1108 "tbhan", i__1, "dasa2l_", (ftnlen)1153)] = 0;
1109 chkin_("DASA2L", (ftnlen)6);
1110 setmsg_("Directory record # in DAS file with handle # is pro"
1111 "bably corrupted. No high cluster address at or above"
1112 " the input address # was found, though it should hav"
1113 "e been. High address was #. Data type was #.", (
1114 ftnlen)199);
1115 errint_("#", &nrec, (ftnlen)1);
1116 errint_("#", handle, (ftnlen)1);
1117 errint_("#", addrss, (ftnlen)1);
1118 errint_("#", &hiaddr, (ftnlen)1);
1119 errint_("#", type__, (ftnlen)1);
1120 sigerr_("SPICE(BADDASDIRECTORY)", (ftnlen)22);
1121 chkout_("DASA2L", (ftnlen)6);
1122 return 0;
1123 }
1124
1125 /* Update CLBASE so that it is the record number of the */
1126 /* first record of the current cluster. */
1127
1128 *clbase += *clsize;
1129
1130 /* Find the type of the current descriptor. */
1131
1132 if (dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ? i__1 : s_rnge(
1133 "dirrec", i__1, "dasa2l_", (ftnlen)1180)] > 0) {
1134 curtyp = next[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 :
1135 s_rnge("next", i__1, "dasa2l_", (ftnlen)1181)];
1136 } else {
1137 curtyp = prev[(i__1 = prvtyp - 1) < 3 && 0 <= i__1 ? i__1 :
1138 s_rnge("prev", i__1, "dasa2l_", (ftnlen)1183)];
1139 }
1140
1141 /* Forgetting to update PRVTYP is a Very Bad Thing (VBT). */
1142
1143 prvtyp = curtyp;
1144
1145 /* If the current descriptor is of the type we're interested */
1146 /* in, update the highest address count. */
1147
1148 if (curtyp == *type__) {
1149 hiaddr += nw[(i__1 = *type__ - 1) < 3 && 0 <= i__1 ? i__1 :
1150 s_rnge("nw", i__1, "dasa2l_", (ftnlen)1196)] * (i__3 =
1151 dirrec[(i__2 = dscloc - 1) < 256 && 0 <= i__2 ? i__2
1152 : s_rnge("dirrec", i__2, "dasa2l_", (ftnlen)1196)],
1153 abs(i__3));
1154 }
1155
1156 /* Compute the number of records described by the current */
1157 /* descriptor. Update the descriptor location. */
1158
1159 *clsize = (i__2 = dirrec[(i__1 = dscloc - 1) < 256 && 0 <= i__1 ?
1160 i__1 : s_rnge("dirrec", i__1, "dasa2l_", (ftnlen)1203)],
1161 abs(i__2));
1162 ++dscloc;
1163 }
1164
1165 /* At this point, the variables */
1166
1167 /* CLBASE */
1168 /* CLSIZE */
1169 /* HIADDR */
1170
1171 /* are set. */
1172
1173 }
1174
1175 /* At this point, */
1176
1177 /* -- CLBASE is properly set: it is the record number of the */
1178 /* first record of the cluster containing ADDRSS. */
1179
1180 /* -- CLSIZE is properly set: it is the size of the cluster */
1181 /* containing ADDRSS. */
1182
1183 /* -- HIADDR is the last logical address in the cluster */
1184 /* containing ADDRSS. */
1185
1186 /* Now we must find the physical record and word corresponding */
1187 /* to ADDRSS. The structure of the cluster containing ADDRSS and */
1188 /* HIADDR is shown below: */
1189
1190 /* +--------------------------------------+ */
1191 /* | | Record # CLBASE */
1192 /* +--------------------------------------+ */
1193 /* . */
1194 /* . */
1195 /* . */
1196 /* +--------------------------------------+ */
1197 /* | |ADDRSS| | Record # RECNO */
1198 /* +--------------------------------------+ */
1199 /* . */
1200 /* . */
1201 /* . */
1202 /* +--------------------------------------+ Record # */
1203 /* | |HIADDR| */
1204 /* +--------------------------------------+ CLBASE + CLSIZE - 1 */
1205
1206
1207 *recno = *clbase + *clsize - 1 - (hiaddr - *addrss) / nw[(i__1 = *type__
1208 - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (
1209 ftnlen)1251)];
1210 *wordno = *addrss - (*addrss - 1) / nw[(i__1 = *type__ - 1) < 3 && 0 <=
1211 i__1 ? i__1 : s_rnge("nw", i__1, "dasa2l_", (ftnlen)1254)] * nw[(
1212 i__2 = *type__ - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("nw", i__2,
1213 "dasa2l_", (ftnlen)1254)];
1214
1215 /* Update PRVHAN and set PRVOK to .TRUE. only if the call succeeded. */
1216
1217 prvhan = *handle;
1218 prvok = TRUE_;
1219 return 0;
1220 } /* dasa2l_ */
1221
1222