FTN4,L,C
      PROGRAM DBSPA(4,90),92069-16133 REV.1912 790130 
C 
C 
C****************************************************************** 
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED 
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN
C CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18133
C     RELOC:     92069-16133
C 
C     PRGMR:     CEJ
C 
C 
C****************************************************************** 
C 
C 
C 
C 
C  DATA BASE SPACE IS A UTILITY PROGRAM FOR IMAGE/1000 WHICH REPORTS THE
C  STATUS OF ANY DATA SET ACCESSIBLE BY THE USER INITIATING DBSPA.  THE 
C  REPORTED BY DBSPA INCLUDES THE CAPACITY OF THE DATA SET AND THE NUMBER 
C  OF FREE RECORDS IN THE DATA SET AS DEFINED BY THE ROOT FILE.  THE NUM- 
C  BER OF USED RECORDS WHICH ACTUALLY EXIST IN THE DATA SET, AND THE DIF- 
C  FERENCE BETWEEN THE CAPACITY OF THE DATA SET AND THE SUM OF ITS FREE 
C  AND USED RECORDS.  A NON-ZERO DIFFERENCE SHOWN FOR ANY OF THE DATA SETS
C  MAY INDICATE THAT THE DATA BASE IS CORRUPT AND SOME FORM OF RECOVERY 
C  OF THE DATA BASE SHOULD BE ATTEMPTED.
C 
C  THE USER INITIATES DBSPA WITH THE COMMAND: 
C 
C    :RU,DBSPA[,INPUT[,OUTPUT[,ROOT FILE NAMR[,LEVEL CODE WORD]]]]
C 
C  WHERE: 
C    INPUT
C      IS THE LU OF THE DEVICE TO BE USED FOR ANY FURTHER INPUT NECESSARY 
C      TO DBSPA.  DEFAULT IS THE SCHEDULING LU. 
C 
C    OUTPUT 
C      IS THE LU OF THE DEVICE TO BE USED BY DBSPA FOR OUTPUT.  DEFAULT 
C      IS THE INPUT LU, IF INTERACTIVE, ELSE LU 6.
C 
C    ROOT FILE NAMR 
C      IS THE FMP NAMR FOR THE ROOT FILE OF THE DATA BASE WHOSE STATUS
C      IS  TO BE REPORTED.  NO DEFAULT. 
C 
C    LEVEL CODE WORD
C      IS THE USER'S LEVEL CODE WORD FOR THE DATA BASE.  NO DEFAULT.
C 
C  IF EITHER, OR BOTH, OF THE LATTER TWO PARAMETERS ARE OMITTED, DBSPA
C  WILL EXPECT THEM FROM THE INPUT DEVICE.  IF THE INPUT DEVICE IS INTER- 
C  ACTIVE, DBSPA WILL PROMPT THE USER FOR INPUT WITH: 
C 
C    /DBSPA: ROOT FILE NAMR?
C 
C                  AND/OR 
C 
C    /DBSPA: LEVEL CODE WORD? 
C 
C  ANY ERRORS ENCOUNTERED BY DBSPA WILL BE LOGGED ON THE INPUT DEVICE,
C  IF INTERACTIVE, ELSE LU 1. 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  SAMPLE OUTPUT. 
C 
CCCCC 
C 
C  GOOD STATUS: 
C 
CCCCC 
C 
C   IMAGE/1000 DATA BASE SPACE UTILITY
C 
C   DATA SET NAME    CAPACITY    FREE RECORDS    RECORDS USED    DIFFERENCE 
C   -------------    --------    ------------    ------------    ---------- 
C 
C       GOOD             1001            984             17              0
C       BAD              1001            984             17              0
C       UGLY               50             40             10              0
C 
C   END DBSPA 
C 
CCCCC 
C 
C  POSSIBLY BAD STATUS: 
C 
CCCCC 
C 
C   IMAGE/1000 DATA BASE SPACE UTILITY
C 
C   DATA SET NAME    CAPACITY    FREE RECORDS    RECORDS USED    DIFFERENCE 
C   -------------    --------    ------------    ------------    ---------- 
C 
C       GOOD             1001            985             17             -1
C       BAD              1001            984             16              1
C       UGLY               50             40             10              0
C 
C   DATA BASE MAY NOT BE GOOD 
C 
C   END DBSPA 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      DIMENSION IBUF(350),IBASE(11),LEVEL(3),ISTAT(10)
      DIMENSION URECS(50),DIFF(50),IOUTB(36)
      DIMENSION IHED1(36),IHED2(36),IWARN(13),IEND(5) 
      DIMENSION IOERR(15),LKERR(17),IGTER(20),IOPER(15) 
      DIMENSION IDSER(25) 
