LOGICAL*1 FUNCTION INMAP (C)
      LOGICAL*1 C
      INMAP = C
      RETURN
      END
      LOGICAL*1 FUNCTION OUTMAP(C)
      LOGICAL*1 C
      OUTMAP = C
      RETURN
      END
      LOGICAL*1 FUNCTION GETCH(C, F)
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      LOGICAL*1 C
      INTEGER F, GETS, N, COUNT
      INTEGER INMAP
      LOGICAL*1 RGETCH
      IF(.NOT.(CHTYPE(F) .EQ. 1))GOTO 23000
      GETCH = RGETCH(C, F)
      RETURN
23000 CONTINUE
      IF(.NOT.(MODE(F) .NE. 0))GOTO 23002
      LASTC(F) = 0
      MODE(F) = 0
23002 CONTINUE
      N = LASTC(F)
      IF(.NOT.(N .EQ. 0 .OR. BUFFER(N, F) .EQ. 10 .OR. N .GE. 400))GOTO 
     *23004
      COUNT = GETS(FDB(F), BUFFER(1, F), 399)
      IF(.NOT.(COUNT .LT. 0))GOTO 23006
      GETCH = -1
      C = -1
      RETURN
23006 CONTINUE
      BUFFER(COUNT+1, F) = 10
      LASTC(F) = 0
23004 CONTINUE
      LASTC(F) = LASTC(F) + 1
      N = LASTC(F)
      C = BUFFER(N,F)
      GETCH = C
      RETURN
      END
      SUBROUTINE PUTCH(C, F)
      LOGICAL*1 C, OUTMAP
      INTEGER F, I, N
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(CHTYPE(F) .EQ. 1))GOTO 23008
      CALL RPUTCH(C, 1, F)
      RETURN
23008 CONTINUE
      IF(.NOT.(MODE(F) .NE. 1))GOTO 23010
      MODE(F) = 1
      LASTC(F) = 0
23010 CONTINUE
      N = LASTC(F)
      IF(.NOT.(N .GE. 400 .OR. C .EQ. 10))GOTO 23012
      CALL PUTS(FDB(F), BUFFER(1,F), N)
      LASTC(F) = 0
23012 CONTINUE
      IF(.NOT.(C .NE. 10))GOTO 23014
      LASTC(F) = LASTC(F) + 1
      N = LASTC(F)
      BUFFER(N, F) = C
23014 CONTINUE
      RETURN
      END
      SUBROUTINE PUTLIN (B, F)
      LOGICAL*1 B(100)
      INTEGER F, I
      INTEGER LENGTH
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(CHTYPE(F) .EQ. 1))GOTO 23016
      I = LENGTH(B)
      CALL RPUTCH(B, I, F)
      GOTO 23017
23016 CONTINUE
      I=1
23018 IF(.NOT.(B(I) .NE. 0))GOTO 23020
      CALL PUTCH (B(I), F)
23019 I=I+1
      GOTO 23018
23020 CONTINUE
23017 CONTINUE
      RETURN
      END
      INTEGER FUNCTION GETLIN (LINE, F)
      LOGICAL*1 LINE(100)
      INTEGER F, I
      INTEGER GETS
      LOGICAL*1 GETCH
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(LASTC(F) .NE. 0 .AND. CHTYPE(F) .NE. 1))GOTO 23021
      I=1
23023 CONTINUE
      IF(.NOT.(GETCH(LINE(I), F) .EQ. 10))GOTO 23026
      LINE(I+1) = 0
      GETLIN = I
      RETURN
23026 CONTINUE
      IF(.NOT.(LINE(I) .EQ. -1))GOTO 23028
      GETLIN = -1
      LINE(I) = 0
      RETURN
23028 CONTINUE
      IF(.NOT.(I .GE. 400-1))GOTO 23030
      LINE(I+1) = 0
      GETLIN = I
      RETURN
23030 CONTINUE
23024 I=I+1
      GOTO 23023
23025 CONTINUE
      GOTO 23022
23021 CONTINUE
      IF(.NOT.(MODE(F) .NE. 0))GOTO 23032
      MODE(F) = 0
23032 CONTINUE
      LASTC(F) = 0
      I = GETS(FDB(F), LINE, 399)
      IF(.NOT.(I .LT. 0))GOTO 23034
      GETLIN = -1
      LINE(1) = 0
      GOTO 23035
23034 CONTINUE
      IF(.NOT.(I .LT. 399))GOTO 23036
      LINE(I+1) = 10
      LINE(I+2) = 0
      GETLIN = I + 1
      GOTO 23037
23036 CONTINUE
      LINE(400) = 0
      GETLIN = 399
