FTN4
      PROGRAM RECOV(4,99),92069-16134 REV.2013 791214 
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-18134
C     RELOC:     92069-16134
C 
C     PRGMR:     JC,CEJ,CSN 
C 
C 
C****************************************************************** 
C 
C 
C 
C ********************************************************************
C                          *** COMMON *** 
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C                         DECLARATIONS
C 
      INTEGER       LUIN,LIST,LULOG 
      INTEGER       INBUF(561),NMBUF(10),LINE,PBUF(5) 
      INTEGER       DBCOP,COTBL,COSIZ,ENTSZ 
      INTEGER       DNODE,RDTBL,BPSIZ,BPNAM,BPNOD 
      INTEGER       ILENG,ISTRC,FCODE,ERROR,QWAIT,GET 
      INTEGER       NULL,DASH,BLANK,STAR,SHFT8
      INTEGER       MNAME(3),MNODE
C 
      LOGICAL       QUIT,YES,IFTTY,RMOTE
C 
      INTEGER       MSG1(27),MSG2(7),MSG5(13),MSG9(5),MSG10(10) 
      COMPLEX       MSG3(2),MSG4,MSG6(3),MSG7(6),MSG8(3)
      COMPLEX       IMHDR(3)
C 
C 
      DATA          QWAIT/23/,GET/21/,NULL/-1/,SHFT8/256/ 
      DATA          DASH/2H--/,BLANK/2H  /,STAR/2H**/ 
C 
      DATA  IMHDR /8HIMAGE/10,8H00 RECOV,8H UTILITY/
      DATA  MSG1  /2HWO,2HUL,2HD ,2HYO,2HU ,2HLI,2HKE,2H T,2HO ,
     &             2HCL,2HEA,2HN ,2HUP,2H A,2HFT,2HER,2H A,2H P,
     &             2HRO,2HGR,2HAM,2H (,2HYE,2HS/,2HNO,2H) ,2H _/
      DATA  MSG2  /2HPR,2HOG,2HRA,2HM ,2HNA,2HME,2H _/
      DATA  MSG3  /8HBAD PROG,8HRAM NAME/ 
      DATA  MSG4  /8HDONE.   /
      DATA  MSG5  /2HDA,2HTA,2H B,2HAS,2HE ,2H  ,2H  ,2H  ,2H R,
     &             2HEL,2HEA,2HSE,2HD./ 
      DATA  MSG6  /8HCLEAN UP,8H UNSUCCE,8HSSFUL.  /
      DATA  MSG7  /8HUNABLE T,8HO OBTAIN,8H CURRENT,8H DATA BA, 
     &             8HSE INFOR,8HMATION. / 
      DATA  MSG8  /8HUNABLE T,8HO LOCK L,8HIST LU. /
      DATA  MSG9  /2HEN,2HD ,2HRE,2HCO,2HV./
      DATA  MSG10 /2H/R,2HEC,2HOV,2H -,2H I,2HLL,2HEG,2HAL,2H L,2HU./ 
