PROGRAM DFX
C
C	THIS PROGRAM WAS WRITTEN TO FULFILL A NEED FOR A PROGRAM
C	THAT WILL CHANGE ONE TYPE OF DATA FILE INTO ANOTHER
C	THAT CAN BE USED BY ANOTHER PROGRAM.  (BASICALLY
C	FROM FORMATTED TO UNFORMATTED).  A MORE EXTENSIVE
C	PROGRAM WAS DEVELOPED TO PROVIDE MANY MORE OPTIONS.
C	IT WAS WRITTEN TO CONFORM TO THE STANDARD UTILITIES
C	FOUND FOR USE ON THE PDP-11/55.
C	IN ADDITION TO CHANGING THE FORMAT TYPE, DIRECT ACCESS
C	FILES CAN ALSO BE CHANGED TO SEQUENTIAL AND VISEVERSA.
C	CARRIAGECONTROL CAN ALSO BE CHANGED.
C
C	THE MOST IMPORTANT FEATURE OF THIS
C	PROGRAM IS THE ABILITY TO CHANGE DATA TYPES.
C	CONVERSION CAN BE MADE BETWEEN FLOATING,INTEGER,AND COMPLEX.
C	CARE MUST BE TAKEN IN THE CONVERSION FROM FLOATING TO INTEGER
C	AS NO PROVISION IS MADE FOR DATA RANGE CHECKING.
C	ERROR MESSAGES ARE GIVEN FOR INCORRECT SWITCH ARANGEMENTS.
C
C	AUTHOR:		JEFF HAMILTON
C			E-SYSTEMS, INC.
C			P.O.BOX 1056
C			GREENVILLE, TEXAS 75401
C			(214)454-4175
C	DATE:		20-FEB-80
C
C	JLH001-10/22/80
C
C		ADDED COMPLX(BOTH) ON INPUT (SQRT(X**2+Y**2))
C		ADDED DOUBLE PRECISION IN
C		ADDED DOUBLE PRECISION OUT
C		ADDED INTEGER*4 IN
C		ADDED INTEGER*4 OUT
C		ADDED INDIRECT COMMAND FILE
C		CHANGED CONVERSION TO SUBROUTINE
C
C
	BYTE MCRLIN(80),LINE(200),FILE(22),INDFIL(33)
	COMPLEX*8 C
	DOUBLE PRECISION DP
	INTEGER*4 I4VAR
	LOGICAL *1 DELETE(2),DIRECT(2),FORMAT(2)
	LOGICAL*1 APPEND,BLOCK,CMDLIN,INDIRC,FILTYP
	INTEGER RECNUM,RECSIZ,TYPE(2),FLOTE,INTIG,REEL,IMAG
	INTEGER COMPLX(3),OUT,BOTH,ERRNUM,CARCON,ERHOLD,RECMAX
	INTEGER DOUB,I4,ATPOS
	DATA ERRNUM/0/
	DATA FLOTE/1/INTIG/2/COMPLX/3,4,5/DOUB/6/I4/7/
	DATA REEL/1/IMAG/2/BOTH/3/
	DATA IN/1/OUT/2/