23037 CONTINUE
23035 CONTINUE
23022 CONTINUE
      RETURN
      END
      INTEGER FUNCTION GETARG (N, ARRAY, MAXSIZ)
      LOGICAL*1 ARRAY(100)
      INTEGER N, MAXSIZ
      COMMON /CARG/ NBRARG, PTR(25), ARG(256)
      INTEGER NBRARG, PTR
      LOGICAL*1 ARG
      IF(.NOT.(N .GE. NBRARG))GOTO 23038
      ARRAY(1) = 0
      GETARG = -1
      RETURN
23038 CONTINUE
      INDEX = PTR(N+1)
      I=1
23040 IF(.NOT.(I .LT. MAXSIZ))GOTO 23042
      ARRAY(I) = ARG(INDEX)
      IF(.NOT.(ARG(INDEX) .EQ. 0))GOTO 23043
      GOTO 23042
23043 CONTINUE
      INDEX = INDEX + 1
23041 I=I+1
      GOTO 23040
23042 CONTINUE
      GETARG = I-1
      ARRAY(I) = 0
      RETURN
      END
      INTEGER FUNCTION INSUB (ARG, FILE)
      LOGICAL*1 ARG(100), FILE(100)
      IF(.NOT.(ARG(1) .EQ. 60 .AND. ARG(2) .NE. 0))GOTO 23045
      INSUB = 1
      CALL SCOPY (ARG, 2, FILE, 1)
      GOTO 23046
23045 CONTINUE
      INSUB = 0
23046 CONTINUE
      RETURN
      END
      INTEGER FUNCTION OUTSUB(C, ARG, FILE, ACCESS)
      LOGICAL*1 ARG(100), FILE(100), C
      INTEGER ACCESS, I
      OUTSUB = 0
      IF(.NOT.(ARG(1) .EQ. C))GOTO 23047
      IF(.NOT.(ARG(2) .EQ. C))GOTO 23049
      IF(.NOT.(ARG(3) .NE. 0))GOTO 23051
      ACCESS = 4
      OUTSUB = 1
      I = 3
23051 CONTINUE
      GOTO 23050
23049 CONTINUE
      IF(.NOT.(ARG(2) .NE. 0))GOTO 23053
      OUTSUB = 1
      ACCESS = 2
      I = 2
23053 CONTINUE
23050 CONTINUE
23047 CONTINUE
      IF(.NOT.(OUTSUB .EQ. 1))GOTO 23055
      CALL SCOPY(ARG, I, FILE, 1)
23055 CONTINUE
      RETURN
      END
      SUBROUTINE DELARG (N)
      INTEGER N, I
      COMMON /CARG/ NBRARG, PTR(25), ARG(256)
      INTEGER NBRARG, PTR
      LOGICAL*1 ARG
      IF(.NOT.(N .LT. NBRARG))GOTO 23057
      I=N+1
23059 IF(.NOT.(I .LT. NBRARG))GOTO 23061
      PTR(I) = PTR(I+1)
23060 I=I+1
      GOTO 23059
23061 CONTINUE
      NBRARG = NBRARG - 1
23057 CONTINUE
      RETURN
      END
      SUBROUTINE REMARK (LINE)
      LOGICAL*1 LINE(100)
      I=1
23062 IF(.NOT.(LINE(I) .NE. 0))GOTO 23064
      CALL PUTCH (LINE(I), 3)
23063 I=I+1
      GOTO 23062
23064 CONTINUE
      IF(.NOT.(LINE(I-1) .NE. 10))GOTO 23065
      CALL PUTCH (10, 3)
23065 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CRE8AT(NAME,ACCESS,INT)
      INTEGER DSC(6)
      INTEGER ACCESS, INT, STATUS, OPENF
      INTEGER TTY
      LOGICAL*1 NAME(100), EXT(40)
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      CALL MKLOCL(NAME, EXT)
      CALL UPPER(EXT)
      CALL DSCBLD(DSC, EXT)
      IF(.NOT.(ACCESS .EQ. 1))GOTO 23067
      STATUS = OPENF(INT, DSC, 0, 2, 1, -1, FDB(INT))
      GOTO 23068
23067 CONTINUE
      IF(.NOT.(ACCESS .EQ. 2 .OR. ACCESS .EQ. 3))GOTO 23069
      STATUS = OPENF(INT, DSC, 0, 2, ACCESS, 0, FDB(INT))
      GOTO 23070
23069 CONTINUE
      IF(.NOT.(ACCESS .EQ. 4))GOTO 23071
      STATUS = OPENF(INT, DSC, 0, 2, 4, 0, FDB(INT))
      GOTO 23072