C 
      INTEGER OUTLU 
      LOGICAL IFTTY 
C 
      COMMON IBUF,NSETS,IBASE 
      COMMON LOGLN,LEVEL,INLU,OUTLU,LULOG 
      COMMON IOUTB
C 
      EQUIVALENCE (IDUM,LEVEL),(NAME,IOUTB(3))
C 
      DATA MAXLN/-80/,IOUTL/-72/,IBLNK/2H  /
      DATA IHED1/2H D,2HAT,2HA ,2HSE,2HT ,2HNA,2HME,2H  ,2H  ,2HCA, 
     2           2HPA,2HCI,2HTY,2H  ,2H  ,2HFR,2HEE,2H R,2HEC,2HOR, 
     3           2HDS,2H  ,2H  ,2HRE,2HCO,2HRD,2HS ,2HUS,2HED,2H  , 
     4           2H  ,2HDI,2HFF,2HER,2HEN,2HCE/ 
      DATA IHED2/2H -,2H--,2H--,2H--,2H--,2H--,2H--,2H  ,2H  ,2H--, 
     2           2H--,2H--,2H--,2H  ,2H  ,2H--,2H--,2H--,2H--,2H--, 
     3           2H--,2H  ,2H  ,2H--,2H--,2H--,2H--,2H--,2H--,2H  , 
     4           2H  ,2H--,2H--,2H--,2H--,2H--/ 
      DATA IWARN/2H D,2HAT,2HA ,2HBA,2HSE,2H M,2HAY,2H N,2HOT,
     2           2H B,2HE ,2HGO,2HOD/ 
      DATA IWRNL/13/
      DATA IEND/2H E,2HND,2H D,2HBS,2HPA/ 
      DATA IENDL/5/ 
      DATA IOERR/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H O,2HN ,2HOU, 
     2           2HTP,2HUT,2H: ,2H  ,2H  /
      DATA IOELN/15/
      DATA LKERR/2H/D,2HBS,2HPA,2H -,2H U,2HNA,2HBL,2HE ,2HTO,2H L, 
     2           2HOC,2HK ,2HOU,2HTP,2HUT,2H L,2HU /
      DATA LKERL/17/
      DATA IGTER/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H: ,2H  ,2H  , 
     2           2H  ,2HON,2H D,2HAT,2HA ,2HSE,2HT ,2H  ,2H  ,2H  / 
      DATA IGTLN/20/
      DATA IOPER/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H: ,2H  ,2H  , 
     2           2H  ,2HON,2H D,2HBO,2HPN/
      DATA IOPLN/15/
      DATA IDSER/2H/D,2HBS,2HPA,2H -,2H U,2HNA,2HBL,2HE ,2HTO,2H O, 
     2           2HBT,2HAI,2HN ,2HIN,2HFO,2HRM,2HAT,2HIO,2HN ,2HON, 
     3           2H D,2HAT,2HA ,2HSE,2HTS/
      DATA IDSLN/25/
      DATA ICAPC/9/,IFREE/16/,IUSED/24/,IDIF/32/
C 
C 
C  GET THE SCHEDULING PARAMETERS AND THE LENGTH OF THE PARAMETER STRING 
C  IN POSITIVE BYTES. 
C 
      CALL GETST(IBUF,MAXLN,LOGLN)
C 
C  ASK PARST TO PARSE THE PARAMETERS STRING.  IT CAN CONTAIN UP TO FOUR 
C  PARAMETERS WHICH ARE:
C            1)  INPUT LU 
C            2)  OUTPUT LU
C            3)  DATA BASE ROOT FILE NAMR 
C            4)  USER'S LEVEL CODE WORD 
C  PARST STORES THESE PARAMETERS RESPECTIVELY IS: 
C            1)  INLU 
C            2)  OUTLU
C            3)  IBASE
C            4)  LEVEL
C  IT WILL DEFAULT THE FIRST TWO IF UNSPECIFIED, AND PROMPT FOR THE LATTER
C  TWO IF UNSPECIFIED.  IN ADDITION, PARST SETS UP THE VARIABLE LULOG TO
C  CONTAIN THE PROPER LU FOR ERROR MESSAGE LOGGING.  IF IT ENCOUNTERS ANY 
C  ERROR, PARST RETURNS A NON-ZERO VALUE IN ISTAT; >0 IF AN ILLEGAL LU
C  NUMBER SPECIFIED IN RUN STRING; <0 FOR ANY OTHER ERROR.
C 
      CALL PARST(ISTAT) 
        IF (ISTAT(1).LT.0) GO TO 900
        IF (ISTAT(1).GT.0) GO TO 1000 