C 
C ********************************************************************
C                          SUBROUTINES
C 
C   DSPLA -DISPLAYS THE CURRENT DATA BASE ENTRIES IN DBCOP'S
C          COORDINATING TABLE AND, IF AVAILABLE, THE REMOTE MASTERS 
C          ASSOCIATED WITH RDBAP COPIES FROM RDBAM'S TABLE. 
C 
C   FINDB -FINDS AND RETURNS ALL THE DATA BASE NAMES AND CRNS ASSOCIATED
C          WITH THE PROGRAM WHOSE NAME IS ENTERED BY THE USER IN RE-
C          SPONSE TO THE QUERY: PROGRAM NAME? 
C 
C   SERCH -FINDS AND RETURNS THE NAME AND NODE NUMBER OF THE MASTER 
C          PROGRAM ASSOCIATED WITH AN REBAP COPY. 
C 
C   ANSWR -INPUTS A USER'S (YES/NO) RESPONSE AND RETURNS LOGICAL T/F. 
C 
C   PUT   -PERFORMS AN EXEC CALL FOR OUTPUT TO A DEVICE.
C 
C   INPUT -PERFORMS AN EXEC CALL FOR INPUT FROM A DEVICE. 
C 
C   RMNF  -GETS A COPY OF THE RDBAP SCHEDULING TABLE IF AVAILABLE 
C          AND RETURNS THE VALUE TRUE, ELSE RETURNS THE VALUE FALSE 
C 
C   RMCLN -SENDS A CLEAN-UP MESSAGE TO RDBAM FOR A SPECIFIC MASTER
C          PROGRAM. 
C 
C ********************************************************************
C                       *** SAMPLE OUTPUT *** 
C 
C  ***
C   NO REMOTE DATA BASE ACCESS
C  ***
C 
C   IMAGE/1000 RECOV UTILITY
C 
C   *********************************************** 
C      DB NAME      CART #      MODE      OPEN TO 
C   ----------------------------------------------- 
C 
C         DB1           12         3        PROG1 
C 
C         DB2           49         1        PROG2 
C                                           PROG3 
C                                           PROG4 
C 
C         DB3         1003         8        DBSPA 
C 
C   *********************************************** 
C 
C   END RECOV 
C 
C *** 
C  WITH REMOTE DATA BASE ACCESS 
C *** 
C   IMAGE 1000 RECOV UTILITY
C 
C   ********************************************************************
C      DB NAME      CART #      MODE      OPEN TO      MASTER      NODE 
C   --------------------------------------------------------------------
C 
C         DB1          12         3        PROG1
C 
C         RB4           4         1        RDB02        PROG8        8
C                                          PROG2
C 
C         RB9           9         8        RDB03        PROG2        2
C                                          DBSPA
C 
C   ********************************************************************
C 
C   END RECOV 
C 
C ********************************************************************
C                       *** INITIALIZATION ***
      COSIZ = 20
      ENTSZ = 27
      DBCOP(1) = 2HDB 
      DBCOP(2) = 2HCO 
      DBCOP(3) = 2HP
      BPSIZ = 8 
      BPNAM = 4 
      BPNOD = 3 
C ********************************************************************
C                          *** MAIN *** 
C     RETRIEVE INVOKING PARAMETERS FROM COMMAND STRING
C 
      CALL GETST(INBUF,-80,ILENG) 
      ISTRC = 1 
C 
C     GET INPUT DEVICE
C 
      IF (NAMR(NMBUF,INBUF,ILENG,ISTRC)) 4,3
C 
C     SKIP TO 5 IF NAMR(COMMAND STRING) YIELDED NON-NULL LEGAL LUIN DEVICE
C 
3     IF ((IAND(NMBUF(4),003B).EQ.1).AND.(NMBUF(1).GE.0)
     &     .AND.(NMBUF(1).LE.255B)) GO TO 5 
        NMBUF(1) = -2 
        IF (NMBUF(4).NE.0) GO TO 5
C 
C       SET THE INPUT DEVICE TO -1 FOR EASY DEFAULT LATER.
C 
4       NMBUF(1) = -1 
5     LUIN = NMBUF(1) 
C 
C     GET LIST DEVICE 
C 
      IF (NAMR(NMBUF,INBUF,ILENG,ISTRC)) 9,8
C 
C     SKIP TO 10 IF LIST NON-NULL AND LEGAL 
C 
8     IF ((IAND(NMBUF(4),003B).EQ.1).AND.(NMBUF(1).GE.0)
     &     .AND.(NMBUF(1).LE.255B)) GO TO 10
        NMBUF(1) = -2 
        IF (NMBUF(4).NE.0) GO TO 10 
C 
C     FOR DEFAULT OF LIST DEVICE BELOW, SET LIST DEVICE TO -1 NOW.
C 
9       NMBUF = -1
C 
10    LIST = NMBUF(1) 
C     GET SCHEDULER'S NODE NUMBER.  IF DEFAULTED OR EQUAL TO THE LOCAL
C       NODE, SET IT TO -1. 
C 
      CALL NAMR(NMBUF,INBUF,ILENG,ISTRC)
        IF (IAND(NMBUF(4),003B).NE.1) NMBUF(1) = -1 
        IF (NMBUF(1).EQ.NODE(IDUM)) NMBUF(1) = -1 
15    DNODE = NMBUF(1)
C 
C     SET ERROR LOGGING LU TO 1 FOR NOW.
C 
      LULOG = 1 