23071 CONTINUE
      IF(.NOT.(ACCESS .EQ. 99))GOTO 23073
      STATUS = OPENF(INT, DSC, 0, 2, 3, 1, FDB(INT))
      GOTO 23074
23073 CONTINUE
      IF(.NOT.(ACCESS .EQ. 97))GOTO 23075
      STATUS = OPENF(INT, DSC, 0, 1, 2, 0, FDB(INT))
      GOTO 23076
23075 CONTINUE
      STATUS = -3
23076 CONTINUE
23074 CONTINUE
23072 CONTINUE
23070 CONTINUE
23068 CONTINUE
      IF(.NOT.(STATUS .EQ. -3))GOTO 23077
      CRE8AT = -3
      GOTO 23078
23077 CONTINUE
      IF(.NOT.(STATUS .EQ. 0))GOTO 23079
      FILETP(INT) = 12
      GOTO 23080
23079 CONTINUE
      FILETP(INT) = 60
23080 CONTINUE
      LASTC(INT) = 0
      IF(.NOT.(ACCESS .EQ. 1))GOTO 23081
      MODE(INT) = 0
      GOTO 23082
23081 CONTINUE
      MODE(INT) = 1
23082 CONTINUE
      IF(.NOT.(TTY(INT) .EQ. 1))GOTO 23083
      LFN(INT) = 2
      GOTO 23084
23083 CONTINUE
      LFN(INT) = 1
23084 CONTINUE
      CHTYPE(INT) = 0
      CALL SCOPY(EXT,1,FILENM(1,INT),1)
      CRE8AT = INT
23078 CONTINUE
      RETURN
      END
      SUBROUTINE CLOSE(INT)
      INTEGER INT
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(LFN(INT) .NE. 0))GOTO 23085
      IF(.NOT.(MODE(INT) .EQ. 1 .AND. LASTC(INT) .GT. 0))GOTO 23087
      CALL PUTCH(10, INT)
23087 CONTINUE
      CALL CLOSEF(FDB(INT))
      LFN(INT) = 0
23085 CONTINUE
      RETURN
      END
	subroutine endr4
      CALL R4EXIT(0)
      END
      INTEGER FUNCTION ASSIGN (EXT, INT, ACCESS)
      LOGICAL*1 EXT(100)
      INTEGER INT, ACCESS, CRE8AT
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      ASSIGN = -3
      IF(.NOT.(INT .GT. 0 .AND. INT .LE. 6))GOTO 23089
      CALL CLOSE(INT)
      ASSIGN = CRE8AT(EXT, ACCESS, INT)
23089 CONTINUE
      RETURN
      END
      INTEGER FUNCTION OPEN (EXT, ACCESS)
      INTEGER ACCESS, INT, CRE8AT, NXTLUN
      LOGICAL*1 EXT(100)
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(NXTLUN(INT) .EQ. -3))GOTO 23091
      OPEN = -3
      GOTO 23092
23091 CONTINUE
      OPEN = CRE8AT(EXT, ACCESS, INT)
23092 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CREATE(EXT, ACCESS)
      LOGICAL*1 EXT(100)
      INTEGER ACCESS, INT
      INTEGER NEWACC
      INTEGER CRE8AT, NXTLUN
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(NXTLUN(INT) .EQ. -3))GOTO 23093
      CREATE = -3
      GOTO 23094
23093 CONTINUE
      IF(.NOT.(ACCESS .EQ. 1))GOTO 23095
      NEWACC = 99
      GOTO 23096
23095 CONTINUE
      NEWACC = ACCESS
23096 CONTINUE
      CREATE = CRE8AT(EXT, NEWACC, INT)
23094 CONTINUE
      RETURN
      END
      INTEGER FUNCTION TTY(INT)
      INTEGER INT
      INTEGER MASKIT
      COMMON / CSCLUN / LUNDAT(6)
      LOGICAL*1 BBUF(12)
      INTEGER LUNDAT
      EQUIVALENCE (LUNDAT(1), BBUF(1))
      CALL GETLUN(INT, LUNDAT)
      IF(.NOT.(MASKIT(1, 4, LUNDAT(3)) .NE. 0))GOTO 23097
      TTY = 1
      GOTO 23098
23097 CONTINUE
      TTY = 0
23098 CONTINUE
      RETURN
      END
      SUBROUTINE MARKL (INT, ADDR)
      INTEGER INT
      INTEGER ADDR(2), DUM
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      CALL MARK (FDB(INT), DUM, ADDR(1), ADDR(2))
      RETURN
      END
      SUBROUTINE SEEK(OFFSET,INT)
      INTEGER OFFSET(2), INT
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      CALL POINT (FDB(INT), 0, OFFSET(1), OFFSET(2))
      RETURN
      END
      INTEGER FUNCTION NXTLUN(FREE)
      INTEGER FREE
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      FREE=1
23099 IF(.NOT.(FREE.LE.6))GOTO 23101
      IF(.NOT.(LFN(FREE) .EQ. 0))GOTO 23102
      GOTO 23101