C
C	START OF THE PROGRAM
C
	INDIRC=.FALSE.
	FILTYP=.FALSE.
	CALL ASNLUN(1,'SY',0)
	CALL ASNLUN(2,'SY',0)
	CALL ASNLUN(3,'SY',0)
	CALL ASNLUN(4,'SY',0)
	CALL ASNLUN(5,'TI',0)
	CALL ASNLUN(6,'TI',0)
	CALL GETMCR(MCRLIN,ISTAT)
	IF(ISTAT.EQ."3.OR.ISTAT.EQ.-80)GO TO 10
	CMDLIN=.TRUE.
	J=ISTAT-4
	DO 5,I=1,J
	IF(MCRLIN(I+4).EQ.'@')INDIRC=.TRUE.
	IF(MCRLIN(I+4).EQ.'@')ATPOS=I+4
5	LINE(I)=MCRLIN(I+4)
	IF(INDIRC)GO TO 7
	GO TO 20
7	CALL ASNLUN(6,'NL',0)
	CALL ASNLUN(5,'SY',0)
	DO 8,NN=ATPOS+1,ISTAT
	IF(MCRLIN(NN).EQ.'.')FILTYP=.TRUE.
8	INDFIL(NN-ATPOS)=MCRLIN(NN)
	IF(FILTYP)GO TO 9
	INDFIL(ISTAT-ATPOS+1)='.'
	INDFIL(ISTAT-ATPOS+2)='C'
	INDFIL(ISTAT-ATPOS+3)='M'
	INDFIL(ISTAT-ATPOS+4)='D'
9	OPEN(UNIT=5,NAME=INDFIL,TYPE='OLD')
10	J=1
11	WRITE(6,1000)
	CMDLIN=.FALSE.
1000	FORMAT($,1X,'DFX>')
	READ(5,1001,END=250),N,(LINE(I),I=J,N+J-1)
1001	FORMAT(Q,132A1)
	IF(N.EQ.0)GO TO 15
	J=N+1
	IF(LINE(N+J-1).NE.'-')GO TO 15
	GO TO 11
15	J=J-1
20	K=1
	CALL FILNAM(LINE,FILE,J,K,ERRNUM)
	CALL ERROR(ERRNUM)
	CALL SWITCH(LINE,J,K,ERRNUM,DIRECT(OUT),APPEND
	1,FORMAT(OUT),DELETE(OUT),CARCON,BLOCK,BLOKSZ
	2,RECSIZ,TYPE(OUT),RECMAX)
	IF(DELETE(OUT))ERRNUM=301
	CALL ERROR(ERRNUM)
	CALL OPENER(FILE,OUT,DIRECT(OUT),APPEND,FORMAT(OUT)
	1,DELETE,CARCON,BLOCK,BLOKSZ,RECSIZ,TYPE(OUT)
	2,ERRNUM,RECMAX)
	CALL ERROR(ERRNUM)
	CALL FILNAM(LINE,FILE,J,K,ERRNUM)
	CALL ERROR(ERRNUM)
	CALL SWITCH(LINE,J,K,ERRNUM,DIRECT(IN),APPEND
	1,FORMAT(IN),DELETE(IN),CARCON,BLOCK,BLOKSZ
	2,RECSIZ,TYPE(IN),RECMAX)
	CALL ERROR(ERRNUM)
	IF(APPEND)ERRNUM=302
	CALL ERROR(ERRNUM)
	CALL OPENER(FILE,IN,DIRECT(IN),APPEND,FORMAT(IN)
	1,DELETE,CARCON,BLOCK,BLOKSZ,RECSIZ,TYPE(IN)
	2,ERRNUM,RECMAX)
	ERHOLD=ERRNUM
	CALL ERROR(ERRNUM)
	IF(ERHOLD.EQ.405)GO TO 200
	RECNUM=1
25	CONTINUE
	IF(DIRECT(IN))GO TO 42
	IF(TYPE(IN).EQ.FLOTE)GO TO 30
	IF(TYPE(IN).EQ.INTIG)GO TO 35
	IF(TYPE(IN).EQ.COMPLX(REEL))GO TO 40
	IF(TYPE(IN).EQ.COMPLX(IMAG))GO TO 40
	IF(TYPE(IN).EQ.COMPLX(BOTH))GO TO 40
	IF(TYPE(IN).EQ.DOUB)GO TO 41
	IF(TYPE(IN).EQ.I4)GO TO 36
	ERRNUM=304
C
C		READ SECTION
C
	CALL ERROR(ERRNUM)
30	IF(FORMAT(IN))READ(IN,*,END=200,ERR=312)A
	IF(.NOT.FORMAT(IN))READ(IN,END=200,ERR=312)A
	GO TO 60
35	IF(FORMAT(IN))READ(IN,*,END=200,ERR=312)NUM
	IF(.NOT.FORMAT(IN))READ(IN,END=200,ERR=312)NUM
	GO TO 60
36	IF(FORMAT(IN))READ(IN,*,END=200,ERR=312)I4VAR
	IF(.NOT.FORMAT(IN))READ(IN,END=200,ERR=312)I4VAR
	GO TO 60
40	IF(FORMAT(IN))READ(IN,*,END=200,ERR=312)C
	IF(.NOT.FORMAT(IN))READ(IN,END=200,ERR=312)C
	GO TO 60
41	IF(FORMAT(IN))READ(IN,*,END=200,ERR=312)DP
	IF(.NOT.FORMAT(IN))READ(IN,END=200,ERR=312)DP
	GO TO 60
42	CONTINUE
	IF(TYPE(IN).EQ.FLOTE)GO TO 50
	IF(TYPE(IN).EQ.INTIG)GO TO 51
	IF(TYPE(IN).EQ.COMPLX(REEL).OR
	1.TYPE(IN).EQ.COMPLX(IMAG).OR
	2.TYPE(IN).EQ.COMPLX(BOTH))GO TO 52
	IF(TYPE(IN).EQ.DOUB)GO TO 53
	IF(TYPE(IN).EQ.I4)GO TO 54
	ERRNUM=304
	CALL ERROR(ERRNUM)
50	READ(IN'RECNUM,END=200,ERR=311)A
	GO TO 60
51	READ(IN'RECNUM,ERR=311,END=200)NUM
	GO TO 60
52	READ(IN'RECNUM,END=200,ERR=311)C
	GO TO 60
53	READ(IN'RECNUM,END=200,ERR=311)DP
	GO TO 60
54	READ(IN'RECNUM,END=200,ERR=311)I4VAR
60	CALL CONVRT(TYPE,A,C,NUM,DP,I4VAR)
63	IF(DIRECT(OUT))GO TO 80
	IF(TYPE(OUT).EQ.FLOTE)GO TO 65
	IF(TYPE(OUT).EQ.INTIG)GO TO 70
	IF(TYPE(OUT).EQ.COMPLX(REEL).OR.TYPE(OUT).EQ
	1.COMPLX(IMAG).OR.TYPE(OUT).EQ.COMPLX(BOTH))
	2GO TO 75
	IF(TYPE(OUT).EQ.DOUB)GO TO 77
	IF(TYPE(OUT).EQ.I4)GO TO 78
	ERRNUM=305
	CALL ERROR(ERRNUM)
C
C	WRITE SECTION
C
65	IF(FORMAT(OUT))WRITE(OUT,*,ERR=313)A
	IF(.NOT.FORMAT(OUT))WRITE(OUT,ERR=313)A
	GO TO 95
70	IF(FORMAT(OUT))WRITE(OUT,*,ERR=313)NUM
	IF(.NOT.FORMAT(OUT))WRITE(OUT,ERR=313)NUM
	GO TO 95
75	IF(FORMAT(OUT))WRITE(OUT,*,ERR=313)C
	IF(.NOT.FORMAT(OUT))WRITE(OUT,ERR=313)C
	GO TO 95
77	IF(FORMAT(OUT))WRITE(OUT,*,ERR=313)DP
	IF(.NOT.FORMAT(OUT))WRITE(OUT,ERR=313)DP
	GO TO 95
78	IF(FORMAT(OUT))WRITE(OUT,*,ERR=313)I4VAR
	IF(.NOT.FORMAT(OUT))WRITE(OUT,ERR=313)I4VAR
	GO TO 95
80	IF(TYPE(OUT).EQ.FLOTE)WRITE(OUT'RECNUM,ERR=313)A
	IF(TYPE(OUT).EQ.INTIG)WRITE(OUT'RECNUM,ERR=313)NUM
	IF(TYPE(OUT).EQ.COMPLX(REEL).OR
	1.TYPE(OUT).EQ.COMPLX(IMAG).OR
	2.TYPE(OUT).EQ.COMPLX(BOTH))WRITE(OUT'RECNUM,ERR=313)C
	IF(TYPE(OUT).EQ.DOUB)WRITE(OUT'RECNUM,ERR=313)DP
	IF(TYPE(OUT).EQ.I4)WRITE(OUT'RECNUM,ERR=313)I4VAR
	IF(RECNUM.GE.RECMAX)GO TO 200
95	CONTINUE
	GO TO 25
C
C	CLOSER SECTION
C
200	IF(DELETE(IN))CLOSE(UNIT=IN,DISPOSE='DELETE',ERR=309)
	IF(.NOT.DELETE(IN))CLOSE(UNIT=IN,ERR=309)
	IF(DELETE(OUT))CLOSE(UNIT=OUT,DISPOSE='DELETE',ERR=310)
	IF(.NOT.DELETE(OUT))CLOSE(UNIT=OUT,ERR=310)
	IF(.NOT.CMDLIN)GO TO 10
250	CALL EXIT
309	ERRNUM=306
	CALL ERROR(ERRNUM)
310	ERRNUM=307
	CALL ERROR(ERRNUM)
311	ERRNUM=308
	CALL ERROR(ERRNUM)
312	ERRNUM=309
	CALL ERROR(ERRNUM)
313	ERRNUM=310
	CALL ERROR(ERRNUM)
	END

	SUBROUTINE FILNAM(LINE,FILE,LAST,NOW,ERRNUM)
	BYTE FILE(22),LINE(200)
	INTEGER ERRNUM
C
C	FIRST INITIALIZE THE FILE NAME TO BLANK
	DO 10,I=1,22
10	FILE(I)="0
	IF(NOW.EQ.LAST)ERRNUM=101
	IF(NOW.LT.1)ERRNUM=102
	IF(LAST.LT.1)ERRNUM=103
C
C	GET FILE NAME FROM COMMAND LINE
	DO 100,I=NOW,LAST
	J=I+1-NOW
	IF(LINE(I).EQ.'/')GO TO 101
	IF(LINE(I).EQ.'=')GO TO 101
100	FILE(J)=LINE(I)
101	NOW=I
	RETURN
	END

	SUBROUTINE SWITCH(LINE,LAST,NOW,ERRNUM,DIRECT,APPEND
	1,FORMAT,DELETE,CARCON,BLOCK,BLOKSZ,RECSIZ,TYPE,RECMAX)
	LOGICAL*1 DIRECT,APPEND,FORMAT,DELETE,BLOCK
	BYTE LINE(200)
	INTEGER DOUB,I4
	INTEGER ERRNUM,CARCON,LIST,FORTRN,NONE,BLOKSZ,RECSIZ
	INTEGER TYPE,FLOTE,INTIG,COMPLX(3),REEL,IMAG,BOTH,RECMAX
	DATA LIST/1/FORTRN/2/NONE/3/
	DATA FLOTE/1/INTIG/2/COMPLX/3,4,5/REEL/1/IMAG/2/BOTH/3/
	DATA DOUB/6/I4/7/
C
C	INITIALIZE
C
	RECSIZ=0
	CARCON=1
	TYPE=1
	DIRECT=.FALSE.
	APPEND=.FALSE.
	FORMAT=.TRUE.
	DELETE=.FALSE.
	BLOCK=.FALSE.
C
C	FIND THE PARAMETERS
C
	DO 10,I=NOW,LAST
	IF(LINE(I).EQ.'=')GO TO 15
	IF(LINE(I).EQ.'/')GO TO 20
10	CONTINUE
	NOW=LAST
	GO TO 40
15	NOW=I+1
	GO TO 40
C
C
C		SWITCH PROCESSING
C
C
20	IF(LINE(I+1).EQ.'A')GO TO 21
	IF(LINE(I+1).EQ.'F')GO TO 22
	IF(LINE(I+1).EQ.'D')GO TO 23
	IF(LINE(I+1).EQ.'C')GO TO 24
	IF(LINE(I+1).EQ.'B')GO TO 25
	IF(LINE(I+1).EQ.'R')GO TO 28
	IF(LINE(I+1).EQ.'T')GO TO 60
	IF(LINE(I+1).EQ.'M')GO TO 35
	ERRNUM=201
	RETURN
C
C	DIRECT,SEQUENTIAL,APPEND
C
21	IF(LINE(I+3).NE.'S'.AND.LINE(I+3).NE.'D'
	1.AND.LINE(I+3).NE.'A')GO TO 45
	IF(LINE(I+3).EQ.'S')DIRECT=.FALSE.
	IF(LINE(I+3).EQ.'D')DIRECT=.TRUE.
	IF(LINE(I+3).EQ.'A')APPEND=.TRUE.
	GO TO 10
C
C	FORMATTED,UNFORMATTED
C
22	IF(LINE(I+3).NE.'F'.AND.LINE(I+3).NE.'U')GO TO 46
	IF(LINE(I+3).EQ.'F')FORMAT=.TRUE.
	IF(LINE(I+3).EQ.'U')FORMAT=.FALSE.
	GO TO 10
C
C	DELETE FILE WHEN FINISHED,SAVE FILE
C
23	IF(LINE(I+3).NE.'D'.AND.LINE(I+3).NE.'S')GO TO 47
	IF(LINE(I+3).EQ.'D')DELETE=.TRUE.
	IF(LINE(I+3).EQ.'S')DELETE=.FALSE.
	GO TO 10
C
C	CARRIAGECONTROL
C
24	IF(LINE(I+3).NE.'F'.AND.LINE(I+3).NE.'L'
	1.AND.LINE(I+3).NE.'N')GO TO 48
	IF(LINE(I+3).EQ.'F')CARCON=FORTRN
	IF(LINE(I+3).EQ.'L')CARCON=LIST
	IF(LINE(I+3).EQ.'N')CARCON=NONE
	GO TO 10
C
C	SET BLOCK SIZE
C
25	BLOCK=.TRUE.
	DO 26,L=I+3,I+7
	IF(LINE(L).EQ.'/'.OR.LINE(L).EQ.'='.OR
	1.L.EQ.LAST)GO TO 27
26	CONTINUE
	ERRNUM=202
	RETURN
27	NSTOP=L-(I+3)
	DECODE(NSTOP,101,LINE(I+3))BLOKSZ
101	FORMAT(I<NSTOP>)
	GO TO 10
C
C	SET RECORD SIZE
C
28	DO 29,LM=I+3,I+7
	IF(LINE(LM).EQ.'/'.OR.LINE(LM).EQ.'='.OR.LM.EQ.LAST)GO TO 30
29	CONTINUE
	ERRNUM=203
	RETURN
30	NSTOP=LM-(I+3)
	DECODE(NSTOP,101,LINE(I+3))RECSIZ
	GO TO 10
C
C	SET MAX RECORDS FOR DIRECT ACCESS
C
35	DO 36,LN=I+3,I+7
	IF(LINE(LN).EQ.'/'.OR.LINE(LN).EQ.'='
	1.OR.LINE(LN).EQ.LAST)GO TO 37
36	CONTINUE
37	IF(LN.EQ.LAST)LN=LN+1
	NSTOP=LN-(I+3)
	DECODE(NSTOP,101,LINE(I+3))RECMAX
	GO TO 10
C
C	TYPE-REAL,INTEGER,COMPLEX(REAL PART,IMAGINARY PART, OR BOTH)
C	ADDED DOUBLE PRECISION, INTEGER*4
C
60	IF(LINE(I+3).EQ.'F')TYPE=FLOTE
	IF(LINE(I+3).EQ.'R')TYPE=REEL
	IF(LINE(I+3).EQ.'I')TYPE=INTIG
	IF(LINE(I+3).EQ.'D')TYPE=DOUB
	IF(LINE(I+3).EQ.'4')TYPE=I4
	IF(LINE(I+3).EQ.'C'.AND
	1.LINE(I+4).EQ.'R')TYPE=COMPLX(REEL)
	IF(LINE(I+3).EQ.'C'.AND
	1.LINE(I+4).EQ.'I')TYPE=COMPLX(IMAG)
	IF(LINE(I+3).EQ.'C'.AND
	1.LINE(I+4).NE.'R'.AND.LINE(I+4).NE.'I')
	2TYPE=COMPLX(BOTH)
	IF(LINE(I+3).EQ.'F'.OR.LINE(I+3).EQ.'R'.
	1OR.LINE(I+3).EQ.'D'.OR.LINE(I+3).EQ.'4'.
	2OR.LINE(I+3).EQ.'I'.OR.LINE(I+3).EQ.'C')GO TO 10
	ERRNUM=204
	RETURN
40	IF(.NOT.(DIRECT.AND.APPEND))GO TO 41
	ERRNUM=205
	RETURN
41	IF(.NOT.(DIRECT.AND.FORMAT))GO TO 42
	ERRNUM=206
	RETURN
42	IF(.NOT.(DIRECT.AND.RECSIZ.LE.0))GO TO 43
	ERRNUM=207
	RETURN
43	IF(DIRECT.OR.(RECSIZ.LE.0))GO TO 44
	ERRNUM=208
	RETURN
44	IF(.NOT.(DIRECT.AND.BLOCK))RETURN
	ERRNUM=209
	RETURN
45	ERRNUM=211
	RETURN
46	ERRNUM=212
	RETURN
47	ERRNUM=213
	RETURN
48	ERRNUM=214
	RETURN
	END

	SUBROUTINE OPENER(FILE,LU,DIRECT,APPEND,FORMAT,DELETE
	1,CARCON,BLOCK,BLOKSZ,RECSIZ,DATATY,ERRNUM,RECMAX)
	BYTE FILE(22)
	LOGICAL*1 DELETE(2),DIRECT,FORMAT,APPEND,BLOCK
	INTEGER CARCON,BLOKSZ,RECSIZ,TYPE,ERRNUM,DATATY,FORTRN
	INTEGER COMPLX(3),FLOTE,INTIG,REEL,IMAG,BOTH,IN,OUT,LU
	INTEGER RECMAX
	DATA FLOTE,INTIG,COMPLX,REEL,IMAG,BOTH/1,2,3,4,5,1,2,3/
	DATA IN,OUT,LIST,FORTRN,NONE/1,2,1,2,3/
	CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,15)
	TYPE=LU
	IF(DIRECT)GO TO 60
	IF(FILE(1).NE.'M'.AND.FILE(2).NE.'M'
	1.AND.FILE(4).NE.':'.AND.BLOCK)ERRNUM=401
	CALL ERROR(ERRNUM)
	IF(.NOT.FORMAT)GO TO 30
	IF(CARCON.EQ.FORTRN)GO TO 20
	IF(CARCON.EQ.NONE)GO TO 10
	IF(APPEND)GO TO 5
	IF(TYPE.EQ.OUT)GO TO 3
	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,CARRIAGECONTROL='LIST',ERR=70)
	GO TO 100
3	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,CARRIAGECONTROL='LIST')
	GO TO 100
5	OPEN(UNIT=LU,NAME=FILE,TYPE='UNKNOWN'
	1,CARRIAGECONTROL='LIST',ACCESS='APPEND')
	GO TO 100
10	IF(APPEND)GO TO 15
	IF(TYPE.EQ.OUT)GO TO 13
	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,CARRIAGECONTROL='NONE',ERR=70)
	GO TO 100
13	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,CARRIAGECONTROL='NONE')
	GO TO 100
15	OPEN(UNIT=LU,NAME=FILE,TYPE='UNKNOWN'
	1,CARRIAGECONTROL='NONE',ACCESS='APPEND')
	GO TO 100
20	IF(APPEND)GO TO 25
	IF(TYPE.EQ.OUT)GO TO 23
	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,CARRIAGECONTROL='FORTRAN',ERR=70)
	GO TO 100
23	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,CARRIAGECONTROL='FORTRAN')
	GO TO 100
25	OPEN(UNIT=LU,NAME=FILE,TYPE='UNKNOWN'
	1,CARRIAGECONTROL='FORTRAN',ACCESS='APPEND')
	GO TO 100
30	IF(CARCON.EQ.FORTRN)GO TO 50
	IF(CARCON.EQ.NONE)GO TO 40
	IF(APPEND)GO TO 35
	IF(TYPE.EQ.IN)GO TO 33
	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,CARRIAGECONTROL='LIST',FORM='UNFORMATTED')
	GO TO 100
33	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,CARRIAGECONTROL='LIST',FORM='UNFORMATTED',ERR=70)
	GO TO 100
35	OPEN(UNIT=LU,NAME=FILE,TYPE='UNKNOWN'
	1,CARRIAGECONTROL='LIST',FORM='UNFORMATTED'
	2,ACCESS='APPEND')
	GO TO 100
40	IF(APPEND)GO TO 45
	IF(TYPE.EQ.OUT)GO TO 43
	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,CARRIAGECONTROL='NONE',FORM='UNFORMATTED',ERR=70)
	GO TO 100
43	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,CARRIAGECONTROL='NONE',FORM='UNFORMATTED')
	GO TO 100