C 
C     NOW SET THE DEFAULT INPUT DEVICE.  IF LUIN IS -1, THEN IF REMOTE
C       SCHEDULE, DEFAULT IT TO 1, ELSE CALL LOGLU.  IF LUIN IS -2, 
C       BRANCH TO PRINT ERROR MESSAGE.
C 
      IF (LUIN.GE.0) GO TO 16 
      IF (LUIN.EQ.-2) GO TO 300 
      LUIN = 1
      IF (DNODE.NE.-1) GO TO 16 
      LUIN = LOGLU(IDUM)
C 
C     NOW SET THE DEFAULT LIST DEVICE.  IF LIST IS -1, THEN IF LUIN IS
C       INTERACTIVE OR REMOTE, SET LIST TO IT, ELSE SET LIST TO 6.
C       IF LIST IS -2, BRANCH TO PRINT ERROR MESSAGE. 
C 
16    IF (LIST.GE.0) GO TO 18 
      IF (LIST.EQ.-2) GO TO 300 
      LIST = 6
      IF (DNODE.NE.-1) GO TO 17 
        IF (.NOT.IFTTY(LUIN)) GO TO 18
17    LIST = LUIN 
C 
C     DETERMINE THE LU OF THE DEVICE TO WHICH ANY ERRORS ARE LOGGED.
C       THIS IS LUIN, IF INTERACTIVE OR REMOTE, ELSE IT REMAINS LU 1. 
C 
18    IF (DNODE.NE.-1) GO TO 19 
        IF (.NOT.IFTTY(LUIN)) GO TO 20
19    LULOG = LUIN
C 
C     IF THE INPUT DEVICE IS NOT INTERACTIVE AND NOT REMOTE, JUST PRINT 
C       OUT THE TABLE AND TERMINATE.
C 
20    IF (DNODE.NE.-1) GO TO 25 
      IF (IFTTY(LUIN))  GO TO 25
        CALL DSPLA(ERROR) 
        GO TO 100 
25    CONTINUE
C 
C     INPUT DEVICE IS INTERACTIVE.  PUT OUT RECOV HEADER. 
C 
      CALL PUT(BLANK,LUIN,1,ERROR)
        IF (ERROR.NE.0) GO TO 130 
      CALL PUT(IMHDR,LUIN,12,ERROR) 
        IF (ERROR.NE.0) GO TO 130 
      QUIT = .FALSE.
C 
C     DO WHILE(QUITFLAG=FALSE)
C 
30    IF (QUIT)  GO TO 120
C 
C       DISPLAY THE CURRENT COORDINATING TABLE- EXIT WHILE ON ERROR 
C 
        CALL DSPLA(ERROR) 
        IF (ERROR.NE.0) GO TO 100 
C 
C       ASK IF USER WANTS TO CLEAN UP AFTER A PROGRAM.
C 
        CALL PUT(MSG1,LUIN,27,ERROR)
        IF (ERROR.NE.0) GO TO 130 
        CALL ANSWR(YES,ERROR) 
        IF (ERROR.NE.0) GO TO 130 
        IF (.NOT.YES) GO TO 80
C 
C         ASK FOR PROGRAM NAME. 
C 
          DO 35 I=1,3 
            NMBUF(I) = 2H 
35        CONTINUE
          CALL PUT(MSG2,LUIN,7,ERROR) 
          IF (ERROR.NE.0) GO TO 130 
          ILENG = 3 
          CALL INPUT(NMBUF,ILENG,ERROR) 
          IF (ERROR.NE.0) GO TO 130 
C 
C       MAKE SURE PROGRAM IS IN OUR LIST AND GET ITS ASSOCIATED DATA BASE 
C         NAMES AND CRNS. 
C 
      CALL FINDB(NMBUF,INBUF,ERROR) 
        IF (ERROR.NE.0) GO TO 78
C 
C       SEE IF PROGRAM TO CLEAN-UP AFTER IS AN RDBAP COPY.  THE FIRST 
C         THREE CHARACTERS OF THE NAME ARE 'RDB' IN THIS CASE.
C 
      IF (.NOT.RMOTE) GO TO 50
        IF (NMBUF(1).NE.2HRD)  GO TO 50 
        IF (IOR(IAND(NMBUF(2),177400B),40B).NE.2HB )  GO TO 50