C 
C  OPEN THE DATA BASE.  TRY IT FIRST WITH MODE 1, IF THAT DOESN'T WORK, 
C  TRY IT WITH MODE 8.  IF NEITHER WORK, GIVE UP. 
C 
      MODE=1
10    CALL DBOPN(IBASE,LEVEL,MODE,ISTAT)
        IF (ISTAT(1).EQ.0) GO TO 25 
          IF (MODE.EQ.8)  GO TO 7000
            IF (ISTAT(1).NE.152) GO TO 7000 
              MODE = 8
              GO TO 10
C 
C  GET THE NUMBER OF DATA SETS THE USER HAS ACCESS TO AND ALL THEIR CAPA- 
C  CITIES THROUGH GETSZ.  IT RETURNS THIS INFORMATION IN IBUF IN THE FOL- 
C  LOWING FORMAT: 
C           WORD     +------------------------------+ 
C             1      |  DOUBLE WORD NUMBER OF FREE  | 
C             2      |  RECORDS IN FIRST DATA SET   | 
C                    -------------------------------- 
C             3      |    FIRST DATA                | 
C             4      |            SET'S             | 
C             5      |                NAME          | 
C                    -------------------------------- 
C             6      |    DOUBLEWORD CAPACITY OF    | 
C             7      |       FIRST DATA SET         | 
C                    -------------------------------- 
C             .                    .
C             .                    .
C             .                    .
C                    -------------------------------- 
C         N*7-6      |  DOUBLEWORD NUMBER OF FREE   | 
C         N*7-5      |    RECORDS IN NTH DATA SET   | 
C                    -------------------------------- 
C         N*7-4      |       NTH DATA               | 
C         N*7-3      |             SET'S            | 
C         N*7-2      |                NAME          | 
C                    -------------------------------- 
C         N*7-1      |    DOUBLEWORD CAPACITY OF    | 
C           N*7      |         NTH DATA SET         | 
C                    +------------------------------+ 
C 
C  WHERE N IS THE NUMBER OF DATA SETS THE USER HAS ACCESS TO.  THERE IS 
C  A MAXIMUM OF 50 DATA SETS.  GETSZ RETURNS THE NUMBER OF DATA SETS
C  DESCRIBED IN IBUF IN NSETS.  IF IT ENCOUNTERS ANY ERROR, GETSZ RETURNS 
C  A NON-ZERO VALUE IN ISTAT. 
C 
25    CALL GETSZ(ISTAT) 
        IF (ISTAT(1).NE.0) GO TO 5000 
          IF (NSETS.LE.0) GO TO 5000
C 
C  SET UP A LOOP, FOR EACH DATA SET ACCESSIBLE BY THE USER, TO DETERMINE
C  THE NUMBER OF USED RECORDS IN THE DATA SET.  THIS NUMBER IS DETERMINED 
C  BY DOING SERIAL READS ON THE DATA SET, COUNTING EACH RECORD RETURNED 
C  AS A USED RECORD.
C 
      DO 100 I=1,NSETS
        URECS(I) = 0
50      CALL DBGET(IBASE,IBUF(I*7-4),2,ISTAT,0,IDUM,IDUM) 
          IF (ISTAT(1).EQ.12) GO TO 100 
            IF (ISTAT(1).NE.0) GO TO 4000 
              URECS(I) = DAD(URECS(I),DBLEI(1)) 
              GO TO 50
100   CONTINUE
C 
C  SET UP A LOOP, FOR EACH DATA SET ACCESSIBLE BY THE USER, TO DETERMINE
C  THE DIFFERENCE BETWEEN THE CAPACITY OF THE DATA SET AND THE SUM OF THE 
C  NUMBER OF FREE RECORDS PLUS THE NUMBER OF USED RECORDS.  IF ANY OF THE 
C  DATA SET RECORDS DO NOT ADD UP, THEN SET A FLAG INDICATING POSSIBLE
C  CORRUPT DATA BASE. 
C 
      IFLAG = 0 
      DO 200 I=1,NSETS
        DIFF(I) = DSB(IBUF(I*7-1),DAD(IBUF(I*7-6),URECS(I)))
        IF (DCO(DIFF(I),DBLEI(0))) 60,70,60 
60        IFLAG = -1
70      CONTINUE
200   CONTINUE
C 
C  SET UP TO PRINT OUT THE ATTAINED INFORMATION.  FIRST, FILL THE OUTPUT
C  BUFFER WITH BLANKS, THEN LOCK THE OUTPUT LU IF IT IS NOT A TTY-LIKE
C  DEVICE, AND FINALLY, PRINT OUT THE HEADER: 
C 
C  DATA SET NAME    CAPACITY    FREE RECORDS    RECORDS USED    DIFFERENCE
C  -------------    --------    ------------    ------------    ----------
      CALL SFILL(IOUTB,1,-IOUTL,IBLNK)
      IF (IFTTY(OUTLU)) GO TO 300 
        CALL LURQ(40001B,OUTLU,1) 
          GO TO 3000
