![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to qqutab.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst|
Return to qqutab.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst |
1.1 root 1: SUBROUTINE QQUTAB
2: C
3: CD0
4: CD0 IDENTIFICATION
5: CD0
6: CD0 SUBROUTINE QQUTAB
7: CD0
8: CD0 Programmer - D. Braley : NASA/JSC : Jan 1975
9: CD0 Modified By - A. Shih : CSC : March 1983
10: CD0 Documented By W. Collier, CSC, Feb. 1983
11: CD1
12: CD1 PURPOSE
13: CD1
14: CD1 This routine builds the units conversion table (UNTAB)
15: CD5
16: CD5 INTERNAL VARIABLES
17: CD5
18: CD5 NAME DIMENSION T LEN DEFINITION
19: CD5
20: CD5 HEADER 5 I DBF omnibus element preamble.
21: CD5 I I do loop index in loop to move units data
22: CD5 from the ISYM array to UNTAB.
23: CD5 ISTART I starting location in the DBF omnibus
24: CD5 element for the units data.
25: CD5 ISTAT I error status code of DREAD.
26: CD5 ISYM 2,NSYM I 2 by NSYM array containing NSYM number of
27: CD5 records with, word 1 of each record =
28: CD5 Symbol, word 2 of each record = SCALE
29: CD5 factor.
30: CD5 ITOT I maximum size of the units table.
31: CD5 LN I length of units data in the DBF omnibus
32: CD5 element.
33: CD5 NEXT I pointer to NEXT open entry in UNTAB.
34: CD5 NN I number of symbols in the units table.
35: CD5 NSCALE I index of SCALE array location of the
36: CD5 conversion factor for a units table
37: CD5 symbol.
38: CD5 NSYM I T.B.S.
39: CD5 SYM 2,1 R real equivalent of the ISYM array for
40: CD5 extracting the SCALE factors.
41: CD5 VALUE R temporary variable to hold the conversion
42: CD5 factors after read from the SYM array.
43: CD7
44: CD7 FUNCTIONAL DESCRIPTION
45: CD7
46: CD7 1. Open the omnibus direct access I/O routines for reading
47: CD7 UNTAB.
48: CD7 2. Use the direct access read (DREAD) to read the units
49: CD7 information into the ISYM array.
50: CD7 3. Step through the ISYM array and move ISYM(1,*) into the
51: CD7 symbol location of UNTAB, and the conversion factor into
52: CD7 the SCALE array, store the SCALE location of the
53: CD7 conversion factor in UNTAB.
54: CD7 4. Complete the preamble of UNTAB.
55: CD8
56: CD8 ASSUMPTIONS AND LIMITATIONS
57: CD8
58: CD8 None
59: CD9
60: CD9 SPECIAL COMMENTS
61: CD9
62: CD9 none
63: CD10
64: CD10 REFERENCES
65: CD10
66: CD10 none
67: C
68: C***BEGIN STANDARD COMMON FOR SUBROUTINE QQUTAB
69: INTEGER QQ3
70: CHARACTER * 6 UNTAB
71: DIMENSION SCALE (31)
72: COMMON /IPKT/ IPKT (44)
73: COMMON /UNTAB/ UNTAB (1)
74: COMMON /QQ3/ QQ3 (114)
75: EQUIVALENCE (IERROR , QQ3 ( 7) )
76: 1 , (SCALE , QQ3 ( 114) )
77: C***END STANDARD COMMON FOR SUBROUTINE QQUTAB
78: C
79: PARAMETER (NSYM = 100)
80: INTEGER HEADER
81: CHARACTER * 6 SYM
82: CHARACTER * 6 ISTORE
83: CHARACTER * 6 ISYM
84: DIMENSION ISYM (2,NSYM)
85: DIMENSION SYM (2,1)
86: DIMENSION HEADER (5)
87: EQUIVALENCE (SYM , ISYM )
88: EQUIVALENCE (VALUE , IVALUE )
89: C
90: C Open the UNTAB record
91: C
92: CALL QQTOPN (UNTAB,*300)
93: C
94: C Read UNTAB into ISYM
95: C
96: CALL DREAD (IPKT,HEADER,1,5,ISTAT,*400,*300)
97: ISTART = HEADER (4)
98: LN = HEADER (5) - HEADER (4)
99: ITOT= NSYM*2
100: IF(LN .GT. ITOT) GO TO 500
101: CALL DCREAD (IPKT,ISYM,ISTART,LN,ISTAT,*400,*300)
102: C
103: C Enter the symbols into the UNTAB array
104: C
105: NEXT = ILOAD (UNTAB(4))
106: NSCALE = 0
107: NSCALE = 0
108: NN = LN/2
109: DO 100 I=1,NN
110: UNTAB(NEXT) = ISYM(1,I)
111: IVALUE = ILOAD (SYM(2,I))
112: NSCALE = NSCALE + 1
113: SCALE (NSCALE) = VALUE
114: UNTAB(NEXT+1) = ISTORE(NSCALE)
115: 100 NEXT = NEXT + 2
116: UNTAB(5) = ISTORE(NEXT)
117: IENTRY = (NEXT - ILOAD(UNTAB(4))) / 2
118: UNTAB (6) = ISTORE (IENTRY)
119: UNTAB (10) = ISTORE(NSCALE)
120: CALL DARCLS (IPKT,ISTAT,*300)
121: RETURN
122: C
123: C Error return from SSM routine
124: C
125: 300 CONTINUE
126: WRITE(6,1300)
127: IERROR = 1
128: RETURN
129: C
130: C Eof encountered in read
131: C
132: 400 CONTINUE
133: WRITE(6,1400)
134: IERROR = 1
135: RETURN
136: C
137: C Not enough space to load UNTAB
138: C
139: 500 CONTINUE
140: WRITE (6,1500)
141: IERROR = 1
142: RETURN
143: C
144: 1300 FORMAT(1H0,'*** ERROR *** - ERROR ENCOUNTERED IN READING'
145: 1,' UNTAB TABLE INTO QQINPT',/)
146: 1400 FORMAT(1H0,'*** ERROR *** - EOF ENCOUNTERED DURING UNTAB READ'/)
147: 1500 FORMAT(1H0,'*** ERROR *** - NOT ENOUGH SPACE EXITS TO LOAD'
148: 1,' UNTAB INTO QQINPT',/)
149: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.