C 
C       AN RDBAP COPY, GET ITS MASTER'S NAME AND NODE NUMBER THEN SEND A
C       MESSAGE TO RDBAM TO REMOVE IT.
C 
          CALL SERCH(NMBUF,MNAME,MNODE,ERROR) 
            IF (ERROR.NE.0) GO TO 50
          CALL RMCLN(MNAME,MNODE,ERROR) 
            IF (ERROR.NE.0) GO TO 70
C 
C    FOR EACH DATA BASE NAME IN INBUF:
C 
C           SCHEDULE DBCOP(NO ABORT) TO DELETE COORD TABLE ENTRY
C 
50    CONTINUE
      DO 67 K=1,561,4 
        IF (INBUF(K).EQ.NULL) GO TO 68
            FCODE = 3 * SHFT8 
            CALL EXEC(QWAIT+100000B,DBCOP,FCODE,INBUF(K),INBUF(K+1),
     &               INBUF(K+2),INBUF(K+3),NMBUF,3) 
               GO TO 70 
60          ERROR = 0 
            CALL RMPAR(PBUF)
C 
C           CHECK PBUF(1) ERROR FLAG
C 
          IF (PBUF(1).EQ.0) GO TO 65
          IF (PBUF(1).NE.103)  GO TO 70 
            GO TO 67
C 
C             PRINT DB RELEASED IF #USERS=0 
C 
65            IF (PBUF(2).GT.0) GO TO 67
                CALL SMOVE(INBUF(K),1,6,MSG5,11)
                CALL PUT(MSG5,LUIN,13,ERROR)
                  IF (ERROR.NE.0) GO TO 130 
67            CONTINUE
C 
C    PRINT CLEAN-UP DONE MESSAGE. 
C 
68        CONTINUE
          CALL PUT(MSG4,LUIN,4,ERROR) 
            IF (ERROR.NE.0) GO TO 130 
          GO TO 90
C 
C             PRINT CLOSURE UNSUCCESSFUL MESSAGE. 
C 
70            CALL PUT(MSG6,LUIN,12,ERROR)
                IF (ERROR.NE.0) GO TO 130 
              GO TO 90
75          CONTINUE
          CONTINUE
C 
C         PRINT BAD PROGRAM NAME MESSAGE. 
C 
78          CALL PUT(MSG3,LUIN,8,ERROR) 
              IF (ERROR.NE.0) GO TO 130 
            GO TO 90
