Return to qqutab.f CVS log

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

Power 6/32 Unix version 1.21

      SUBROUTINE QQUTAB
C
CD0
CD0   IDENTIFICATION
CD0
CD0         SUBROUTINE QQUTAB
CD0
CD0         Programmer - D. Braley : NASA/JSC : Jan 1975
CD0         Modified By - A. Shih : CSC : March 1983
CD0         Documented By  W. Collier, CSC, Feb. 1983
CD1
CD1   PURPOSE
CD1
CD1         This routine builds the units conversion table (UNTAB)
CD5
CD5   INTERNAL VARIABLES
CD5
CD5      NAME        DIMENSION T  LEN  DEFINITION
CD5
CD5      HEADER              5 I       DBF omnibus element preamble.
CD5      I                     I       do loop index in loop to move units data
CD5                                    from the ISYM array to UNTAB.
CD5      ISTART                I       starting location in the DBF omnibus
CD5                                    element for the units data.
CD5      ISTAT                 I       error status code of DREAD.
CD5      ISYM           2,NSYM I       2 by NSYM array containing NSYM number of
CD5                                    records with, word 1 of each record =
CD5                                    Symbol, word 2 of each record = SCALE
CD5                                    factor.
CD5      ITOT                  I       maximum size of the units table.
CD5      LN                    I       length of units data in the DBF omnibus
CD5                                    element.
CD5      NEXT                  I       pointer to NEXT open entry in UNTAB.
CD5      NN                    I       number of symbols in the units table.
CD5      NSCALE                I       index of SCALE array location of the
CD5                                    conversion factor for a units table
CD5                                    symbol.
CD5      NSYM                  I       T.B.S.
CD5      SYM               2,1 R       real equivalent of the ISYM array for
CD5                                    extracting the SCALE factors.
CD5      VALUE                 R       temporary variable to hold the conversion
CD5                                    factors after read from the SYM array.
CD7
CD7   FUNCTIONAL DESCRIPTION
CD7
CD7         1. Open the omnibus direct access I/O routines for reading
CD7            UNTAB.
CD7         2. Use the direct access read (DREAD) to read the units
CD7            information into the ISYM array.
CD7         3. Step through the ISYM array and move ISYM(1,*) into the
CD7            symbol location of UNTAB, and the conversion factor into
CD7            the SCALE array, store the SCALE location of the
CD7            conversion factor in UNTAB.
CD7         4. Complete the preamble of UNTAB.
CD8
CD8   ASSUMPTIONS AND LIMITATIONS
CD8
CD8         None
CD9
CD9   SPECIAL COMMENTS
CD9
CD9         none
CD10
CD10  REFERENCES
CD10
CD10        none
C
C***BEGIN STANDARD COMMON FOR SUBROUTINE QQUTAB
      INTEGER QQ3
      CHARACTER * 6 UNTAB
      DIMENSION SCALE (31)
      COMMON /IPKT/ IPKT (44)
      COMMON /UNTAB/ UNTAB (1)
      COMMON /QQ3/ QQ3 (114)
      EQUIVALENCE (IERROR     ,  QQ3    (   7) )
     1 ,          (SCALE      ,  QQ3    (  114) )
C***END STANDARD COMMON FOR SUBROUTINE QQUTAB
C
      PARAMETER  (NSYM = 100)
      INTEGER HEADER
      CHARACTER * 6 SYM
      CHARACTER * 6 ISTORE
      CHARACTER * 6 ISYM
      DIMENSION ISYM (2,NSYM)
      DIMENSION SYM (2,1)
      DIMENSION HEADER (5)
      EQUIVALENCE (SYM        ,  ISYM           )
      EQUIVALENCE (VALUE      ,  IVALUE         )
C
C          Open the UNTAB record
C
      CALL QQTOPN (UNTAB,*300)
C
C          Read UNTAB into ISYM
C
      CALL DREAD (IPKT,HEADER,1,5,ISTAT,*400,*300)
      ISTART = HEADER (4)
      LN = HEADER (5) - HEADER (4)
      ITOT= NSYM*2
      IF(LN .GT. ITOT) GO TO 500
      CALL DCREAD (IPKT,ISYM,ISTART,LN,ISTAT,*400,*300)
C
C          Enter the symbols into the UNTAB array
C
      NEXT =  ILOAD (UNTAB(4))
      NSCALE = 0
      NSCALE = 0
      NN = LN/2
      DO 100 I=1,NN
      UNTAB(NEXT) = ISYM(1,I)
      IVALUE = ILOAD (SYM(2,I))
      NSCALE = NSCALE + 1
      SCALE (NSCALE) = VALUE
      UNTAB(NEXT+1) = ISTORE(NSCALE)
  100 NEXT = NEXT + 2
      UNTAB(5) = ISTORE(NEXT)
      IENTRY = (NEXT - ILOAD(UNTAB(4))) / 2
      UNTAB (6) = ISTORE (IENTRY)
      UNTAB (10) = ISTORE(NSCALE)
      CALL DARCLS (IPKT,ISTAT,*300)
      RETURN
C
C          Error return from SSM routine
C
300   CONTINUE
      WRITE(6,1300)
      IERROR = 1
      RETURN
C
C          Eof encountered in read
C
400   CONTINUE
      WRITE(6,1400)
      IERROR = 1
      RETURN
C
C          Not enough space to load UNTAB
C
  500 CONTINUE
      WRITE (6,1500)
      IERROR = 1
      RETURN
C
 1300 FORMAT(1H0,'*** ERROR *** - ERROR ENCOUNTERED IN READING'
     1,' UNTAB TABLE INTO QQINPT',/)
 1400 FORMAT(1H0,'*** ERROR *** - EOF ENCOUNTERED DURING UNTAB READ'/)
 1500 FORMAT(1H0,'*** ERROR *** - NOT ENOUGH SPACE EXITS TO LOAD'
     1,' UNTAB INTO QQINPT',/)
      END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.