45	OPEN(UNIT=LU,NAME=FILE,TYPE='UNKNOWN'
	1,CARRIAGECONTROL='NONE',FORM='UNFORMATTED'
	2,ACCESS='APPEND')
	GO TO 100
50	IF(APPEND)GO TO 55
	IF(TYPE.EQ.OUT)GO TO 53
	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,CARRIAGECONTROL='FORTRAN',FORM='UNFORMATTED',ERR=70)
	GO TO 100
53	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,CARRIAGECONTROL='FORTRAN',FORM='UNFORMATTED')
	GO TO 100
55	OPEN(UNIT=LU,NAME=FILE,TYPE='UNKNOWN'
	1,CARRIAGECONTROL='FORTRAN',FORM='UNFORMATTED'
	2,ACCESS='APPEND')
	GO TO 100
60	IF(FORMAT)ERRNUM=402
	CALL ERROR(ERRNUM)
	IF(BLOCK)ERRNUM=403
	CALL ERROR(ERRNUM)
	IF(APPEND)ERRNUM=404
	CALL ERROR(ERRNUM)
	IF(RECMAX.LE.0)ERRNUM=406
	CALL ERROR(ERRNUM)
	IF(TYPE.EQ.OUT)GO TO 65
	OPEN(UNIT=LU,NAME=FILE,TYPE='OLD'
	1,FORM='UNFORMATTED',ACCESS='DIRECT'
	2,RECORDSIZE=RECSIZ,MAXREC=RECMAX)
	GO TO 100