23102 CONTINUE
23100 FREE=FREE+1
      GOTO 23099
23101 CONTINUE
      IF(.NOT.(FREE .GT. 6))GOTO 23104
      FREE = -3
23104 CONTINUE
      NXTLUN = FREE
      RETURN
      END
      SUBROUTINE AMOVE(NAME1, NAME2)
      LOGICAL*1 NAME1(40), NAME2(40)
      INTEGER OPEN, OLD, NEW, CREATE, RENAME
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      OLD = OPEN(NAME1, 1)
      IF(.NOT.(OLD .EQ. -3))GOTO 23106
      CALL CANT(NAME1)
      GOTO 23107
23106 CONTINUE
      NEW = CREATE(NAME2, 2)
      IF(.NOT.(NEW .EQ. -3))GOTO 23108
      CALL CANT(NAME2)
      GOTO 23109
23108 CONTINUE
      CALL FCOPY(OLD, NEW)
      CALL CLOSE(OLD)
      CALL CLOSE(NEW)
      CALL REMOVE(NAME1)
23109 CONTINUE
23107 CONTINUE
      RETURN
      END
      SUBROUTINE MAKARG
      COMMON /CARG/ NBRARG, PTR(25), ARG(256)
      INTEGER NBRARG, PTR
      LOGICAL*1 ARG
      INTEGER IEND, INDEX, GETMSG, TOG
      IEND = GETMSG(ARG)
      NBRARG = 0
      INDEX = 1
      I=1
23110 IF(.NOT.(I.LE.25))GOTO 23112
      IF(.NOT.(INDEX .LE. IEND))GOTO 23113
      CALL SKIPBL (ARG, INDEX)
23113 CONTINUE
      IF(.NOT.(INDEX .GT. IEND))GOTO 23115
      GOTO 23112
23115 CONTINUE
      PTR(I) = INDEX
      IF(.NOT.(ARG(INDEX) .EQ. 39 .OR. ARG(INDEX) .EQ. 34))GOTO 23117
      PTR(I) = INDEX+1
      TOG = ARG(INDEX)
      INDEX=INDEX+1
23119 IF(.NOT.(ARG(INDEX) .NE. TOG .AND. ARG(INDEX) .NE. 0))GOTO 23121
23120 INDEX=INDEX+1
      GOTO 23119
23121 CONTINUE
      GOTO 23118
23117 CONTINUE
23122 IF(.NOT.(ARG(INDEX) .NE. 32 .AND. ARG(INDEX) .NE. 0))GOTO 23123
      INDEX = INDEX + 1
      GOTO 23122
23123 CONTINUE
23118 CONTINUE
      ARG(INDEX) = 0
      INDEX = INDEX + 1
23111 I=I+1
      GOTO 23110
23112 CONTINUE
      NBRARG = I -1
      RETURN
      END
      INTEGER FUNCTION GETTYP (INT, TYPE)
      INTEGER INT, TYPE
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      TYPE = FILETP(INT)
      GETTYP = TYPE
      RETURN
      END
      SUBROUTINE INITR4
      INTEGER GETARG, CRE8AT, INSUB, OUTSUB, I, IOATT
      INTEGER OUTACC,ERRACC, NEWAST, OLDAST, ITOC
      COMMON /CARG/ NBRARG, PTR(25), ARG(256)
      INTEGER NBRARG, PTR
      LOGICAL*1 ARG
      COMMON / CSPAWN / EFN, IFFORE, IFBACK, IFBAST, FOREPC(7), BACKPC(7
     *), TASKNM(7), PRIOST(5)
      INTEGER EFN
      INTEGER IFFORE
      INTEGER IFBACK
      INTEGER IFBAST
      LOGICAL*1 FOREPC
      LOGICAL*1 BACKPC
      LOGICAL*1 TASKNM
      LOGICAL*1 PRIOST
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      EXTERNAL EXTAST
      LOGICAL*1 TTYS(4)
      DATA TTYS(1)/84/,TTYS(2)/73/,TTYS(3)/58/,TTYS(4)/0/
      DATA OUTACC /2/
      DATA ERRACC /2/
	data ioatt/"1400/
      NBRARG = 0
      CALL GETADR(NEWAST, EXTAST)
      CALL SRDA(NEWAST, OLDAST)
      IFFORE = 0
      IFBACK = 0
      CALL GETTSK(FILENM(1,1), I)
      CALL R50ASC(6, FILENM(1,1), TASKNM)
      I = ITOC(FILENM(13,1), PRIOST, 5)
      TASKNM(7) = 0
      I=1
