FTN 
      PROGRAM ROOT2(5,90),92069-16015 REV.2026 800124 
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
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18028
C     RELOC:     92069-16015
C 
C 
C****************************************************************:
C 
C 
C ABSTRACT: 
C 
C THIS IS THE FINAL SEGMENT OF DBDS 
C IT CREATES THE SET FILES AND ROOT FILE
C WHEN "ROOT", AND "SETS" ARE SPECIFIED.
C 
C ROOT WILL NOT CREATE THE DATA SETS WHEN THE "NOROOT" OPTION 
C OR THE "NOSET" OPTIONS ARE USED.
C 
C ROOT FIRST CREATES THE DATA SETS AND WRITES ZEROS IN ALL
C THE RECORDS IN THE MASTER DATA SETS AND LINKS THE FREE
C SPACE LIST TOGETHER IN THE DETAIL DATA SETS.
C 
C ROOT THEN CREATES THE DATA BASE ROOT FILE AND WRITES THE
C OVERHEAD RECORD TO THE FIRST 128 WORD RECORD AND THE
C FREE SPACE POINTERS IN THE SECOND ( AND POSSIBLIY THIRD)
C RECORDS OF THE ROOT FILE, THEN WRITES THE RUN TABLE 
C TO THE REST OF THE FILE.
C 
C 
C 
C 
      INTEGER BUFF(144) 
      INTEGER SPTR
      INTEGER ERR1(20)
      INTEGER INAM(3) 
      INTEGER IERR(4) 
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980  
C 
C 
C                      CONSTANTS IN INTEGER 
C 
C 
C 
      INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 
     1       CAP,CNTRL,COLON,COMMA,CRDLM, 
     2       DATA,DETAIL,DOLLR,DOT, 
     3       ELSE,END,ENTY,EQUAL,ERR, 
     4       FIELD, 
     5       ICODE,INTGR,ITM, 
     6       LEVL,LPARN,LST,
     7       MANU,MXCAP,MAXRC,
     8       MXELE,MXENT,MXITM,MXLEV,MXSTR, 
     9       NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO,
     C       NOLST,NORES,NOTAB, 
     1       OPSET, 
     2       PMAX,
     3       ROOTR,RPARN, 
     4       SEMI,SET,SMAX, 
     5       UPPER
C 
C 
C 
C 
C                      DATA BASE OFFSETS
C 
C 
C 
      INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP,
     1       DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 
     2       DBLVE
C 
C 
C 
C                     ITEM TABLE OFFSETS
C 
C 
C 
      INTEGER ITNME,ITINF,ITTYP,ITSCT,
     1       ITSNO,ITECT,ITLNG,ITMSZ,ITMST
C 
C 
C                     DATA SET TABLE OFFSETS
C 
C 
      INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT,
     1       DSITP,DSCAP,DSCCT,DSPAN,SETSZ
C 
C 
C 
C               OFFSET TO OVERHEAD RECORD 
C 
C 
C 
      INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC 
C 
C 
C 
C              ERROR MESSAGES 
C 
C 
      INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 
     1       DUPIT,ITLIM,ILITP,FLDER,ILXTP, 
     2       ILWR,ILTRM,NAMX,DUPST,STLIM, 
     3       ENTYX,NOITM,BDSET,BDKEY,DUPHS, 
     4       NOPTH,AERR,RCLIM,CAPX,ILCAP, 
     5       EMPTY,MXERR,EOF,NOSEG,NOMEM, 
     6       DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 
     7       ILRD,ILRNG,SETX,IGNSC,INMX,
     8       PTDUP,DBKEY,ENDX,PDEFC,SIMPT,
     9       BDCNT,RTERR,GOODS,GOODR,BADS,
     C       BADR,ABORT,OPNER,XCNTR,ILLVN,
     1       SRCH2,UEND,XITM,ELERR,ROTER, 
     2       UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 
     3       ILLSC,MORIT,ILPTH,DEFIT, 
     4       ILSRT,SIMPS,UNDST