65	OPEN(UNIT=LU,NAME=FILE,TYPE='NEW'
	1,FORM='UNFORMATTED',ACCESS='DIRECT'
	2,RECORDSIZE=RECSIZ,MAXREC=RECMAX)
	GO TO 100
70	CALL ERRTST(29,J)
	IF(J.EQ.2)GO TO 100
	ERRNUM=405
	DELETE(OUT)=.TRUE.
100	CONTINUE
	RETURN
	END

	SUBROUTINE CONVRT(TYPE,A,C,NUM,DP,I4VAR)
C
C	SUBROUTINE THAT DOES THE DATA TYPES CONVERSION
C
	INTEGER*2 NUM
	INTEGER*4 I4VAR
	DOUBLE PRECISION DP
	REAL A
	COMPLEX*8 C
	INTEGER*2 TYPE(2),FLOTE,REEL,IMAG,DOUB,I4
	INTEGER*2 COMPLX(3),OUT,IN,BOTH,INTIG
	DATA FLOTE/1/INTIG/2/COMPLX/3,4,5/DOUB/6/I4/7/
	DATA REEL/1/IMAG/2/IN/1/OUT/2/BOTH/3/
C
C	DATA TYPE CONVERSION SECTION
C
60	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.FLOTE)RETURN
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.INTIG)RETURN
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.COMPLX(BOTH))RETURN
	IF(TYPE(IN).EQ.DOUB.AND.TYPE(OUT).EQ.DOUB)RETURN
	IF(TYPE(IN).EQ.I4.AND.TYPE(OUT).EQ.I4)RETURN