300   CALL EXEC(100002B,OUTLU,IHED1,IOUTL)
        GO TO 2000
310   CALL EXEC(100002B,OUTLU,IHED2,IOUTL)
        GO TO 2000
320   CALL EXEC(100002B,OUTLU,IBLNK,1)
        GO TO 2000
C 
C  LOOP ON EACH DATA SET PRINTNG OUT: 
C      1)  THE DATA SET'S NAME
C      2)  THE DATA SET'S CAPACITY
C      3)  THE NUMBER OF FREE RECORDS IN THE DATA SET 
C      4)  THE NUMBER OF USED RECORDS IN THE DATA SET 
C      5)  THE CALCULATED DIFFERENCE
C  AFTER EACH SET OF FIVE DATA SETS A BLANK LINE IS PRINTED FOR READABILITY.
C 
330   DO 500 I=1,NSETS
C  MOVE NAME INTO OUTPUT BUFFER 
        CALL SMOVE(IBUF(I*7-4),1,6,NAME,1)
C  CONVERT CAPACITY INTO ASCII AND PUT INTO OUTPUT BUFFER.
        CALL CNVRT(IBUF(I*7-1),ICAPC) 
C  CONVERT FREE RECORDS TO ASCII AND PUT INTO OUTPUT BUFFER.
        CALL CNVRT(IBUF(I*7-6),IFREE) 
C  CONVERT USED RECORDS TO ASCII AND PUT INTO OUTPUT BUFFER.
        CALL CNVRT(URECS(I),IUSED)
C  CONVERT DIFFERENCE TO ASCII AND PUT INTO OUTPUT BUFFER.
        CALL CNVRT(DIFF(I),IDIF)
C  WRITE THIS DATA SET'S INFORMATION OUT. 
        CALL EXEC(100002B,OUTLU,IOUTB,IOUTL)
          GO TO 2000
C  AFTER FIFTH DATA SET, IN A ROW, WRITE A BLANK LINE.
400     IF (MOD(I,5).NE.0) GO TO 500
          CALL EXEC(100002B,OUTLU,IBLNK,1)
            GO TO 2000
500   CONTINUE
C 
C  DONE WITH ALL DATA SET.  IF IFLAG IS NON-ZERO, PRINT THE WARNING:
C 
C  DATA BASE MAY NOT BE GOOD - TRY PROGRAM 'RECOV'
C 
      IF (IFLAG.EQ.0) GO TO 700 
        CALL EXEC(100002B,OUTLU,IBLNK,1)
          GO TO 2000
550     CALL EXEC(100002B,OUTLU,IWARN,IWRNL)
          GO TO 2000
C 
C  UNLOCK THE OUTPUT DEVICE, CLOSE THE DATA BASE, PRINT THE STOP MESSAGE: 
C 
C  END DBSPA
C 
C  AND TERMINATE. 
C 
700   CALL LURQ(100000B,OUTLU,1)
800   CALL DBCLS(IBASE,IDUM,1,ISTAT)
900   CALL EXEC(2,OUTLU,IBLNK,1)
      CALL EXEC(2,OUTLU,IEND,IENDL) 
1000  STOP
C 
C  ERROR HANDLERS.
C 
C  OUTPUT ERROR.  PRINT MESSAGE:
C 
C  /DBSPA - ERROR ON OUTPUT: AABB 
C         WHERE AABB IS THE CONTENTS OF THE A & B REGISTERS FROM THE
C            EXEC WRITE CALL RESPECTIVELY.
C 
2000  CALL ABREG(IOERR(14),IOERR(15)) 
      CALL EXEC(100002B,LULOG,IOERR,IOELN)
        GO TO 2050
2025  GO TO 700 
C 
2050  CALL EXEC(100002B,1,IOERR,IOELN)
        GO TO 700 
2075  GO TO 700 
C 
C  LURQ ERROR.  PRINT MESSAGE:
C 
C  /DBSPA - UNABLE TO LOCK OUTPUT LU
C 
3000  CALL EXEC(100002B,LULOG,LKERR,LKERL)
        GO TO 2000