C 
C         ELSE (IF DON'T WANT TO CLEAN UP AFTER A PROGRAM)
C 
80        QUIT = .TRUE. 
        CONTINUE
90    CONTINUE
      GO TO 30
C 
C     END WHILE 
C 
100   CONTINUE
      IF (ERROR.EQ.0) GO TO 120 
C 
C     INCASE(ERROR) 
C 
        IF (ERROR.NE.1) GO TO 110 
          CALL PUT(MSG7,LULOG,24,ERROR) 
          GO TO 120 
C 
110     IF (ERROR.NE.2) GO TO 130 
          CALL PUT(MSG8,LULOG,12,ERROR) 
120   CONTINUE
C 
C     END INCASE
C 
C     PRINT END MESSAGE IF LUIN IS REMOTE AND/OR INTERACTIVE. 
C 
      IF (RMOTE) GO TO 125
      IF (.NOT.IFTTY(LUIN)) GO TO 130 
125   CALL PUT(MSG9,LUIN,5,ERROR) 
130   CONTINUE
      STOP
C 
C     HERE ON AN ILLEGAL LU NUMBER IN RUN STRING.  PRINT ERROR MESSAGE: 
C 
C     /RECOV - ILLEGAL LU.
C 
C     AND STOP. 
C 
300   CALL PUT(MSG10,LULOG,10,ERROR)
      GO TO 130 
      END 
C 
C 
C 
C 
      SUBROUTINE DSPLA(ERR) 
C 
C ********************************************************************
C                           *** COMMON ***
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C 
      INTEGER       COTBL,COSIZ,ENTSZ,LINE,PBUF(5),DBCOP
      INTEGER       DNODE,RDTBL,BPSIZ,BPNAM,BPNOD 
      INTEGER       ASCII(3),FCODE,QWAIT,GET,CLASS,EBASE,NULL,ERR,LIST
      INTEGER       TBLEN,SHFT8 
      INTEGER       ENAME,UNLCK 
      LOGICAL       RMNF,RMOTE,IFTTY
      COMPLEX       TBHDR(6)
C 
      DIMENSION     MNAME(3)
C 
C ********************************************************************
C 
      DATA           LOCK/040001B/,UNLCK/140000B/ 
        DATA        QWAIT/23/,GET/21/,DASH/2H--/,BLANK/2H  /,STAR/2H**/ 
        DATA        NULL/-1/,SHFT8/256/ 
        DATA  TBHDR/8HDB NAME ,8H CART # ,8H   MODE ,8H OPEN TO,
     &               8H  MASTER,8H   NODE / 
C ********************************************************************
C 
C 
C     SCHEDULE DBCOP TO ACCESS COORDINATING TABLE.
C 
      FCODE = -1
      CALL EXEC(QWAIT+100000B,DBCOP,FCODE)
          GO TO 50
10    CALL RMPAR(PBUF)
C 
C     TEST FOR DBCOP ERROR
C 
      IF (PBUF(1).NE.0) GO TO 50
      CLASS = IAND(PBUF(2),017777B) 
C 
C     GET COPY OF COORD TABLE FROM SAM. 
C 
      CALL EXEC(GET+100000B,CLASS,COTBL,COSIZ*ENTSZ)
          GO TO 50
C 
C     IF OUTPUT DEVICE NON-INTERACTIVE, LOCK IT.
C 
20    IF (IFTTY(LIST))  GO TO 21
        IF (DNODE.NE.-1)  GO TO 21
          CALL LURQ(LOCK,LIST,1)
            GO TO 55
C 
C     DETERMINE IF WE CAN PRINT REMOTE DATA BASE ACCESS INFORMATION.
C       IF SO, MAKE A COPY OF THE RDBAP COPY TABLE AND SET OUR FLAGS, 
C       AND OUTPUT LENGTH.
C 
21    RMOTE = RMNF(RDTBL) 
      LINLN = 16
      IF (RMOTE) LINLN = 24 
C 
C     PRINT HEADER: 
C 
C  ***********************************************[*******************] 
C     DB NAME      CART #      MODE      OPEN TO  [   MASTER     NODE ] 
C  -----------------------------------------------[-------------------] 
C 
C     WHERE THE CHARACTERS IN BRACKETS ([]) ARE PRINTED ONLY IF WE CAN
C     REPORT ON REMOTE ACCESS.
C 
      CALL PUT(BLANK,LIST,1,ERR)
        IF (ERR.NE.0) GO TO 60
      CALL SFILL(LINE,1,LINLN*2,STAR) 
      CALL PUT(LINE,LIST,LINLN,ERR) 
        IF (ERR.NE.0) GO TO 60
      CALL PUT(TBHDR,LIST,LINLN,ERR)
        IF (ERR.NE.0) GO TO 60
      CALL SFILL(LINE,1,LINLN*2,DASH) 
      CALL PUT(LINE,LIST,LINLN,ERR) 
        IF (ERR.NE.0) GO TO 60
      CALL PUT(BLANK,LIST,1,ERR)
        IF (ERR.NE.0) GO TO 60
C 
      CALL SFILL(LINE,1,LINLN*2,BLANK)
C 
C     PRINT COORDINATING TABLE
C 
C     PRINT EVERY NON-NULL ENTRY OF THE COORD TABLE 
C 
      TBLEN = COSIZ*ENTSZ 
      DO 40 EBASE=1,TBLEN,ENTSZ 
        IF (COTBL(EBASE).EQ.NULL) GO TO 40
C         BUFF UP DBNAME
          CALL SMOVE(COTBL(EBASE),1,6,LINE,2) 
C         BUF UP CARTRIDGE #
          CALL CNUMD(COTBL(EBASE+3),ASCII)
          CALL SMOVE(ASCII,1,6,LINE,10) 
C         BUFF UP OPEN MODE (IN LEFT BYTE)
          CALL CNUMD(COTBL(EBASE+4)/SHFT8,ASCII)
          CALL SMOVE(ASCII,1,6,LINE,17) 
C         BUFF UP FIRST USER PROGRAM NAME IN THIS LINE
          DO 30 ENAME=EBASE+6,EBASE+ENTSZ-3,3 
            IF (COTBL(ENAME).EQ.NULL) GO TO 30
              CALL SMOVE(COTBL(ENAME),1,6,LINE,27)
C             IF WE ARE PRINTING REMOTE MONITOR PROGRAMS, SEE IF A MASTER 
C               FOR THIS PROGRAM EXISTS.
              IF (.NOT.RMOTE) GO TO 25
                CALL SERCH(COTBL(ENAME),MNAME,MNODE,ERR)
                IF (ERR.NE.0) GO TO 25
C               A MASTER PROGRAM, BUFF UP ITS NAME
                CALL SMOVE(MNAME,1,6,LINE,35) 
C               BUFF UP MASTER'S NODE NUMBER
                CALL CNUMD(MNODE,ASCII) 
                CALL SMOVE(ASCII,1,6,LINE,42) 
C           PRINT OUT LINE OF INFORMATION 
25          CONTINUE
            CALL PUT(LINE,LIST,LINLN,ERR) 
              IF (ERR.NE.0) GO TO 60
C           FILL LINE WITH BLANKS 
            CALL SFILL(LINE,1,LINLN*2,BLANK)
C         CONTINUE FOR ALL NAMES IN THIS ENTRY
30        CONTINUE
C       PRINT ONE BLANK LINE AFTER EACH DATA BASE 
        CALL PUT(BLANK,LIST,1,ERR)
          IF (ERR.NE.0) GO TO 60
40    CONTINUE
C 
C     END DO
C 
      CALL SFILL(LINE,1,LINLN*2,STAR) 
      CALL PUT(LINE,LIST,LINLN,ERR) 
        IF (ERR.NE.0) GO TO 60
      CALL PUT(BLANK,LIST,1,ERR)
        IF (ERR.NE.0) GO TO 60
      ERR = 0 
C 
C     UNLOCK LIST DEVICE
C 
      CALL LURQ(UNLCK,LIST,1) 
        GO TO 60
48    GO TO 60
C 
C     BRANCH HERE FOR DSPLA ERROR CASE: ERR = 1 
C 
50    ERR = 1 
      GO TO 60
C 
C     BRANCH HERE FOR LU LOCK ERROR CASE: ERR = 2 
C 
55    ERR = 2 
60    CONTINUE
      RETURN
      END 
C 
C 
C 
C 
      SUBROUTINE FINDB(NMBUF,INBUF,ERROR) 
C 
C ********************************************************************
C                           *** COMMON ***
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C 
C 
      INTEGER ERROR,EBASE,ENTSZ,COSIZ,INBUF 
      INTEGER DNODE,DBCOP,RDTBL,BPSIZ,BPNAM,BPNOD 
      INTEGER NMBUF,ENAME,COTBL 
C 
      LOGICAL RMOTE 
C 
      DIMENSION NMBUF(3),INBUF(80)
C 
      DATA NULL/-1/ 
C 
      ERROR = -1
      J = 1 
      DO 50 EBASE=1,ENTSZ*COSIZ,ENTSZ 
        IF (COTBL(EBASE).EQ.NULL)  GO TO 50 
          DO 40 ENAME=EBASE+6,EBASE+ENTSZ-3,3 
            IF (COTBL(ENAME).EQ.NULL) GO TO 40
            IF (JSCOM(COTBL(ENAME),1,6,NMBUF,1,ERROR).NE.0) GO TO 40
              CALL SMOVE(COTBL(EBASE),1,8,INBUF,J)
              ERROR = 0 
              J = J + 8 
40        CONTINUE
50    CONTINUE
      INBUF((J+1)/2) = -1 
      RETURN
      END 
C 
C 
C 
C 
      SUBROUTINE SERCH(PNAME,MNAME,MNODE,ERROR) 
C 
C ********************************************************************
C                             *** COMMON ***
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C 
      INTEGER PNAME,ERROR,ENTRY 
      INTEGER COTBL,COSIZ,ENTSZ,DNODE,DBCOP 
      INTEGER RDTBL,BPSIZ,BPNAM,BPNOD 
C 
      LOGICAL RMOTE 
C 
      DIMENSION PNAME(3),MNAME(3) 
C 
      DO 50 ENTRY=1,BPSIZ*COSIZ,BPSIZ 
        IF (RDTBL(ENTRY).EQ.0)  GO TO 50
          IF (JSCOM(RDTBL(ENTRY+BPNAM),1,6,PNAME,1,ERROR).NE.0) GO TO 50
            CALL SMOVE(RDTBL(ENTRY),1,6,MNAME,1)
            MNODE = RDTBL(ENTRY+BPNOD)
            ERROR = 0 
            GO TO 100 
50    CONTINUE
      ERROR = -1
100   RETURN
      END 
C 
C 
C 
C 
      SUBROUTINE PUT(BUF,DEST,LEN,ERROR)
C 
C ********************************************************************
C                           *** COMMON ***
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C 
      INTEGER       BUF(40),DEST,LEN,FCODE,ERROR
      INTEGER       COTBL,COSIZ,ENTSZ,DNODE,DBCOP 
      INTEGER       RDTBL,BPSIZ,BPNAM,BPNOD 
C 
      LOGICAL       RMOTE 
      COMPLEX       ERMSG(2)
      DATA          ERMSG /8HRECOV OU,8HTPUT ERR/ 
  
      FCODE = 2 
      IF (DNODE.NE.-1)  GO TO 7 
      CALL EXEC(FCODE+100000B,DEST+200B,BUF,LEN)
        GO TO 10
5     ERROR = 0 
      RETURN
C 
7     CONTINUE
      CALL DEXEC(DNODE,FCODE+100000B,DEST+200B,BUF,LEN) 
        GO TO 10
8     ERROR = 0 
      RETURN
C 
10    ERROR = -1
      IF (DNODE.EQ.-1) GO TO 15 
        CALL DEXEC(DNODE,FCODE+100000B,201B,ERMSG,8)
          GO TO 15
13      GO TO 20
15    CALL EXEC(FCODE,201B,ERMSG,8) 
20    RETURN
      END 
C 
C 
C 
      SUBROUTINE INPUT(BUF,LEN,ERROR) 
C 
C ********************************************************************
C                            *** COMMON *** 
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C       INPUTS A MAXIMUM OF (+LEN) WORDS OR (-LEN) CHARACTERS 
        INTEGER     BUF(40),ERROR,LEN,AREG,BREG,QMARK 
        INTEGER     COTBL,COSIZ,ENTSZ,DNODE,DBCOP 
        INTEGER     RDTBL,BPSIZ,BPNAM,BPNOD 
C 
        LOGICAL     RMOTE 
C 
        COMPLEX     ERMSG(2)
        DATA        ERMSG /8HRECOV IN,8HPUT ERR / 
        DATA        QMARK/2H?_/ 
C 
C       TRUNCATE INPUT REQUEST IF LARGER THAN BUFFER
C 
        IF (LEN.GT.40)  LEN = 40
        IF (LEN.LT.-80) LEN = -80 
C 
      IF (DNODE.NE.-1) GO TO 3
        CALL EXEC(100002B,LUIN,QMARK,1) 
          GO TO 10
1       CALL EXEC(100001B,LUIN+400B,BUF,LEN)
          GO TO 10
2       GO TO 5 
C 
3     CALL DEXEC(DNODE,100001B,LUIN+4400B,BUF,LEN,QMARK,1)
        GO TO 10
5       CALL ABREG(AREG,BREG) 
        LEN = BREG
        ERROR = 0 
        RETURN
C 
10      ERROR = -1
        CALL EXEC(2,201B,ERMSG,8) 
        RETURN
      END 
C 
C 
C 
      SUBROUTINE ANSWR(REPLY,ERROR) 
C 
C ********************************************************************
C                           *** COMMON ***
C 
      COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) 
      COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD 
C 
C ********************************************************************
C 
        INTEGER     YES,NO,RESP(2),ERROR      
        INTEGER     COTBL,COSIZ,ENTSZ,DNODE,DBCOP 
        INTEGER     RDTBL,BPSIZ,BPNAM,BPNOD 
C 
        LOGICAL     REPLY,RMOTE 
C 
        DATA        YES/2HYE/ 
        DATA        NO /2HNO/ 
C 
        REPLY = .FALSE. 
10      LEN=2 
        CALL INPUT(RESP,LEN,ERROR)
          IF (ERROR.NE.0) RETURN
        IF ((RESP.EQ.YES).OR.(RESP.EQ.NO)) GO TO 20 
        GO TO 10
20      CONTINUE
        IF (RESP.EQ.YES) REPLY= .TRUE.
        RETURN
      END 
      END$