C 
C 
C                 VARIABLES 
C 
C 
C 
      INTEGER CARD,CHAR,CODE,CRDPR
      REAL CPACK
      INTEGER DSEC,DCRN 
      INTEGER ENTL,ERROR
      LOGICAL NMFLG 
      INTEGER FWAM
      INTEGER GGERR 
      INTEGER ICNT,IDCB,INDX
      INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB
      INTEGER KPACK 
      INTEGER LDCB,LGLOB,LIST,LWAM
      INTEGER MEDIA 
      INTEGER NPACK,NSETS 
      INTEGER OVRHD 
      INTEGER PTHTB 
      INTEGER RDEF,RESNO,RFILE,RINDX
      INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE
      INTEGER TYPE,PRGFLG 
C 
C 
C    EXTERNAL REFERENCES
C 
C 
      INTEGER ROOTA 
C 
C                      CONSTANTS IN COMMON
C 
C 
C 
      COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 
     1       CAP,CNTRL,COLON,COMMA,CRDLM, 
     2       DATA,DETAIL,DOLLR,DOT, 
     3       ELSE,END,ENTY,EQUAL,ERR, 
     4       FIELD, 
     5       ICODE,INTGR,ITM, 
     6       LEVL,LPARN,LST,
     7       MANU,MXCAP(2),MAXRC, 
     8       MXELE,MXENT,MXITM,MXLEV,MXSTR, 
     9       NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10),
     C       NFO(10), 
     C       NOLST,NORES,NOTAB, 
     1       OPSET, 
     2       PMAX,
     3       ROOTR,RPARN, 
     4       SEMI,SET,SMAX, 
     5       UPPER
C 
C 
C 
C 
C                      DATA BASE OFFSETS
C 
C 
C 
      COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 
     1       DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 
     2       DBLVE
C 
C 
C 
C                     ITEM TABLE OFFSETS
C 
C 
C 
      COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 
     1       ITSNO,ITECT,ITLNG,ITMSZ,ITMST
C 
C 
C                     DATA SET TABLE OFFSETS
C 
C 
      COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 
     1       DSITP,DSCAP,DSCCT,DSPAN,SETSZ
C 
C 
C 
C               OFFSET TO OVERHEAD RECORD 
C 
C 
C 
      COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC
C 
C 
C 
C              ERROR MESSAGES 
C 
C 
      COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV,
     1       DUPIT,ITLIM,ILITP,FLDER,ILXTP, 
     2       ILWR,ILTRM,NAMX,DUPST,STLIM, 
     3       ENTYX,NOITM,BDSET,BDKEY,DUPHS, 
     4       NOPTH,AERR,RCLIM,CAPX,ILCAP, 
     5       EMPTY,MXERR,EOF,NOSEG,NOMEM, 
     6       DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 
     7       ILRD,ILRNG,SETX,IGNSC,INMX,
     8       PTDUP,DBKEY,ENDX,PDEFC,SIMPT,
     9       BDCNT,RTERR,GOODS,GOODR,BADS,
     C       BADR,ABORT,OPNER,XCNTR,ILLVN,
     1       SRCH2,UEND,XITM,ELERR,ROTER, 
     2       UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 
     3       ILLSC,MORIT,ILPTH,DEFIT, 
     4       ILSRT,SIMPS,UNDST
C 
C 
C                 VARIABLES 
C 
C 
C 
      COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR 
      COMMON DSEC,DCRN
      COMMON ENTL,ERROR 
      COMMON NMFLG
      COMMON FWAM 
      COMMON GGERR
      COMMON ICNT,IDCB(144),INDX
      COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB
      COMMON KPACK(50)
      COMMON LDCB(144),LGLOB,LIST,LWAM
      COMMON MEDIA
      COMMON NPACK(50),NSETS(50)
      COMMON OVRHD
      COMMON PTHTB(32)
      COMMON RDEF(64),RESNO,RFILE(3),RINDX
      COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE
      COMMON TYPE,PRGFLG