3010  GO TO 800 
C 
C  DBGET ERROR.  PRINT MESSAGE: 
C 
C  /DBSPA - ERROR XXX ON DATA SET YYYYY 
C            WHERE XXX IS THE ERROR CODE PASSED BACK BY DBGET IN ISTAT
C               AND YYYYY IS THE NAME OF THE DATA SET CURRENTLY BEING READ. 
C 
4000  CALL CNUMD(ISTAT(1),IGTER(8)) 
      DO 4050 J=1,3 
        IGTER(J+17) = IBUF(I*7-5+J) 
4050  CONTINUE
      CALL EXEC(100002B,LULOG,IGTER,IGTLN)
        GO TO 2000
4060  GO TO 800 
C 
C  NO DATA SET ACCESSIBLE BY USER OR INFORMATION ON SETS UNOBTAINABLE.
C  PRINT MESSAGE: 
C 
C  /DBSPA - UNABLE TO OBTAIN INFORMATION ON DATA SET
C 
5000  CALL EXEC(100002B,LULOG,IDSER,IDSLN)
        GO TO 2000
5010  GO TO 800 
C 
C  DBOPN ERROR.  PRINT MESSAGE: 
C 
C  /DBSPA - ERROR XXX ON DBOPN
C          WHERE XXX IS THE ERROR CODE PASSED BACK BY DBOPN IN ISTAT. 
C 
7000  CALL CNUMD(ISTAT(1),IOPER(8)) 
      CALL EXEC(100002B,LULOG,IOPER,IOPLN)
        GO TO 2000
7010  GO TO 900 
      END 
C 
C 
C  SUBROUTINE CNVRT.  THIS SUBROUTINE TAKES A DOUBLE WORD INTEGER VALUE 
C  AND CONVERTS IT INTO A 10 CHARACTER ASCII STRING SUPPRESSING LEADING 
C  ZEROES.  THE ASCII VALUE IS PUT INTO THE OUTPUT BUFFER FOR DBSPA WITH
C  THE PROPER SIGN PRECEDING THE FIRST NON-ZERO CHARACTER.  NEGATIVE
C  VALUES ARE PRECEDED BY A NEGATIVE SIGN, POSITIVE WITH A BLANK. 
C 
C  THE CALLING SEQUENCE FOR CNVRT IS: 
C 
C         CALL CNVRT(VALUE,INDEX) 
C 
C  WHERE VALUE
C        IS THE DOUBLE WORD INTEGER VALUE TO CONVERT
C        INDEX
C        IS AN INTEGER INDEX INTO THE OUTPUT BUFFER FOR THE LOCATION AT 
C        WHICH THE CONVERTED STRING IS TO BEGIN 
C 
      SUBROUTINE CNVRT(VALUE,INDEX) 
C 
      DIMENSION IOUTB(36),IBUF(350),IBASE(11),LEVEL(3)
C 
      INTEGER OUTLU 
C 
      COMMON IBUF,NSETS,IBASE 
      COMMON LOGLN,LEVEL,INLU,OUTLU,LULOG 
      COMMON IOUTB
C 
C  DETERMINE PROPER SIGN FOR ASCII STRING.  ALSO, IF THE VALUE IS NEGATIVE, 
C  MAKE IT POSITIVE FOR DCITA.
C 
      ISIGN = 40B 
      IF (DCO(VALUE,DBLEI(0))) 10,20,20 
10      VALUE = DNG(VALUE)
        ISIGN = 55B 
C 
C  ASK DCITA TO DO THE DOUBLE INTEGER TO ASCII CONVERSION AND SET THE 
C  RETURNED VALUE INTO THE PROPER POSITION IN THE OUTPUT BUFFER.  THIS
C  VALUE MAY CONTAIN LEADING ZEROES.
C 
20    CALL DCITA(VALUE,IOUTB(INDEX))
C 
C  REPLACE ALL LEADING ZEROES WITH BLANKS.
C 
      DO 50 I=1,9 
        CALL SGET(IOUTB(INDEX),I,ICHAR) 
        IF (ICHAR.NE.60B) GO TO 60
          CALL SPUT(IOUTB(INDEX),I,40B) 
50    CONTINUE
      I = 9 
C 
C  INSERT PROPER SIGN INTO OUTPUT BUFFER. 
C 
60    CALL SPUT(IOUTB(INDEX-1),I+1,ISIGN) 
      RETURN
      END 