23124 IF(.NOT.(I.LE.6))GOTO 23126
      LFN(I) = 0
23125 I=I+1
      GOTO 23124
23126 CONTINUE
      CALL ASNLUN(8, 2HTI, 0)
      CALL WTQIO(IOATT, 8)
      CALL MAKARG
      CALL SCOPY(TTYS, 1, FILENM(1, 1), 1)
      CALL SCOPY(TTYS, 1, FILENM(1, 2), 1)
      CALL SCOPY(TTYS, 1, FILENM(1, 3), 1)
      I=1
23127 IF(.NOT.(GETARG(I, BUFFER(1,6), 40) .NE. -1))GOTO 23129
      IF(.NOT.( (INSUB(BUFFER(1,6),FILENM(1,1)) .EQ. 1) .OR. (OUTSUB(62,
     * BUFFER(1,6),FILENM(1,2), OUTACC) .EQ. 1) .OR. (OUTSUB(63, BUFFER(
     *1,6), FILENM(1,3), ERRACC) .EQ. 1) ))GOTO 23130
      CALL DELARG (I)
      GOTO 23131
23130 CONTINUE
      I = I + 1
23131 CONTINUE
23128 GOTO 23127
23129 CONTINUE
      IF(.NOT.(CRE8AT(FILENM(1,3), ERRACC, 3) .EQ. -3))GOTO 23132
      CALL R4EXIT(0)
23132 CONTINUE
      IF(.NOT.(CRE8AT(FILENM(1,1), 1, 1) .EQ. -3))GOTO 23134
      CALL CANT(FILENM(1, 1))
23134 CONTINUE
      IF(.NOT.(CRE8AT(FILENM(1,2), OUTACC, 2) .EQ. -3))GOTO 23136
      CALL CANT(FILENM(1, 2))
23136 CONTINUE
      RETURN
      END
      SUBROUTINE REMOVE(BUF)
      LOGICAL*1 BUF(40)
      INTEGER INT, OPEN, FDEL
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      INT = OPEN(BUF, 1)
      IF(.NOT.(INT .NE. -3))GOTO 23138
      IF(.NOT.(FDEL(FDB(INT)) .LT. 0))GOTO 23140
      CALL PUTLIN(BUF, 3)
      CALL REMARK(33H not deleted--privilege violation)
23140 CONTINUE
      CALL CLOSE(INT)
23138 CONTINUE
      RETURN
      END
      INTEGER FUNCTION PROMPT(PSTR, BUF, INT)
      INTEGER INT, N, TTY, GETLIN, LENGTH
      LOGICAL*1 PSTR(100), BUF(100), CRLF(2)
      DATA CRLF/13, 10/
      N = LENGTH(PSTR)
      IF(.NOT.(TTY(INT) .EQ. 1 .AND. N .GT. 0))GOTO 23142
      CALL RPUTCH(CRLF, 2, INT)
      CALL RPUTCH(PSTR, N, INT)
23142 CONTINUE
      PROMPT = GETLIN(BUF, INT)
      RETURN
      END
      SUBROUTINE GTIME(IBUF)
      LOGICAL*1 IBUF(100)
      CALL TIME(IBUF)
      IBUF(9) = 0
      RETURN
      END
      SUBROUTINE GDATE(IBUF)
      LOGICAL*1 IBUF(100)
      CALL DATE(IBUF)
      IBUF(10) = 0
      RETURN
      END
      INTEGER FUNCTION CTOO(IN, I)
      LOGICAL*1 IN(100)
      INTEGER INDEX
      INTEGER D, I
      LOGICAL*1 DIGITS(9)
      DATA DIGITS(1) /48/
      DATA DIGITS(2) /49/
      DATA DIGITS(3) /50/
      DATA DIGITS(4) /51/
      DATA DIGITS(5) /52/
      DATA DIGITS(6) /53/
      DATA DIGITS(7) /54/
      DATA DIGITS(8) /55/
      DATA DIGITS(9) /0/
23144 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23145
      I = I + 1
      GOTO 23144
23145 CONTINUE
      CTOO = 0
23146 IF(.NOT.(IN(I) .NE. 0))GOTO 23148
      D = INDEX(DIGITS, IN(I))
      IF(.NOT.(D .EQ. 0))GOTO 23149
      GOTO 23148
23149 CONTINUE
      CTOO = 8 * CTOO + D - 1
23147 I = I + 1
      GOTO 23146