C
C	INPUT TYPE IS INTEGER
C
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.FLOTE)A=FLOAT(NUM)
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.COMPLX(REEL))
	1C=CMPLX(FLOAT(NUM),0.)
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.COMPLX(IMAG))
	1C=CMPLX(0.,FLOAT(NUM))
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.COMPLX(BOTH))
	1C=CMPLX(FLOAT(NUM),0.)
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.DOUB)
	1DP=DBLE(NUM)
	IF(TYPE(IN).EQ.INTIG.AND.TYPE(OUT).EQ.I4)
	1I4VAR=NUM
C
C	TYPE INPUT IS FLOATING POINT
C
	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.COMPLX(BOTH))
	1C=CMPLX(A,0.)
	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.INTIG)NUM=INT(A)
	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.COMPLX(REEL))C=CMPLX(A,0.)
	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.COMPLX(IMAG))C=CMPLX(0.,A)
	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.DOUB)
	1DP=DBLE(A)
	IF(TYPE(IN).EQ.FLOTE.AND.TYPE(OUT).EQ.I4)
	1I4VAR=IFIX(A)
C
C	TYPE INPUT IS COMPLEX
C
	IF(TYPE(IN).EQ.COMPLX(REEL).AND.TYPE(OUT).EQ.INTIG)
	1NUM=INT(REAL(C))
	IF(TYPE(IN).EQ.COMPLX(IMAG).AND.TYPE(OUT).EQ.INTIG)
	1NUM=INT(AIMAG(C))
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.INTIG)
	1NUM=INT(SQRT(REAL(C)*REAL(C)+AIMAG(C)*AIMAG(C)))
	IF(TYPE(IN).EQ.COMPLX(REEL).AND.TYPE(OUT).EQ.FLOTE)
	1A=REAL(C)
	IF(TYPE(IN).EQ.COMPLX(IMAG).AND.TYPE(OUT).EQ.FLOTE)
	1A=AIMAG(C)
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.FLOTE)
	1A=SQRT(REAL(C)*REAL(C)+AIMAG(C)*AIMAG(C))
	IF(TYPE(IN).EQ.COMPLX(REEL).AND.TYPE(OUT).EQ.COMPLX(IMAG))
	1C=CMPLX(AIMAG(C),0.)
	IF(TYPE(IN).EQ.COMPLX(IMAG).AND.TYPE(OUT).EQ.COMPLX(REEL))
	1C=CMPLX(0.,REAL(C))
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.COMPLX(REEL))
	1C=CMPLX(SQRT(REAL(C)*REAL(C)+AIMAG(C)*AIMAG(C)),0.)
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.COMPLX(IMAG))
	1C=CMPLX(0.,SQRT(REAL(C)*REAL(C)+AIMAG(C)*AIMAG(C)))
	IF(TYPE(IN).EQ.COMPLX(REEL).AND.TYPE(OUT).EQ.DOUB)
	1DP=DBLE(REAL(C))
	IF(TYPE(IN).EQ.COMPLX(IMAG).AND.TYPE(OUT).EQ.DOUB)
	1DP=DBLE(AIMAG(C))
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.DOUB)
	1DP=DBLE(SQRT(REAL(C)*REAL(C)+AIMAG(C)*AIMAG(C)))
	IF(TYPE(IN).EQ.COMPLX(REEL).AND.TYPE(OUT).EQ.I4)
	1I4VAR=IFIX(REAL(C))
	IF(TYPE(IN).EQ.COMPLX(IMAG).AND.TYPE(OUT).EQ.I4)
	1I4VAR=IFIX(AIMAG(C))
	IF(TYPE(IN).EQ.COMPLX(BOTH).AND.TYPE(OUT).EQ.I4)
	1I4VAR=IFIX(SQRT(REAL(C)*REAL(C)+AIMAG(C)*AIMAG(C)))