C 
C 
C  SUBROUTINE GETSZ.  GETSZ BUILDS AN INFORMATION BUFFER FOR DBSPA CON- 
C  SISTING OF THE NAMES OF ALL THE DATA SETS ACCESSIBLE BY THE USER, THEIR
C  CAPACITIES, AND THE COUNTS OF THEIR FREE RECORDS.  THE BUFFER THIS 
C  INFORMATION IS PUT INTO IS IBUF AND THE NUMBER OF DATA SETS DESCRIBED
C  IN IBUF IS PUT INTO NSETS.  THE INFORMATION IN IBUF IS FORMATTED AS
C  FOLLOWS: 
C           WORD     +------------------------------+ 
C             1      |  DOUBLE WORD NUMBER OF FREE  | 
C             2      |  RECORDS IN FIRST DATA SET   | 
C                    -------------------------------- 
C             3      |    FIRST DATA                | 
C             4      |            SET'S             | 
C             5      |                NAME          | 
C                    -------------------------------- 
C             6      |    DOUBLEWORD CAPACITY OF    | 
C             7      |       FIRST DATA SET         | 
C                    -------------------------------- 
C             .                    .
C             .                    .
C             .                    .
C                    -------------------------------- 
C         N*7-6      |  DOUBLEWORD NUMBER OF FREE   | 
C         N*7-5      |    RECORDS IN NTH DATA SET   | 
C                    -------------------------------- 
C         N*7-4      |       NTH DATA               | 
C         N*7-3      |             SET'S            | 
C         N*7-2      |                NAME          | 
C                    -------------------------------- 
C         N*7-1      |    DOUBLEWORD CAPACITY OF    | 
C           N*7      |         NTH DATA SET         | 
C                    +------------------------------+ 
C 
C  WHERE N IS THE NUMBER OF DATA SETS THE USER HAS ACCESS TO.  THERE IS 
C  A MAXIMUM OF 50 DATA SETS. 
C 
C  THE CALLING SEQUENCE FOR GETSZ IS: 
C 
C         CALL GETSZ(ISTAT) 
C 
C  WHERE ISTAT
C        IS AN INTEGER VARIABLE IN WHICH A STATUS CODE IS RETURNED
C          = 0 IF BUFFER SUCCESSFULLY BUILT 
C          <> 0 IF ANY ERROR IS ENCOUNTERED.
C 
      SUBROUTINE GETSZ(ISTAT) 
C 
      DIMENSION IBUF(350),ISTAT(10),IBASE(11),INFO(17)
C 
      COMMON IBUF,NSETS,IBASE 
C 
      EQUIVALENCE (USED,INFO(14)),(CAPAC,INFO(16))
C 
      NSETS = 0 
C 
C  GET THE COUNT OF ALL THE DATA SETS THE USER HAS ACCESS TO AND THEIR
C  RESPECTIVE DATA SET NUMBERS. 
C 
      CALL DBINF(IBASE,0,203,ISTAT,IBUF(300)) 
        IF (ISTAT(1).NE.0) GO TO 200
          IF (IBUF(300).LE.0) GO TO 200 
C 
C  FOR EACH DATA SET IN THE LIST, GET ITS NAME, CAPACITY AND NUMBER OF
C  USED RECORDS.  THEN, BUILD THE NEXT ENTRY IN IBUF DETERMINING THE
C  NUMBER OF FREE RECORDS BY SUBTRACTING THE NUMBER OF USED RECORDS FROM
C  THE CAPACITY.
C 
      NSETS = IBUF(300) 
      ICNT = 0
      DO 100 I=1,NSETS
        ISNO = IABS(IBUF(300+I))
        CALL DBINF(IBASE,ISNO,202,ISTAT,INFO) 
          IF (ISTAT(1).NE.0) GO TO 200
        FREE = DSB(CAPAC,USED)
        CALL SMOVE(FREE,1,4,IBUF(ICNT*7+1),1) 
        CALL SMOVE(INFO,1,6,IBUF(ICNT*7+3),1) 
        CALL SMOVE(CAPAC,1,4,IBUF(ICNT*7+6),1)
        ICNT = ICNT + 1 
100   CONTINUE
      NSETS = ICNT
200   RETURN
      END 
C 
C 
C  SUBROUTINE PARST.  PARST TAKES THE RUN STRING GIVEN DBSPA AND PARSES 
C  IT INTO ITS CONPONENTS.  PARST ALSO RESOLVES ANY UNSPECIFIED PARAMETERS
C  AND DETERMINES THE LU TO USE IN LOGGING ERROR MESSAGES.  THE RUN STRING
C  CAN CONTAIN UP TO FOUR PARAMETERS WHICH ARE AS FOLLOWS:
C            1)  INPUT LU 
C            2)  OUTPUT LU
C            3)  DATA BASE ROOT FILE NAMR 
C            4)  USER'S LEVEL CODE WORD 
C  PARST STORES THESE PARAMETERS RESPECTIVELY IS: 
C            1)  INLU 
C            2)  OUTLU
C            3)  IBASE
C            4)  LEVEL
C  IT WILL DEFAULT THE FIRST TWO IF UNSPECIFIED, AND PROMPT FOR THE LATTER
C  TWO IF UNSPECIFIED.  IN ADDITION, PARST SETS UP THE VARIABLE LULOG TO
C  CONTAIN THE PROPER LU FOR ERROR MESSAGE LOGGING. 
C 
C  THE CALLING SEQUENCE FOR PARST IS: 
C 
C         CALL PARST(ISTAT) 
C 
C  WHERE ISTAT
C        IS A VARIABLE IN WHICH A STATUS CODE IS RETURNED 
C        = 0 IF PARSE WAS SUCCESSFUL
C        > 0 IF AN ILLEGAL LU SPECIFIED IN RUN STRING 
C        < 0 IF ANY OTHER ERROR WAS ENCOUNTERED 
C 
      SUBROUTINE PARST(ISTAT) 