23148 CONTINUE
      RETURN
      END
      INTEGER FUNCTION OLDMAK(ARG)
      INTEGER IEND, PROMPT, INT, OPEN, GOTIT
      LOGICAL*1 ARG(100)
      LOGICAL*1 STAR(3)
      DATA STAR(1)/42/,STAR(2)/32/,STAR(3)/0/
      DATA GOTIT /0/
      IF(.NOT.(GOTIT .EQ. 1))GOTO 23151
      CALL SCOPY(STAR, 1, ARG, 1)
      IEND = 2
      GOTO 23152
23151 CONTINUE
      GOTIT = 1
      CALL GETMCR(ARG, IEND)
      IF(.NOT.(IEND .LE. 0))GOTO 23153
      CALL SCOPY(STAR, 1, ARG, 1)
      INT = OPEN(3HTI:, 3)
      IEND = PROMPT(STAR, ARG(3), INT)
      CALL CLOSE(INT)
      IF(.NOT.(IEND .EQ. -1))GOTO 23155
      IEND = 2
      GOTO 23156
23155 CONTINUE
      IEND = IEND + 1
23156 CONTINUE
23153 CONTINUE
23152 CONTINUE
      ARG(IEND+1) = 0
      OLDMAK = IEND
      RETURN
      END
      INTEGER FUNCTION OTOCZF(N, W, BUF, SIZE)
      LOGICAL*1 BUF(100)
      INTEGER N, W, SIZE, M, OTOC, I, LENGTH
      COMMON / CFMTBF / TEMP(20)
      LOGICAL*1 TEMP
      M = W - OTOC(N, TEMP, 20)
      I=1
23157 IF(.NOT.(I .LE. M))GOTO 23159
      BUF(I) = 48
23158 I=I+1
      GOTO 23157
23159 CONTINUE
      CALL SCOPY(TEMP, 1, BUF, I)
      OTOCZF = LENGTH(BUF)
      RETURN
      END
      INTEGER FUNCTION RAWMOD(UNIT, TYPE)
      INTEGER UNIT, TYPE
      INTEGER TTY
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(TTY(UNIT) .EQ. 1 .AND. TYPE .EQ. 1))GOTO 23160
      CHTYPE(UNIT) = 1
      GOTO 23161
23160 CONTINUE
      CHTYPE(UNIT) = 0
23161 CONTINUE
      RAWMOD = CHTYPE(UNIT)
      RETURN
      END
      LOGICAL*1 FUNCTION RGETCH(C, LUN)
      LOGICAL*1 C
      LOGICAL*1 MASKIT
      INTEGER LUN, FUNC
      COMMON / CRAWTT / IDS, PARAM(6), IOSB(4)
      INTEGER BCOUNT
      INTEGER IDS
      INTEGER PARAM
      LOGICAL*1 IOSB
      EQUIVALENCE (IOSB(3), BCOUNT)
	data func /"1030/
      CALL GETADR(PARAM, C)
      PARAM(2) = 1
      PARAM(3) = 0
      CALL WTQIO(FUNC, LUN, 1,, IOSB, PARAM, IDS)
      C = MASKIT(0, 127, C)
      RGETCH = C
      RETURN
      END
      SUBROUTINE RPUTCH(C, N, LUN)
      LOGICAL*1 C(100)
      INTEGER N, LUN, FUNC
      COMMON / CRAWTT / IDS, PARAM(6), IOSB(4)
      INTEGER BCOUNT
      INTEGER IDS
      INTEGER PARAM
      LOGICAL*1 IOSB
      EQUIVALENCE (IOSB(3), BCOUNT)
	data func/"410/
      CALL GETADR(PARAM, C)
      PARAM(2) = N
      PARAM(3) = 0
      CALL WTQIO(FUNC, LUN, 1,, IOSB, PARAM, IDS)
      RETURN
      END
      SUBROUTINE R4EXIT(STATUS)
      INTEGER JUNK, STATUS, IOKIL, INT
      INTEGER KILL
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      COMMON / CSPAWN / EFN, IFFORE, IFBACK, IFBAST, FOREPC(7), BACKPC(7
     *), TASKNM(7), PRIOST(5)
      INTEGER EFN
      INTEGER IFFORE
      INTEGER IFBACK
      INTEGER IFBAST
      LOGICAL*1 FOREPC
      LOGICAL*1 BACKPC
      LOGICAL*1 TASKNM
      LOGICAL*1 PRIOST
      LOGICAL*1 KILDIR(17)
      DATA KILDIR(1)/32/,KILDIR(2)/32/,KILDIR(3)/32/,KILDIR(4)/32/,KILDI
     *R(5)/32/,KILDIR(6)/32/,KILDIR(7)/32/,KILDIR(8)/32/,KILDIR(9)/32/,K
     *ILDIR(10)/107/,KILDIR(11)/105/,KILDIR(12)/108/,KILDIR(13)/108/,KIL
     *DIR(14)/101/,KILDIR(15)/100/,KILDIR(16)/46/,KILDIR(17)/0/
	data iokil/"12/
      IF(.NOT.(IFFORE .EQ. 1))GOTO 23162
      JUNK = KILL(FOREPC)
      CALL WAITFR(EFN, JUNK)
