C
C		********************
C		* [311,77]DUMP.FTN *
C		********************
C
C------- DUMP ACCOUNTING FILE
C
	PARAMETER MUIC=25
C
	LOGICAL*1 ERROR
C
	INTEGER*4 BLOCKS,NUMBER,KUIC,ITEMP
C
	DIMENSION KUIC(MUIC),JUIC(2),ILINE(260)
C
	BYTE USERS(12,MUIC),BUFD(2)
C
	BYTE LINE(520),OUT(132)
C
	BYTE DATSTR(9),TIMSTR(8)
	BYTE UIC(2),SUBACC,TYPE
	BYTE TT,NTASK
	BYTE TASKTY
	BYTE TASKN(30),PASS(6)
	BYTE JOB(9),BUREAU
	BYTE FSPEC(4)
	BYTE NAME(30)
	BYTE BYTE(2)
C
	INTEGER INT
C
	INTEGER RDATE,STARTM,EMPLY(2),IDATE(2)
	INTEGER ENDM,TASK(10)
	INTEGER TICKS(2)
C
	EQUIVALENCE (UIC,LINE(1)) , (RDATE,LINE(3)) , (LUIC,LINE)
	EQUIVALENCE (STARTM,LINE(5)) , (EMPLY,LINE(7))
	EQUIVALENCE (TYPE,LINE(12))
	EQUIVALENCE (IDATE(1),RDATE) , (IDATE(2),STARTM)
	EQUIVALENCE (BLOCKS,LINE(5)) , (IFILES,LINE(9))
	EQUIVALENCE (BYTE,INT) , (ILINE,LINE)
C
	DATA FSPEC /':','[',',',']'/
C
	DATA NUIC /0/
C
	DATA OUT /132*' '/
C
C------- DISABLE OUTPUT CONVERSION
	CALL ERRSET (63,,,,.FALSE.)
C
C------- OPEN THE UPF FILE
	OPEN (UNIT=3,NAME='LB0:[1,100]PDSUPF.DAT',TYPE='OLD',
	1	READONLY,SHARED,ACCESS='DIRECT')
C
C------- OPEN THE FILE
	CALL INOPEN(5,1,'CRR',
	1	'What is the accounting file name? ',34,ERROR)
	IF (ERROR) CALL EXIT
C
	CALL PROPEN (5,2,'LST',
	1	'What is the output file name? ',30,ERROR)
	IF (ERROR) CALL EXIT
	TYPE 10
 10	FORMAT('$What is the length of the output line? ')
	ACCEPT 20,IBL
 20	FORMAT(I5)
C
C------- INPUT THE USER NAMES
	TYPE 25
 25	FORMAT('0Input user names desired. If all desired',
	1	' RETURN on first.',/,' RETURN when done.')
 30	TYPE 40
 40	FORMAT('$Enter user name: ')
	ACCEPT 50,NC,(LINE(I),I=1,12)
 50	FORMAT(Q,12A1)
	IF (NC .EQ. 0) GO TO 60
C
C------- CHECK FOR VALID USER NAME
	CALL U1FIND (3,LINE,JUIC,L,M,N)
	IF (M .EQ. 1) GO TO 55
C
C------- INVALID USER NAME
	TYPE 51
 51	FORMAT('$Invalid user name enter UIC if known else RETURN',
	1	' (No "[]"): ')
	ACCEPT 52,NC,JUIC
 52	FORMAT(Q,2O4)
	IF (NC .EQ. 0) GO TO 30
	ENCODE (12,53,LINE)
 53	FORMAT('INVALID USER')
C
C------- STORE THE USER
 55	NUIC = NUIC + 1
	DO 56 I=1,12
	USERS(I,NUIC) = LINE(I)
 56	CONTINUE
	BYTE(1) = JUIC(2) .AND. "377
	BYTE(2) = JUIC(1) .AND. "377
	KUIC(NUIC) = INT .AND. "177777
	IF (NUIC .LT. MUIC) GO TO 30