C 
C 
C    EXTERNAL REFERENCES
C 
C 
      EXTERNAL ROOTA
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980
C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB
C 
C 
C IS THE ROOT FILE REQUESTED? 
C 
      NDX = NFONX(ROOTR)
      IF (INFO(NDX) .NE. NFO(ROOTR)) GOTO 20
C 
C YES, THEN WAS THERE ANY ERRORS? 
C 
      IF (ERROR .NE. 0) CALL ERXIT(RTERR) 
C 
C WERE SETS REQUESTED?
C 
      NDX = NFONX(OPSET)
      IF (INFO(NDX) .EQ. NFO(OPSET)) GOTO 10
C 
C CREATE THE DATA SET FILES 
C 
      CALL DBCRT(FWAM,BUFF,PRGFLG,IERR) 
      IF (IERR .LT. 0) GOTO 7010
      CALL OUTPT(GOODS) 
C 
C CREATE THE ROOT FILE
C 
10    CONTINUE
      IF(PRGFLG .EQ. 0) GOTO 15 
      CALL PURGE(BUFF,IERR,RFILE,DSEC,DCRN) 
C 
C 
15    CONTINUE
      SIZE = DBLEI(((OVRHD/2)+127)/128+3) 
      CALL ECREA(BUFF,IERR,RFILE,SIZE,1,DSEC,DCRN)
      IF (IERR .LT.0) GOTO 7020 
C 
C WRITE THE ROOT FILE OUT 
C 
      CALL WRITR(IERR,BUFF) 
C 
C CLOSE THE ROOT FILE 
C 
      CALL CLOSE(BUFF)
      IF(IERR .LT. 0) GOTO 7020 
      CALL OUTPT(GOODR) 
C 
C TERMINATE THE PROCESSING
C 
20    CONTINUE
      CALL ERXIT(0) 
C 
C 
C ERROR PROCESSORS
C 
C 
C 
C PURGE ALL THE DATA SETS CREATED BY DBCRT
C OUTPUT "I/O ERROR XX ON DATA SET XXXXXX"
C OUTPUT "I/O ERROR - ALL DATA SETS NOT CREATED"
C 
7010  CONTINUE
      CALL EMESS(BADS)
C 
C DELETE ALL THE DATA SETS
C 
7011  CONTINUE
      SPTR = ROOTA(DBSTP) * 2 
      ISCT = ROOTA(DBSCT) 
C 
C PURGE ALL THE DATA SETS CREATED BY DBCRT, STARTING WITH THE 
C FIRST DATA SET IN THE DATA SET TABLE.  STOP WHEN THE
C DATA SET IN ERROR IS REACHED. 
C 
      DO 7012 I = 0,ISCT-1
      INAM = ROOTA(SPTR+DSNME)
      INAM(2) = ROOTA(SPTR+DSNME+2) 
      INAM(3) = ROOTA(SPTR+DSNME+4) 
      ICR = ROOTA(SPTR+DSCRN) 
      SPTR = SPTR+SETSZ 
C 
C IF THIS IS NOT THE DATA SET WITH THE ERROR THEN PURGE IT
C 
      IF(JSCOM(IERR,3,8,INAM,1,IERR2) .EQ. 0) GOTO 7013 
      CALL PURGE(BUFF,IERR2,INAM,DSEC,ICR)
7012  CONTINUE
C 
C TELL THE USER THE BAD DATA SET
C    GET THE MESSAGE USING GMESS
C    PUT THE CONVERTED I/O ERROR CODE INTO THE MESSAGE
C    PUT THE DATA SET NAME INTO THE MESSAGE 
C    THEN PRINT THE MESSAGE 
C 
7013  CONTINUE
      CALL GMESS(IOERR,ERR1,ISZ)
      CALL CITA(IERR,ERR1(7)) 
      CALL SMOVE(IERR,3,8,ERR1,29)
      CALL OUTLN(ERR1,ISZ)
      GOTO 20 
C 
C OUTPUT "ROOT NOT CREATED" 
C   AND TERMINATE 
C 
7020  CALL EMESS(BADR)
      CALL SMOVE(RFILE,1,6,IERR,3)
      GOTO 7011 
      END