C
C	TYPE INPUT IS DOUBLE PRECISION
C
	IF(TYPE(IN).EQ.DOUB.AND.TYPE(OUT).EQ.INTIG)
	1NUM=INT(DP)
	IF(TYPE(IN).EQ.DOUB.AND.TYPE(OUT).EQ.FLOTE)
	1A=SNGL(DP)
	IF(TYPE(IN).EQ.DOUB.AND.TYPE(OUT).EQ.COMPLX(REEL))
	1C=CMPLX(SNGL(DP),0.)
	IF(TYPE(IN).EQ.DOUB.AND.TYPE(OUT).EQ.COMPLX(IMAG))
	1C=CMPLX(0.,SNGL(DP))
	IF(TYPE(IN).EQ.DOUB.AND.TYPE(OUT).EQ.I4)
	1I4VAR=IFIX(SNGL(DP))
C
C	TYPE INPUT IS INTEGER*4
C
	IF(TYPE(IN).EQ.I4.AND.TYPE(OUT).EQ.INTIG)
	1NUM=I4VAL
	IF(TYPE(IN).EQ.I4.AND.TYPE(OUT).EQ.FLOTE)
	1A=FLOAT(IFVAR)
	IF(TYPE(IN).EQ.I4.AND.TYPE(OUT).EQ.COMPLX(REEL))
	1C=CMPLX(FLOAT(I4VAR),0.)
	IF(TYPE(IN).EQ.I4.AND.TYPE(OUT).EQ.COMPLX(IMAG))
	1C=CMPLX(0.,FLOAT(I4VAR))
	IF(TYPE(IN).EQ.I4.AND.TYPE(OUT).EQ.DOUB)
	1DP=DFLOAT(I4VAR)
	RETURN
	END
	SUBROUTINE ERROR(N)
	IF(N.EQ.0)RETURN
	GO TO (1000,2000,3000,4000,5000,6000,7000),N/100