C 
      DIMENSION IPBUF(10),IBUF(350),IBASE(11),LEVEL(3),IHEDR(18)
      DIMENSION INERR(15),INMRE(21),IOERR(15),IRFPT(13),ILCWP(13) 
      DIMENSION ILLUE(10) 
C 
      INTEGER OUTLU 
      LOGICAL IFTTY 
C 
      COMMON IBUF,NSETS,IBASE 
      COMMON LOGLN,LEVEL,INLU,OUTLU,LULOG 
C 
      DATA IBLNK/2H  /
      DATA IHEDR/2H I,2HMA,2HGE,2H/1,2H00,2H0 ,2HDA,2HTA,2H B,2HAS, 
     2           2HE ,2HSP,2HAC,2HE ,2HUT,2HIL,2HIT,2HY / 
      DATA IHEDL/18/
      DATA IRFPT/2H/D,2HBS,2HPA,2H: ,2HRO,2HOT,2H F,2HIL,2HE ,2HNA, 
     2           2HMR,2H? ,2H _/
      DATA ILCWP/2H/D,2HBS,2HPA,2H: ,2HLE,2HVE,2HL ,2HCO,2HDE,2H W, 
     2           2HOR,2HD?,2H _/
      DATA IPRML/13/
      DATA INMRE/2H/D,2HBS,2HPA,2H -,2H I,2HLL,2HEG,2HAL,2H O,2HR , 
     2           2HMI,2HSS,2HIN,2HG ,2HRO,2HOT,2H F,2HIL,2HE ,2HNA, 
     3           2HMR/
      DATA INMRL/21/
      DATA INERR/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H O,2HN ,2HIN, 
     2           2HPU,2HT:,2H  ,2H  ,2H  /
      DATA IOERR/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H O,2HN ,2HOU, 
     2           2HTP,2HUT,2H: ,2H  ,2H  /
      DATA IOELN/15/
      DATA ILLUE/2H/D,2HBS,2HPA,2H -,2H I,2HLL,2HEG,2HAL,2H L,2HU./ 
      DATA ILLUL/10/
C 
C 
C  SET ERROR LOGGING LU TO 1. 
C 
      LULOG = 1 
C 
C  DETERMINE THE INPUT LU FROM THE SCHEDULING STRING.  IF UNSPECIFIED,
C  CALL LOGLU TO GET IT.  IF SPECIFIED, MAKE SURE IT'S LEGAL. 
C 
      ISTRT = 1 
      IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 20,10 
10      IF ((IAND(IPBUF(4),003B).EQ.1).AND.(IPBUF(1).GE.0)
     &       .AND.(IPBUF(1).LE.255B)) GO TO 30
        IF (IPBUF(4).NE.0) GO TO 500
20      IPBUF(1) = LOGLU(IDUM)
30    INLU = IPBUF(1) 
C 
C  DETERMINE OUTPUT LU FROM SCHEDULING STRING.  IF UNSPECIFIED, THEN IF 
C  THE INPUT LU IS INTERACTIVE, THEN DEFAULT THE OUTPUT LU TO THE INPUT 
C  LU, ELSE DEFAULT THE OUTPUT LU TO 6.  IF SPECIFIED, MAKE SURE ITS LEGAL. 
C 
      IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 60,50 
50      IF ((IAND(IPBUF(4),003B).EQ.1).AND.(IPBUF(1).GE.0)
     &       .AND.(IPBUF(1).LE.255B)) GO TO 70
        IF (IPBUF(4).NE.0) GO TO 500
60        IPBUF(1) = 6
          IF (IFTTY(INLU)) IPBUF(1) = INLU