C
C------- IF ANY USERS ENTERED SORT BY UIC
 60	IF (NUIC .LE. 1) GO TO 90
	DO 80 I=1,NUIC-1
	DO 80 J=I+1,NUIC
	IF (KUIC(J) .GE. KUIC(I)) GO TO 80
	ITEMP = KUIC(J)
	KUIC(J) = KUIC(I)
	KUIC(I) = ITEMP
	DO 70 K=1,12
	LINE(1) = USERS(K,I)
	USERS(K,I) = USERS(K,J)
	USERS(K,J) = LINE(1)
 70	CONTINUE
 80	CONTINUE
C
 90	IUIC = 1
D	DO 93 KK=1,NUIC
D	TYPE 91,(USERS(K,KK),K=1,12)
D91	FORMAT(1X,12A1)
D93	CONTINUE
	NREC = 0
	IF (NUIC .EQ. 0) GO TO 99
	WRITE(2,95)(USERS(J,IUIC),J=1,12)
 95	FORMAT('1',//,1X,80('*'),/,1X,80('*'),/,
	1	1X,5('*'),70X,5('*'),/
	2	1X,5('*'),24X,'DATA FOR ',12A1,25X,5('*'),/,
	3	1X,5('*'),70X,5('*'),/,1X,80('*'),/,1X,80('*'),//)
C
C------- CLOSE THE UPF FILE
 99	CLOSE (UNIT=3)
C
C------- READ THE RECORD
 100	READ(1,200,END=9000) NC,(LINE(II),II=1,NC)
 200	FORMAT(Q,200A1,200A1,200A1)
	NREC = NREC + 1
C
C------- CHECK THE CHECK SUM
	ICHK = 0
	DO 220 I=1,(NC-2)/2
	ICHK = ICHK + ILINE(I)
 220	CONTINUE
	IF (ICHK .EQ. ILINE(NC/2)) GO TO 240
	TYPE 230,ICHK,ILINE(NC/2)
 230	FORMAT(' CHECK SUM S/B (',I7,') WAS (',I7,')')
	GO TO 100
C
C------- IF ALL SKIP THE CHECK
 240	IF (NUIC .EQ. 0) GO TO 300
C
C------- CHECK FOR MATCH -- SKIP IF UIC IS LESS
 250	ITEMP = LUIC .AND. "177777
	IF (ITEMP .LT. KUIC(IUIC)) GO TO 100
C
C------- IF EQUAL INCLUDE
	IF (ITEMP .EQ. KUIC(IUIC)) GO TO 300
C
C------- MOVE TO NEXT UIC
	IUIC = IUIC + 1
	IF (IUIC .GT. NUIC) CALL EXIT
	WRITE(2,95)(USERS(J,IUIC),J=1,12)
	GO TO 250
C
C------- DETERMINE RECORD TYPE
 300	ITYPE = TYPE + 1
C
C------- CHECK FOR SPECIAL
	IF (ITYPE .GT. 11) GO TO 11000
C
C		 T    B    D
C		 /    T    S
C		 S    C    K
C		      H	
C
	GO TO (1000,2000,3000),ITYPE
C
C------- REGULAR TIME SHARING USAGE
 1000	WRITE(2,1100)
 1100	FORMAT('0TIMESHARING JOB',/,1X,15('='))
C
	DO 1101 K=1,30
	NAME(K) = ' '
 1101	CONTINUE
C
C------- CONVERT DATE AND TIME
 1102	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
C
C------- CONVERT PASSWORD
	CALL R50ASC (6,EMPLY,PASS)
C
C------- IF PASS WORD IS A NUMBER GET USERS NAME
	IF (PASS(1) .LT. '0' .OR. PASS(1) .GT. '9') GO TO 1105
	DO 1103 KK=6,1,-1
	IF (PASS(KK) .NE. ' ') GO TO 1104
 1103	CONTINUE
 1104	DECODE(KK,11040,PASS,ERR=11041) NUMBER
11040	FORMAT(I6)
	IF (NUMBER .LT. 32000) GO TO 11045
11041	IENUM = 1
	TYPE 11042,NREC,NUMBER,PASS,(LINE(II),II=1,NC)
11042	FORMAT(' BAD EMPLY NUMBER (RECORD,EMPLY #)',2I10,'"',6A1,'"',
	1	52(/,10O8))
	GO TO 11046
11045	IENUM = NUMBER
11046	CALL GETNAM (3,4,IENUM,NAME,IJKL)
	GO TO 1107
C
 1105	DO 1106 K=1,6
	NAME(K) = PASS(K)
 1106	CONTINUE
C
 1107	DO 1108 K=30,1,-1
	IF (NAME(K) .NE. ' ') GO TO 1109
 1108	CONTINUE
 1109	WRITE(2,1110) UIC(2),UIC(1),DATSTR,TIMSTR,(NAME(L),L=1,K)
 1110	FORMAT (5X,'UIC/DATE/TIME',T30,'[',O3,',',O3,']','/',
	1	9A1,'/',8A1,/,
	3	5X,'PASSWORD',T30,<K>A1)
C
C------- DECODE REMAINDER OF RECORD
	DECODE (8,1200,LINE(13)) ENDM,TICKS,TT,NTASK
 1200	FORMAT(3A2,A1,A1)
	IDATE(2) = ENDM
	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
	WRITE(2,1210) TIMSTR,TT
 1210	FORMAT (5X,'SESSION END',T30,8A1,/,
	1	5X,'TERMINAL',T30,'TT',O2)
	WRITE(2,1220) SECS(TICKS(1),TICKS(2))
 1220	FORMAT(5X,'KILO-CORE-SECONDS',T30,F8.2)
	NCC = 21
	IOUT = 0
C
C------ SKIP IF NO TASKS
	IF (NTASK .EQ. 0) GO TO 100
	DO 1500 I=1,NTASK
	DECODE(6,1300,LINE(NCC)) NWORD,TICKS
 1300	FORMAT(A2,2A2)
	NCC = NCC + 6
	DECODE(NWORD*2,1301,LINE(NCC)) (TASK(II),II=1,NWORD)
 1301	FORMAT(<NWORD>A2)
	NB = NWORD * 3
	NCC = NCC + NWORD * 2
C
C------- CONVERT TASK NAME TO ASCII
	CALL R50ASC (NB,TASK,TASKN)
C
C------- COUNT NUMBER OF CHARACTERS
	DO 1305 NC=NB,1,-1
	IF (TASKN(NC) .NE. ' ') GO TO 1306
 1305	CONTINUE
C
 1306	CONTINUE
C
C------- REFORMAT FILE SPEC
	KS = 1
	DO 1307 II=1,NC
	IF (TASKN(II) .NE. '$') GO TO 1307
	TASKN(II) = FSPEC(KS)
	KS = KS + 1
 1307	CONTINUE
C
C------- CHECK FOR FULL BUFFER
	IF (IOUT+40 .LE. IBL) GO TO 1310
C
C------- DUMP BUFFER
	WRITE(2,1308) (OUT(II),II=1,IOUT)
 1308	FORMAT(1X,132A1)
	DO 1309 II=1,IOUT
	OUT(II) = ' '
 1309	CONTINUE
	IOUT = 0
C
C------- FILL BUFFER
 1310	DO 1311 II=1,NC
	IOUT = IOUT + 1
	OUT(IOUT) = TASKN(II)
 1311	CONTINUE
	IOUT = IOUT + (30-NC)
	ENCODE (10,1312,OUT(IOUT),ERR=1313) SECS(TICKS(1),TICKS(2))
 1312	FORMAT(F10.2)
 1313	IOUT = IOUT + 10
C
 1500	CONTINUE
	IF (IOUT .EQ. 0) GO TO 100
	WRITE (2,1308) (OUT(II),II=1,IOUT)
	DO 1510 II=1,IOUT
	OUT(II) = ' '
 1510	CONTINUE
	GO TO 100
C
C------- BATCH JOB
 2000	WRITE(2,2100)
 2100	FORMAT('0BATCH JOB',/,1X,9('='))
C
	GO TO 1102
C
C------- DISK USAGE
 3000	WRITE(2,3100)
 3100	FORMAT('0DISK USAGE',/,1X,10('='))
C
C------- CONVERT DATE AND TIME
	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
	WRITE(2,3200) UIC(2),UIC(1),DATSTR,BLOCKS,IFILES
 3200	FORMAT (5X,'UIC',T30,'[',O3,',',O3,']',/,
	1	5X,'DATE',T30,9A1,/,
	3	5X,'BLOCKS/FILES',T30,I6,'/',I4)
	GO TO 100
C
C------- END OF FILE
 9000	CONTINUE
C
	CALL EXIT
C
C------- SPECIAL RECORDS
C
C------- CHECK FOR SPECS
11000	IF (ITYPE .NE. 12) GO TO 12000
	WRITE(2,11100)
11100	FORMAT('0SPECS PAGES',/,1X,11('='))
C
C------- CONVERT DATE AND TIME
	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
C
C------- CONVERT PASSWORD
	CALL R50ASC (6,EMPLY,PASS)
C
	WRITE(2,11110) UIC(2),UIC(1),DATSTR,TIMSTR,PASS
11110	FORMAT (5X,'UIC/DATE/TIME',T30,'[',O3,',',O3,']','/',
	1	9A1,'/',8A1,/,
	3	5X,'TASK',T30,6A1)
C
C------- GET NUMBER OF WORDS
	BYTE(1) = LINE(13)
	BYTE(2) = LINE(14)
	NWORD = INT
	NREC = NWORD / 5
	IPTR = 15
	DO 11200 I=1,NREC
C
C------- GET NUMBER OF PAGES
	BYTE(1) = LINE(IPTR)
	BYTE(2) = LINE(IPTR+1)
	IPAGE = INT
C
C------- GET TYPE
	IPTR = IPTR + 2
	BYTE(1) = LINE(IPTR)
	BYTE(2) = LINE(IPTR+1)
	IP = INT
C
C------- GET FILE SPEC
	CALL R50ASC (9,LINE(IPTR+2),NAME)
	IF (IP .EQ. 0) WRITE(2,11150) IPAGE,(NAME(II),II=1,9)
11150	FORMAT(5X,'WORKING PAGES',T30,I6,1X,9A1)
	IF (IP .EQ. 1) WRITE(2,11160) IPAGE,(NAME(II),II=1,9)
11160	FORMAT(5X,'CONTRACT PAGES',T30,I6,1X,9A1)
	IPTR = IPTR + 8
11200	CONTINUE
	GO TO 100
C
C------- SFL
12000	IF (ITYPE .NE. 13) GO TO 13000
	WRITE(2,12100)
12100	FORMAT('0SFL USAGE',/,1X,9('='))
C
C------- CONVERT DATE AND TIME
	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
C
C------- CONVERT PASSWORD
	CALL R50ASC (6,EMPLY,PASS)
C
	WRITE(2,11110) UIC(2),UIC(1),DATSTR,TIMSTR,PASS
C
C------- GET FILE NAME
	CALL R50ASC(9,LINE(13),NAME)
	NAME(10) = '.'
	CALL R50ASC(3,LINE(19),NAME(11))
	BYTE(1) = LINE(21)
	BYTE(2) = LINE(22)
	WRITE(2,12200) INT,(NAME(II),II=1,13)
12200	FORMAT(5X,'SFL ACCESSES',T30,I6,1X,13A1)
	GO TO 100
C
C------- ARCHIVE
13000	IF (ITYPE .NE. 14) GO TO 14000
	WRITE(2,13100)
13100	FORMAT('0ARCHIVE USAGE',/,1X,13('='))
C
C------- CONVERT DATE AND TIME
	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
C
C------- CONVERT PASSWORD
	CALL R50ASC (6,EMPLY,PASS)
C
	WRITE(2,11110) UIC(2),UIC(1),DATSTR,TIMSTR,PASS
C
C------- GET FILE NAME
	CALL R50ASC(9,LINE(13),NAME)
	NAME(10) = '.'
	CALL R50ASC(3,LINE(19),NAME(11))
	WRITE(2,13200) (NAME(II),II=1,13)
13200	FORMAT(5X,'ARCHIVED FILES',T30,13A1)
	GO TO 100
C
C------- RESTORE
14000	IF (ITYPE .NE. 15) GO TO 15000
	WRITE(2,14100)
14100	FORMAT('0RESTORE USAGE',/,1X,13('='))
C
C------- CONVERT DATE AND TIME
	CALL DAYTIM (IDATE,DATSTR,TIMSTR)
C
C------- CONVERT PASSWORD
	CALL R50ASC (6,EMPLY,PASS)
C
	WRITE(2,11110) UIC(2),UIC(1),DATSTR,TIMSTR,PASS
C
C------- GET FILE NAME
	CALL R50ASC(9,LINE(13),NAME)
	NAME(10) = '.'
	CALL R50ASC(3,LINE(19),NAME(11))
	BYTE(1) = LINE(21)
	BYTE(2) = LINE(22)
	WRITE(2,14200) INT,(NAME(II),II=1,13)
14200	FORMAT(5X,'RESTORED FILES',T30,I6,' BLKS ',13A1)
	GO TO 100
C
15000	CONTINUE
C
C------- BAD RECORD TYPE
20000	TYPE 21000,ITYPE-1
21000	FORMAT(' BAD RECORD TYPE',I10)
	GO TO 100
C
	END
	FUNCTION SECS (I,J)
C
	DIMENSION L(2)
C
	INTEGER*4 K
C
	EQUIVALENCE (L,K)
C
	L(2) = I
	L(1) = J
C
	SECS = FLOAT(K) / 60.0
C
	RETURN
C
	END
	SUBROUTINE DAYTIM(IDATE,DAT,TIM)
C
C-----     SUBROUTINE TO CONVERT FROM 2I2 TO FULL DATE
C
C	IDATE = COMPACT DAY / TIME CODE
C	DAT   = 9 BYTE ARRAY TO CONTAIN THE DATE
C	TIM   = 8 BYTE ARRAY TO CONTAIN THE TIME
C
	DIMENSION IDATE(2)
	BYTE DAT(9),TIM(8)
C
	DIMENSION AMONTH(12)
	BYTE MONTH(4,12)
	EQUIVALENCE (MONTH(1), AMONTH(1))
C
	DATA AMONTH/'JAN-','FEB-','MAR-','APR-','MAY-','JUN-',
     *	            'JUL-','AUG-','SEP-','OCT-','NOV-','DEC-'/
C
C-----     DECODE THE TIME
	IHR = IDATE(2) / 60
	IMIN = IDATE(2) - 60 * IHR
C
	ENCODE(8,110,TIM,ERR=111) IHR,IMIN
110	FORMAT(I2,':',I2,':00')
 111	IF(TIM(1) .EQ. ' ') TIM(1) = '0'
	IF(TIM(4) .EQ. ' ') TIM(4) = '0'
C
C-----     THE DATE
	IYR = IDATE(1) .AND. "177000
	IYR = ISHFT(IYR,-9)
	IMON = IDATE(1) .AND. "740
	IMON = ISHFT(IMON,-5)
	IDAY = IDATE(1) .AND. "37
C
	ENCODE(9,130,DAT,ERR=131)IDAY,(MONTH(I,IMON),I=1,4),IYR
130	FORMAT(I2,'-',4A1,I2)
 131	IF(TIM(1) .EQ. ' ') TIM(1) = '0'
	IF(TIM(8) .EQ. ' ') TIM(8) = '0'
C
	RETURN
C
	END
	SUBROUTINE INOPEN(ITR,LUN,TYPE,MSG,NCHR,ERROR,FNAME,NC)
C
C
C
C-----	SUBROUTINE TO OPEN AN INPUT OR OUTPUTUT FILE INTERACTIVELY
C
C	ITR  =  LOGICAL UNIT NUMBER OF THE TERMINAL
C	LUN  =  LOGICAL UNIT NUMBER OF THE FILE TO BE OPENED
C	TYPE =  DEFAULT FILE TYPE
C	MSG  =  ARRAY OF CHARACTERS GIVING A
C	        REQUESTING MESSAGE
C	NCHR =  NUMBER OF CHARACTERS IN MSG (40 MAXIMUM)
C      ERROR =  .FALSE.  IF THE OPEN WAS SUCCESSFULL   (LOGICAL *1)
C	     =  .TRUE. IF THE OPEN WAS UNSUCCESSFUL
C
C	EXAMPLE:
C
C	CALL INOPEN(5,1,'DAT','Enter the Input FILE NAME: ',27,ERROR)
C	IF( ERROR ) GO TO ...
C				or
C			to open a "FORMATTED" print file:
C       CALL PROPEN(5,2,'LST','Enter the Output FILE NAME: ',28,ERROR)
C	IF( ERROR ) GO TO ...
C
C				or
C			to open a "LIST" type OUTPUT file:
C	CALL DAOPEN(5,2,'DAT','Enter the Output FILE NAME: ',28,ERROR)
C
C				or
C			to open an existing file for "APPEND"
C	CALL APOPEN(5,2,'DAT','Enter the Output FILE NAME: ',28,ERROR)
C
C
C	PREFIXING THE SUBROUTINE NAME WITH AN 'R' REQUIRES 2 MORE 
C	ARGUMENTS AS FOLLOWS:
C	FNAME = ARRAY TO CONTAIN FILE NAME
C	NC    = INTEGER TO CONTAIN NUMBER OF CHARACTERS IN FNAME
C
	BYTE TYPE(3), FILE(34), MSG , FNAME(34)
	DIMENSION MSG(NCHR)
	LOGICAL*1 NEWFIL,ERROR,DAFILE,COPY, APPND
C
	COPY = .FALSE.
 10	NEWFIL = .FALSE.
	DAFILE = .TRUE.
	APPND = .FALSE.
	GO TO 99
C
C-----     ENTRY FOR OUTPUT FILE
	ENTRY PROPEN(ITR,LUN,TYPE,MSG,ICHR,ERROR)
	COPY = .FALSE.
 20	NEWFIL = .TRUE.
	DAFILE = .FALSE.
	APPND = .FALSE.
	GO TO 99
C
C-----    ENTRY FOR LIST TYPE OUTPUT FILE
	ENTRY DAOPEN(ITR,LUN,TYPE,MSG,ICHR,ERROR)
	COPY = .FALSE.
 30	NEWFIL = .TRUE.
	APPND = .FALSE.
	DAFILE = .TRUE.
	GO TO 99
C
C-----     APPEND
	ENTRY APOPEN(ITR,LUN,TYPE,MSG,ICHR,ERROR)
	COPY = .FALSE.
40	NEWFIL = .FALSE.
	DAFILE = .TRUE.
	APPND = .TRUE.
	GO TO 99
C
C-----	SET COUNTER FOR NUMBER OF TRIES (ONLY 3 ALLOWED)
99	K = 0
	ERROR = .FALSE.
100	IF(K .EQ. 3)GO TO 190
C
C-----	GET THE NAME
C
	WRITE(ITR,110)MSG
110	FORMAT(/'$',80A1)
	READ(ITR,120,END=210)J,FILE
120	FORMAT(Q, 34A1)
C
C------- IF NO CHARACTERS INPUT RETURN ERROR
	IF (J .EQ. 0) GO TO 210
C
C------- CONVERT FROM LOWER CASE TO UPPER CASE AS REQUIRED
	DO 125 I=1,J
	IF (FILE(I) .GT. "140) FILE(I) = FILE(I) - "40
 125	CONTINUE
C
C-----	CHECK FOR EXISTANCE OF A FILE TYPE
C	LOOK FOR A PERIOD
	DO 130 I=1,J
C
C------- CHECK FOR A BLANK - MIGHT HAVE BEEN READ FROM CARDS
	IF (FILE(I) .EQ. ' ') GO TO 155
	IF(FILE(I) .EQ. '.')GO TO 170
130	CONTINUE
C
C----	NO PERIOD - THEREFORE NO FILE TYPE
C	IS THERE ROOM FOR ONE? IF YES-THEN ADD ONE-ELSE ERROR
	IF(J .LE. 27)GO TO 160
140	WRITE(ITR,150)
150	FORMAT(' *** ERROR IN THE NAME ***')
	K = K + 1
	GO TO 100
C
C------- READJUST LENGTH
 155	J = I - 1
C
C-----	ADD A FILE TYPE
160	FILE(J+1) = '.'
	FILE(J+2) = TYPE(1)
	FILE(J+3) = TYPE(2)
	FILE(J+4) = TYPE(3)
	J = J + 4
	GO TO 180
C
C-----	A PERIOD HAS BEEN FOUND- CHECK FOR 3 OR MORE CHAR. FOLLOWING
170	IF(J .LT. I+3)GO TO 140
C
C-----	A PROPER FILE TYPE  - ATTEMPT TO OPEN FILE
180	K = K + 1
	FILE(J+1) = 0
C
C-----     OPEN AN INPUT FILE
	IF ( NEWFIL ) GO TO 185
	IF( APPND ) GO TO 182
	OPEN(UNIT=LUN,NAME=FILE, ERR=100, TYPE='OLD',READONLY)
	GO TO 183
C
182	OPEN(UNIT=LUN,NAME=FILE,ERR=100,TYPE='OLD',ACCESS='APPEND')
C
C
C-----	     SUCCESS   -   RETURN
183	IF (.NOT. COPY) RETURN
	DO 184 K=1,J+1
	FNAME(K) = FILE(K)
 184	CONTINUE
	NC = J
C
	RETURN
C
C-----     OPEN AN OUTPUT FILE    IS IT "LIST" OR "FORMAT"?
185	IF( DAFILE ) GO TO 187
	OPEN(UNIT=LUN,NAME=FILE, ERR=100, TYPE='NEW')
C
C-----     SUCCESS   RETURN
	GO TO 183
C
187	OPEN(UNIT=LUN,NAME=FILE,ERR=100,TYPE='NEW',
     *	 CARRIAGECONTROL='LIST')
C
C-----     SUCCESS  RETURN
	GO TO 183
C
C-----    THREE STRIKES  -  YOU'RE  OUT!
190	WRITE(ITR,200)
200	FORMAT(' Please Check for Correct FILE NAME'//)
210	ERROR = .TRUE.
	RETURN
C
	ENTRY RINOPE (ITR,LUN,TYPE,MSG,NCHR,ERROR,FNAME,NC)
	COPY = .TRUE.
	GO TO 10
C
	ENTRY RPROPE (ITR,LUN,TYPE,MSG,NCHR,ERROR,FNAME,NC)
	COPY = .TRUE.
	GO TO 20
C
	ENTRY RDAOPE (ITR,LUN,TYPE,MSG,NCHR,ERROR,FNAME,NC)
	COPY = .TRUE.
	GO TO 30
	ENTRY RAPOPE(ITR,LUN,TYPE,MSG,NCHR,ERROR,FNAME,NC)
	COPY = .TRUE.
	GO TO 40
C
	END
	SUBROUTINE GETNAM(LUN1,LUN2,NEMP,NAME,NVALID)
C
C-----    SUBROUTINE TO GET EMPLOYEE NAME GIVEN THE NUMBER
C
C	LUN1	= AVAILABLE LUN
C
C	LUN2	= AVAILABLE LUN
C
C	NAME	= 30 BYTE ARRAY INTO WHICH THE NAME WILL BE PLACED
C
C	NEMP	= INTEGER EMPLOYEE NUMBER
C
C	NVALID	= LOGICAL *1 VARIABLE = .TRUE. IF NUMBER IS VALID
C					ELSE .FALSE.
C
C
	BYTE NAME(30)
	LOGICAL *1 NEW, NVALID
	DATA NEW /.TRUE./
C
C-----     INITIALIZE
	IF( .NOT. NEW ) GO TO 100
	DEFINE FILE LUN1 (12289,1,U,IJKL)
	CALL FDBSET(LUN1,'READONLY')
	OPEN(UNIT=LUN2,NAME='LB0:[70,24]EMPLNAM.DAT',
	1	ACCESS='DIRECT',READONLY,SHARED,TYPE='OLD',
	2	RECORDSIZE=8)
	CALL ASSIGN (LUN1,'LB0:[70,24]EMPLPTR.DAT')
	NEW = .FALSE.
C
100	NVALID = .FALSE.
	IF(NEMP .GT. 12289)RETURN
	IF (NEMP .LE. 0) RETURN
C
	READ(LUN1'NEMP) IREC
	IF (IREC .EQ. 0) GO TO 160
	READ(LUN2'IREC) IN,NAME
	NVALID = .TRUE.
C
	RETURN
C
C-----     NO MATCH
160	NAME(1) = 'N'
	NAME(2) = 'O'
	NAME(3) = 'T'
	NAME(4) = ' '
	NAME(5) = 'V'
	NAME(6) = 'A'
	NAME(7) = 'L'
	NAME(8) = 'I'
	NAME(9) = 'D'
	DO 170 I = 10, 30
170	NAME(I) = ' '
C
	RETURN
C
	END
	SUBROUTINE U1FIND (LUN,TNAME,JU,NREC,MATCH,NREAD)
C
C-----    SUBROUTINE TO GET THE UIC GIVEN THE NAME
C
C	LUN	= LOGICAL UNIT NUMBER OF THE FILE
C		  [1,100]PDSUPF.DAT WHICH SHOULD HAVE
C		  BEEN OPENED WITH:
C		  OPEN(UNIT=LUN,TYPE='OLD',ACCESS='DIRECT',
C		*  SHARED,READONLY,NAME='[1,100]PDSUPF.DAT')
C
C	TNAME	= 12 BYTE ARRAY CONTAINING THE USER NAME FOR
C		  FOR WHICH THE UIC IS DESIRED.
C
C	JU	= 2 INTEGER ARRAY WHICH WILL CONTAIN THE UIC
C		  JU(1) CONTAINS THE GROUP NUMBER
C		  JU(2) CONTAINS THE "OWNER"
C
C	NREC	= RECORD NUMBER IN THE FILE IN WHICH TNAME WAS
C		  FOUND.  OR, IF NO MATCH WAS FOUND, NREC IS THE
C		  NUMBER OF THE RECORD IMMEDIATELY AFTER WHICH
C		  TNAME WOULD BELONG.
C
C	MATCH	= 1 IF A MATCH WAS FOUND, = 0 IF NO MATCH
C
C	NREAD	= THE NUMBER OF FILE ACCESSES TO FIND A MATCH
C		  OR TO DECIDE THAT ONE DOESN'T EXIST
C
	LOGICAL*1 NEW
C
C
	BYTE BREC(64),TNAME(12)
C
	DIMENSION IREC(32),JU(2),INAME(4)
C
	EQUIVALENCE (IREC,BREC)
C
	DATA NEW /.TRUE./
C
C------- CONVERT USER NAME TO ASCII
	CALL IRAD50 (12,TNAME,INAME)
C
C------- READ FIRST RECORD FOR COUNTS
	IF (NEW) READ (LUN'1) IF,IL
	NEW = .FALSE.
C
C------- COMPUTE LAST INDEX RECORD
C	NL = (IL+4) / 8 + 1
	NL = (IL - IF + 8) / 8 + 1  !   GSO 6/7/79
C
C------- SET RECORD POINTER
	NREC = IF - 1
C
C------- ZERO READ COUNT
	NREAD = 0
C
C------- LOOP THRU INDEX RECORDS
	DO 1000 I=2,NL
C
	READ (LUN'I) IREC
C
C------- INCREMENT READ COUNT
	NREAD = NREAD + 1
C
C------- CHECK INDEX RECORDS
	DO 500 J=1,32,4
	NREC = NREC + 1
	IF(NREC .GT. IL) GO TO  1010  !   GSO 6/7/79
	DO 400 K=1,4
	IF (INAME(K) .NE. IREC(K+J-1)) GO TO 500
 400	CONTINUE
C
C------- FOUND MATCH
	GO TO 2000
 500	CONTINUE
 1000	CONTINUE
C
C------- NO MATCH
1010	MATCH = 0
	RETURN
C
C------- MATCH
 2000	MATCH = 1
C
C------- READ RECORD
	READ (LUN'NREC) IREC
	NREAD = NREAD + 1
	JU(1) = BREC(10)
	JU(1) = JU(1) .AND. "377
	JU(2) = BREC(9)
	JU(2) = JU(2) .AND. "377
C
	RETURN
C
	END