C
C	FILENAME HANDELING
C
1000	IF(N.EQ.101)TYPE 101
	IF(N.EQ.102)TYPE 102
	IF(N.EQ.103)TYPE 103
	CALL EXIT
C
C	SWITCH ERRORS
C
2000	IF(N.EQ.201)TYPE 201
	IF(N.EQ.202)TYPE 202
	IF(N.EQ.203)TYPE 203
	IF(N.EQ.204)TYPE 204
	IF(N.EQ.205)TYPE 205
	IF(N.EQ.206)TYPE 206
	IF(N.EQ.207)TYPE 207
	IF(N.EQ.208)TYPE 208
	IF(N.EQ.208)GO TO 8000
	IF(N.EQ.209)TYPE 209
	IF(N.EQ.210)TYPE 210
	IF(N.EQ.211)TYPE 211
	IF(N.EQ.212)TYPE 212
	IF(N.EQ.213)TYPE 213
	IF(N.EQ.214)TYPE 214
	IF(N.EQ.215)TYPE 215
	CALL EXIT
C
C	MAIN PROGRAM ERRORS
C
3000	IF(N.EQ.301)TYPE 301
	IF(N.EQ.302)TYPE 302
	IF(N.LE.302)GO TO 8000
	IF(N.EQ.303)TYPE 303
	IF(N.EQ.304)TYPE 304
	IF(N.EQ.305)TYPE 305
	IF(N.EQ.306)TYPE 306
	IF(N.EQ.307)TYPE 307
	IF(N.EQ.308)TYPE 308
	IF(N.EQ.309)TYPE 309
	IF(N.EQ.310)TYPE 310
	CALL EXIT