70    OUTLU = IPBUF(1)
C 
C  DETERMINE THE ERROR LOGGING LU.  IF INPUT LU IS INTERACTIVE, THEN THE
C  LOGGING LU BECOMES THE INPUT LU, ELSE IT REMAINS LU 1. 
C 
      IF (IFTTY(INLU)) LULOG = INLU 
C 
C  PRINT OUT THE HEADER:
C 
C    IMAGE/1000 DATA BASE SPACE UTILITY 
C 
      CALL EXEC(100002B,OUTLU,IBLNK,1)
        GO TO 3000
80    CALL EXEC(100002B,OUTLU,IHEDR,IHEDL)
        GO TO 3000
85    CALL EXEC(100002B,OUTLU,IBLNK,1)
        GO TO 3000
C 
C  GET THE DATA BASE ROOT FILE'S NAMR.  IF NOT SPECIFIED IN THE RUN STRING, 
C  THEN IF THE INPUT LU IS INTERACTIVE, PROMPT FOR THE NAMR AND READ THE
C  REPLY, ELSE JUST DO THE READ.
C 
90    IBASE(1) = IBLNK
      IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 110,100 
100     IF (IAND(IPBUF(4),3).EQ.0) GO TO 110
          NCHARS = 0
          IF (INAMR(IPBUF,IBASE(2),20,NCHRS)) 1000,150
C 
110     IF (IFTTY(INLU)) 120,130
120       CALL EXEC(100002B,INLU,IRFPT,IPRML) 
            GO TO 2000
130     NCHRS = -20 
        CALL EXEC(100001B,INLU+400B,IBASE(2),NCHRS) 
          GO TO 2000
135   CALL ABREG(IA,IB) 
        IF (IB.NE.0) GO TO 140
          IF (IFTTY(INLU)) 120,1000 
140     NCHRS = IB
150   CALL SPUT(IBASE(2),NCHRS+1,IBLNK) 
C 
C  GET THE USER'S LEVEL CODE WORD.  IF NOT SPECIFIED IN THE RUN STRING, 
C  THEN IF THE INPUT LU IS INTERACTIVE, PROMPT FOR THE WORD AND READ THE
C  REPLY, ELSE JUST DO THE READ.
C 
      IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 210,200 
200     IF (IPBUF(4).EQ.0) GO TO 210
          CALL SMOVE(IPBUF,1,6,LEVEL,1) 
          GO TO 300 
210     IF (IFTTY(INLU)) 220,230
220       CALL EXEC(100002B,INLU,ILCWP,IPRML) 
            GO TO 2000
230       CALL SFILL(LEVEL,1,6,IBLNK) 
          CALL EXEC(100001B,INLU,LEVEL,3) 
            GO TO 2000
C 
C  SET STATUS WORD TO ZERO UPON SUCCESSFUL COMPLETION AND RETURN. 
C 
300   ISTAT = 0 
      RETURN
C 
C  ERROR HANDLERS.
C 
C  ILLEGAL LU IN RUN STRING. PRINT MESSAGE: 
C 
C  /DBSPA - ILLEGAL LU. 
C 
500   CALL EXEC(100002B,LULOG,ILLUE,ILLUL)
        GO TO 6000
750   GO TO 6000
C 
C  UNABLE TO OBTAIN ROOT FILE NAMR OR NAMR SPECIFIED IS ILLEGAL.  PRINT 
C  MESSAGE: 
C 
C  /DBSPA - ILLEGAL OR MISSING ROOT FILE NAMR 
C 
1000  CALL EXEC(100002B,LULOG,INMRE,INMRL)
        GO TO 5000
1500  GO TO 5000
C 
C  ERROR ON I/O CALL TO INPUT DEVICE.  PRINT MESSAGE: 
C 
C  /DBSPA - ERROR ON INPUT AABB 
C           WHERE AABB IS THE CONTENTS OF THE A & B REGISTERS FROM THE
C              EXEC I/O CALL RESPECTIVELY.
C 
2000  CALL ABREG(INERR(14),INERR(15)) 
      CALL EXEC(100002B,LULOG,INERR,IOELN)
        GO TO 5000
2500  GO TO 5000
C 
C  ERROR ON I/O CALL TO OUTPUT DEVICE.  PRINT MESSAGE:
C 
C    /DBSPA - ERROR ON OUTPUT AABB
C             WHERE AABB IS AS ABOVE. 
C 
3000  CALL ABREG(IOERR(14),IOERR(15)) 
      CALL EXEC(100002B,LULOG,IOERR,IOELN)
        GO TO 5000
3500  GO TO 5000
C 
C  SET STATUS WORD TO -1 ON ERROR AND RETURN. 
C 
5000  ISTAT = -1
      RETURN
6000  ISTAT = 1 
      RETURN
      END 
      END$
                                                                                                                          