Return to qqutab.f CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst

Annotation of cci/usr/src/usr.bin/f77/f77pass1/tst/qqutab.f, revision 1.1

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.