C
C	OPENER ERRORS
C
4000	IF(N.EQ.401)TYPE 401
	IF(N.EQ.402)TYPE 402
	IF(N.EQ.403)TYPE 403
	IF(N.EQ.404)TYPE 404
	IF(N.EQ.405)TYPE 405
	IF(N.EQ.406)TYPE 406
	IF(N.EQ.401.OR.N.EQ.403)GO TO 8000
	IF(N.EQ.405)GO TO 8000
	CALL EXIT
C
C	MISC ERRORS
C
5000	TYPE 500
	CALL EXIT
6000	CONTINUE
7000	CONTINUE
8000	N=0
	RETURN
101	FORMAT(1X,'DFX--NO FILE NAME FOUND')
102	FORMAT(1X,'DFX--ERROR FILNAM K<1')
103	FORMAT(1X,'DFX--ERROR FILNAM J<1')
201	FORMAT(1X,'DFX--UNKNOWN SWITCH')
202	FORMAT(1X,'DFX--UNKNOWN BLOCKSIZE')
203	FORMAT(1X,'DFX--UNKNOWN RECORDSIZE')
204	FORMAT(1X,'DFX--UNKNOWN DATA TYPE')
205	FORMAT(1X,'DFX--CANNOT APPEND DIRECT ACCESS')
206	FORMAT(1X,'DFX--CANNOT FORMAT DIRECT ACCESS')
207	FORMAT(1X,'DFX--RECORD SIZE MUST BE SET FOR DIRECT ACCESS')
208	FORMAT(1X,'DFX--RECORD SIZE SET FOR NON DIRECT-IGNORED')
209	FORMAT(1X,'DFX--CANNOT BLOCK DIRECT ACCESS')
210	FORMAT(1X,'DFX--UNKNOWN ERROR IN SWITCH')
211	FORMAT(1X,'DFX--UNKNOWN ACCESS')
212	FORMAT(1X,'DFX--UNKNOWN QUALIFIER FOR FORM')
213	FORMAT(1X,'DFX--UNKNOWN QUALIFIER FOR DISPOSE')
214	FORMAT(1X,'DFX--UNKNOWN QUALIFIER FOR CARRIAGECONTROL')
215	FORMAT(1X,'DFX--UNKNOWN MAX RECORDS')
301	FORMAT(1X,'DFX--DELETE ON OUTPUT-IGNORED')
302	FORMAT(1X,'DFX--APPEND ON INPUT-IGNORED')
303	FORMAT(1X,'DFX--COMPLEX OUT IF COMPLEX IN')
304	FORMAT(1X,'DFX--UNKNOWN DATA TYPE IN')
305	FORMAT(1X,'DFX--UNKNOWN DATA TYPE OUT')
306	FORMAT(1X,'DFX--ERROR CLOSING INPUT FILE')
307	FORMAT(1X,'DFX--ERROR CLOSING OUTPUT FILE')
308	FORMAT(1X,'DFX--ERROR DURING READ-DIRECT ACCESS')
309	FORMAT(1X,'DFX--ERROR DURING READ-SEQUENTIAL ACCESS')
310	FORMAT(1X,'DFX--ERROR DURING WRITE')
401	FORMAT(1X,'DFX--BLOCKING ON NON MAGTAPE-IGNORED')
402	FORMAT(1X,'DFX--CAN''T FORMAT DIRECT ACCESS')
403	FORMAT(1X,'DFX--CAN''T BLOCK DIRECT ACCESS-IGNORED')
404	FORMAT(1X,'DFX--CAN''T APPEND DIRECT ACCESS')
405	FORMAT(1X,'DFX--NO SUCH FILE')
406	FORMAT(1X,'DFX--MAX RECORDS REQUIRED FOR DIRECT ACCESS')
500	FORMAT(1X,'DFX--MUST USE COMMAND LINE')
	END