23162 CONTINUE
      INT = 1
23164 IF(.NOT.(INT .LE. 6))GOTO 23166
      CALL CLOSE(INT)
23165 INT = INT + 1
      GOTO 23164
23166 CONTINUE
      KILDIR(1) = 13
      KILDIR(2) = 10
      IF(.NOT.(STATUS .EQ. -3))GOTO 23167
      CALL WTQIO(8, IOKIL)
      N = 3
      CALL STCOPY(TASKNM, 1, KILDIR, N)
23169 IF(.NOT.(N .LE. 9))GOTO 23171
      KILDIR(N) = 32
23170 N=N+1
      GOTO 23169
23171 CONTINUE
      CALL RPUTCH(KILDIR, 16, 8)
23167 CONTINUE
      CALL EXIT
      END
      SUBROUTINE EXTAST
      CALL R4EXIT(-3)
      END
      SUBROUTINE DSCBLD(DSC, FILESP)
      INTEGER DSC(6), START, STOP
      INTEGER INDEX, LENGTH
      LOGICAL*1 FILESP(40)
      START = 1
      STOP = START + INDEX(FILESP(START), 58)
      DSC(1) = STOP - START
      CALL GETADR(DSC(2), FILESP(START))
      START = STOP
      STOP = START + INDEX(FILESP(START), 93)
      DSC(3) = STOP - START
      CALL GETADR(DSC(4), FILESP(START))
      START = STOP
      STOP = START + LENGTH(FILESP(START))
      DSC(5) = STOP - START
      CALL GETADR(DSC(6), FILESP(START))
      RETURN
      END
      SUBROUTINE GETPNM(PNAME)
      LOGICAL*1 PNAME(100)
      COMMON / CSPAWN / EFN, IFFORE, IFBACK, IFBAST, FOREPC(7), BACKPC(7
     *), TASKNM(7), PRIOST(5)
      INTEGER EFN
      INTEGER IFFORE
      INTEGER IFBACK
      INTEGER IFBAST
      LOGICAL*1 FOREPC
      LOGICAL*1 BACKPC
      LOGICAL*1 TASKNM
      LOGICAL*1 PRIOST
      CALL SCOPY(TASKNM, 1, PNAME, 1)
      RETURN
      END
      INTEGER FUNCTION GETFDB(INT)
      INTEGER INT
      COMMON / IO / LASTC(6), FDB(6), LFN(6), CHTYPE(6), MODE(6), FILETP
     *(6), FILENM(40, 6), BUFFER(400, 6)
      INTEGER LASTC
      INTEGER FDB
      LOGICAL*1 LFN
      LOGICAL*1 CHTYPE
      LOGICAL*1 MODE
      LOGICAL*1 FILETP
      LOGICAL*1 FILENM
      LOGICAL*1 BUFFER
      IF(.NOT.(INT .GE. 1 .AND. INT .LE. 6))GOTO 23172
      GETFDB = FDB(INT)
      GOTO 23173
23172 CONTINUE
      GETFDB = -3
23173 CONTINUE
      RETURN
      END
      CALL INITR4
      CALL MAIN
      CALL R4EXIT(0)
      END
      INTEGER FUNCTION LOCCOM(COMAND, SPATH, PATH)
      LOGICAL*1 COMAND(100), SPATH(100), PATH(100), TEMP(40)
      INTEGER I, N, INT
      INTEGER LENGTH, OPEN, GETTYP
      LOGICAL*1 SCREXT(1)
      LOGICAL*1 IMGEXT(5)
      DATA SCREXT(1)/0/
      DATA IMGEXT(1)/46/,IMGEXT(2)/116/,IMGEXT(3)/115/,IMGEXT(4)/107/,IM
     *GEXT(5)/0/
      I=1
23174 IF(.NOT.(SPATH(I) .NE. 10))GOTO 23176
      CALL CONCAT(SPATH(I), COMAND, TEMP)
      N = LENGTH(TEMP) + 1
      CALL SCOPY(SCREXT, 1, TEMP, N)
      INT = OPEN(TEMP, 1)
      IF(.NOT.(INT .NE. -3))GOTO 23177
      GOTO 23176
23177 CONTINUE
      CALL SCOPY(IMGEXT, 1, TEMP, N)
      INT = OPEN(TEMP, 1)
      IF(.NOT.(INT .NE. -3))GOTO 23179
      GOTO 23176
23179 CONTINUE
23175 I=I+LENGTH(SPATH(I))+1
      GOTO 23174
23176 CONTINUE
      IF(.NOT.(INT .NE. -3))GOTO 23181
      LOCCOM = GETTYP(INT, LOCCOM)
      CALL CLOSE(INT)
      CALL MKLOCL(TEMP, PATH)
      GOTO 23182
23181 CONTINUE
      LOCCOM = -3
      CALL SCOPY(COMAND, 1, PATH, 1)
23182 CONTINUE
      RETURN
      END
      SUBROUTINE SCRATF (SEED, NAME)
      LOGICAL*1 SEED(100), NAME(100), TEMP(7)
      INTEGER I, J, CTYPE, TYPE, LENGTH
      CALL GETPNM(TEMP)
      CALL UPPER(TEMP)
      CALL GETDIR(3, 6, NAME)
      J = LENGTH(NAME) + 1
      I=1
23183 IF(.NOT.(TEMP(I) .NE. 0))GOTO 23185
      CTYPE = TYPE(TEMP(I))
      IF(.NOT.(CTYPE .EQ. 2 .OR. CTYPE .EQ. 1))GOTO 23186
      NAME(J) = TEMP(I)
      J = J + 1
23186 CONTINUE
23184 I=I+1
      GOTO 23183
23185 CONTINUE
      NAME(J) = 46
      J = J + 1
      I=1
23188 IF(.NOT.(SEED(I) .NE. 0 .AND. I .LE. 3))GOTO 23190
      NAME(J) = SEED(I)
      J = J + 1
23189 I=I+1
      GOTO 23188
23190 CONTINUE
      NAME(J) = 0
      RETURN
      END
      SUBROUTINE ARGFIL(PID, FILE)
      LOGICAL*1 PID(7), FILE(40)
      INTEGER I, J, CTYPE, TYPE, LENGTH
      CALL GETDIR(3, 6, FILE)
      J = LENGTH(FILE) + 1
      I=1
23191 IF(.NOT.(PID(I) .NE. 0))GOTO 23193
      CTYPE = TYPE(PID(I))
      IF(.NOT.(CTYPE .EQ. 2 .OR. CTYPE .EQ. 1))GOTO 23194
      FILE(J) = PID(I)
      J = J + 1
23194 CONTINUE
23192 I=I+1
      GOTO 23191
23193 CONTINUE
      CALL SCOPY(4H.ARG, 1, FILE, J)
      RETURN
      END
      SUBROUTINE MAILID(SENDER, MDIREC)
      LOGICAL*1 SENDER(100), MDIREC(100), LOGUIC(20), UIC(12), X, BUF(40
     *0)
      INTEGER IDS, I, GRP, MEM, INT, OPEN, GETLIN, JUNK, GETWRD, EQUAL, 
     *J, FOUND
      EQUIVALENCE (X, IDS)
      CALL GETTSK(BUF, IDS)
      X = BUF(32)
      GRP = IDS
      X = BUF(31)
      MEM = IDS
      CALL FMTUIC(GRP, MEM, LOGUIC)
      FOUND = 0
      CALL ADRFIL(BUF)
      INT = OPEN(BUF, 1)
      IF(.NOT.(INT .NE. -3))GOTO 23196
23198 IF(.NOT.(GETLIN(BUF, INT) .NE. -1))GOTO 23199
      I = 1
      JUNK = GETWRD(BUF, I, SENDER)
      JUNK = GETWRD(BUF, I, MDIREC)
      JUNK = GETWRD(BUF, I, UIC)
      IF(.NOT.(EQUAL(UIC, LOGUIC) .EQ. 1))GOTO 23200
      FOUND = 1
      GOTO 23199
23200 CONTINUE
      GOTO 23198
23199 CONTINUE
      CALL CLOSE(INT)
23196 CONTINUE
      IF(.NOT.(FOUND .EQ. 0))GOTO 23202
      CALL SCOPY(LOGUIC, 1, SENDER, 1)
      MDIREC(1) = 0
23202 CONTINUE
      CALL FOLD(SENDER)
      RETURN
      END
      SUBROUTINE FMTUIC(GROUP, MEMBER, BUF)
      INTEGER GROUP, MEMBER, I, OTOCZF
      LOGICAL*1 BUF(100)
      BUF(1) = 91
      I = 2
      I = I + OTOCZF(GROUP, 3, BUF(I), 100)
      BUF(I) = 44
      I = I + 1
      I = I + OTOCZF(MEMBER, 3, BUF(I), 100)
      BUF(I) = 93
      BUF(I+1) = 0
      RETURN
      END