C.. DATAEN.FTN    BOHDEN K. CMAYLO    DEC 1981
C..
C..   MAIN SUBROUTINE FOR DATAENTRY
C..
	SUBROUTINE DATAEN
C.. KOUT=ARRAY FOR OUTPUT 1=FIELD, 2=COLUMN
	BYTE INPUT,MARRAY,IBLANK
	DIMENSION KOUT(2,250)
C.. KTYPES=ARRAY FOR RECORD TYPE, 1=CODE, 2=ADDRESS IN MARRAY
	DIMENSION KTYPES(2,25)
C.. KBTYPE= 1=CODE, 2=LINK
	BYTE KBTYPE(4,25),LTYPE,LTYPEO
	EQUIVALENCE (KTYPES,KBTYPE)
C..	INARR IS BROKEN UP AS:
C..	1=ID +1000=CONST -=USED  	2=+/-, +=NUMBER, -=ALPHA	3=MSG START IN MARRAY
C..	5=CHECK START IN MARRAY		4=PREVIOUS DATA IN MARRAY
	COMMON /XFORMX/INFORM,MXFORM,IRECO
C.. LONG VERSION = (5,999) WORDS AND (5000) BYTES
C.. SHORT VERSION = (5,99) WORDS AND (1000) BYTES
	COMMON/IOCOM/INCR,IPR,IEOF,INPUT(512),INARR(5,99)
	COMMON/XMAXID/MAXIDX
	COMMON/XIOCOM/MARRAX,MARRAY(1000)
C.. STORAGE FOR TYPE STUFF
	COMMON/XMTY/MTYMAX,MTY(250)
	EQUIVALENCE (XDATA,INPUT),(KINPUT,INPUT)
	DATA HEAD,DATA,OUTP,TYPE,ENDX/'HEAD','DATA','OUTP','TYPE','END'/
C..  MARRAX = MAXIMUM MARRAY COUNT    MAXID = FIELD COUNTER AND MAX
C..  MAXOUT=MAXIMUM OUTPUTS, MAXIDX=MAXIMUM ID ALLOWED
C..    KNTR=READ FIELD COUNTER, KNTW=WRITTEN RECORDS
C.. MAXTYP = MAXIMUM NUMBER OF TYPES
C..MAXCOL = MAX OUTPUT COLUMN NUMBER
	DATA MAXTYP,MAXOUT,MAXID,KNTRX,KNTR,KNTW,MAXCOL
     1 /25,250,0,0,0,0,512/
C.. IO UNITS 
	DATA IZERO,IBLANK,INCR,IPR,INFILE,IXFILE/0,' ',5,5,1,2/
C..  NKOUT = OUTPUT RECORD LIMITS
C.. IHEAD=LAST HEADER LINE, IDATA= FIRST DATA LINE, IREC=LAST LINE
	DATA NKOUT,IHEAD,IREC,KARR/0,0,0,0/
C..
C..	SYSTEM OPTION SQUEEZE
C..
	DATA ISQUZE,SQUZE/0,'SQUE'/
C..
C..	INITIALIZE
C..
	MXFORM=20
	CALL CRTINI
C..
	CALL DOWORD(INARR(1,1),INARR(5,MAXIDX),IZERO)
	CALL DOREAL(MARRAY(1),MARRAY(MARRAX-4),'        ')
C..
C..	GET DATA FILE FOR DEFINITIONS STARTED
C..
C..	SET NO ERROR MESSAGES FROM FORTRAN BAD NUMBER INPUT (ERROR 64)
	CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,100)
C.. IO ERRORS (29=NO FILE)
	CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,100)
C..
	CALL CRTWRT(0,12,'*** DATAENTRY PROGRAM ***..')
	IERR=0
	CALL DATENT(IERR,INFILE,INPUT)
	IF(IERR.EQ.0) GO TO 9
	WRITE(IPR,8)IERR,(INPUT(II),II=1,80)
8	FORMAT('0*** FATAL I/O ERROR #',I3//' *** FILE =',80A1)
	CALL EXIT
C..
C..	READ IN HEADER OR DATA SECTION NAME
C..
9	READ(INFILE,1)IQ,(INPUT(II),II=1,80)
1	FORMAT(Q,80A1)
	IF(XDATA.EQ.HEAD) GO TO 2
	IF(XDATA.EQ.DATA) GO TO 3
C..	CHECK FOR SYSTEM OPTION SQUEEZE, IF USED
C..
C..	SQUEEZE = BEFORE WRITING OUT DATA, SQUEEZE OUT ALL BLANKS
	IF(XDATA.EQ.SQUZE) ISQUZE=1
C..
C..	END OF SYSTEM OPTION
C..
	IF(XDATA.EQ.SQUZE) GO TO 9
C..
C..	ERROR, NOT HEAD OR DATA
C..
	CALL CRTERR(INPUT,IQ,'FIRST RECORD NOT HEADER OR DATA NAME..')
	CALL EXIT
C..
C..	HEADER DATA
C..
C..SET HEADER TO ALL CONSTANT
	KCHEAD=0
2	CALL INDATA(INFILE,IREC,KARR,DATA,MAXID,IERR,ICONST)
	IF(ICONST.EQ.0) KCHEAD=1
	IF(IREC.GT.0) GO TO 2
C..
C..	CHECK FOR CRTERR
C..
	IF(IREC.LT.0) GO TO 21
	CALL CRTERR(INPUT,IQ,'DATA SECTION NOT FOUND..')
	CALL EXIT
21	IHEAD=MAXID
	IREC=-IREC
C..
C..	DATA SECTION
C..
C..	SET DATA TO ALL CONSTANT
	KCDATA=0
3	CALL INDATA(INFILE,IREC,KARR,OUTP,MAXID,IERR,ICONST)
	IF(ICONST.EQ.1) KCDATA=1
	IF(IREC.GT.0) GO TO 3
C.. CHECK FOR ERRORS
	IF(IREC.LT.0) GO TO 4
	CALL CRTERR(INPUT,IQ,'OUTPUT SECTION NOT FOUND..')
	CALL EXIT
C..
C..	OUTPUT SECTION
C..
4	IDATA=IHEAD+1
	IREC=-IREC
	CALL OUTPIN(INFILE,KOUT,NKOUT,MAXOUT,MAXID,TYPE,ENDX,IERR)
C..
C..	SEE IF TYPE IS ON
C..
12	CONTINUE
	NTYPE=0
	IF(XDATA.EQ.ENDX) GO TO 121
	NTYPE=1
C..
C..	FIGURE TYPES
C..
	CALL TYPEIN
     1 (INFILE,MAXID,MAXTYP,MINTYP,KTYPES,KBTYPE,ENDX,IERR)
121	CONTINUE
C..
C..	END OF INFO, START OF DATA ENTRY
C..
	IF(IERR.LE.0) GO TO 13
	WRITE(IPR,14)IERR
14	FORMAT('0*** ERROR ***',I4,' ERRORS IN APPLICATION FILE..')
	CALL EXIT
C..
C..	*** USER OPTIONS SECTION ***
C..
C..	GET FILE NAME TO OUTPUT ON
C..
13	CLOSE (UNIT=INFILE)
	CALL CRTCLR(3)
	CALL CRTWRT(2,1,'*** ENTER OPTIONS ***..')
	CALL CRTPOS(3,1)
	CALL XINOUT(IERR,IXFILE,'OUT OUTPUT FILE NAME=',INPUT)
	IF(IERR.EQ.0) GO TO 1577
	WRITE(IPR,8)IERR,(INPUT(II),II=1,80)
	CALL EXIT
C..
C..	SEE IF Y/N DESIRED AT END OF RECORD
C..
1577	CALL CRTYN(7,1,'OK QUESTION ASKED AT END OF RECORD (D: Y) ?',IQ)
C..	NO
	KQEOF=0
C..	YES
	IF(IQ.GE.1) KQEOF=1
C..
C..	NO AUTO CR AT END OF FIELD
C..
	CALL CRTYN(9,1,'AUTO CARRIAGE RETURN AT FIELD END (D: Y) ?',IQ)
C..	NO
	KPNUM=1
C..	YES
	IF(IQ.GE.1) KPNUM=0
C..
C..	SEE IF FORM OR RANDOM ACCESS WANTED
C..
157	CONTINUE
	INFORM=0
	IF(NTYPE.NE.0) GO TO 1600
C.. SEE IF REGULAR OR RANDOM
	IRAND=0
	 CALL CRTYN(11,1,'DO YOU WANT RANDOM ACCESS (D: N) ?',IQ)
	CALL CRTCLR(0)
C..NO
	IF(IQ.EQ.0) IRAND=-1
C..YES
	IF(IQ.EQ.1) IRAND=1
C..DEFAULT
	IF(IQ.EQ.2) IRAND=-1
	GO TO 15
C.. SET REGULAR OR FORM FOR TYPE MODE
1600	CALL CRTYN(11,1,'DO YOU WANT FORM MODE (D: Y) ?',IQ)
	CALL CRTCLR(0)
C..YES
	IF(IQ.GE.1)INFORM=1
	IRAND=2
C..
C..	IF NOT RANDOM OR TYPE, GO TO REGULAR SECTION
C..
15	IF(IRAND.LT.0) GO TO 150
C..
C..	RANDOM SECTION OR TYPE SECTION
C..
C..	SEE IF NOT FIRST TIME
C..
	IF(IRAND.GT.1) GO TO 151
	IRAND=2
	IHEAD=0
	WRITE(IPR,153)
301	DO 152 I=1,MAXID
C.. GET MSG BEGINNING
	IF(INARR(1,I).EQ.0.OR.INARR(1,I).GT.1000) GO TO 152
	MSG=INARR(3,I)
	KNUM=INARR(2,I)
	IF(KNUM.LT.0) KNUM=-KNUM
	MSGL=INARR(4,I)+KNUM-1
	WRITE(IPR,153)(MARRAY(J),J=MSG,MSGL)
153	FORMAT('0',80A1)
152	CONTINUE
C..
C..	SPLIT RANDOM FROM TYPE
C..
151	IF(NTYPE.EQ.0) GO TO 1511
C..
C..	TYPE SECTION
C..
1512	CONTINUE
	IF(INFORM.GT.0) CALL CRTCLR(0)
1551	CALL CRTWRT(3,0,'TYPE - ?')
	CALL CRTPOS(3,5)
	CALL CRTRED(INPUT,1,INACT,ISPEC)
	INPUT(2)=' '
C..	RESET OK FLAG
	KNTRX=0
	IF(ISPEC.LT.0) GO TO 40
	IF(INACT.EQ.0) GO TO 1512
	IF(INPUT(1).EQ.'@') IEOF=IEOF+1
	IF(INPUT(1).EQ.'@') GO TO 31
1505	CONTINUE
	LTYPE1=0
	IEOF=0
C..
C..	FIND TYPE
C..
	DO 1513 ITYPE=1,MINTYP
	IF(INPUT(1).EQ.KBTYPE(1,ITYPE)) GO TO 1516
1513	CONTINUE
	CALL CRTERR(INPUT,1,'INVALID TYPE ENTERED..')
	GO TO 1551
C..
C..	SET UP FORM MODE, IF SET
C..
1516	KFORM=0
	MXFORM=20
C..SET LINK, IF ANY
	LTYPEO=INPUT(1)
	LTYPE=KBTYPE(2,ITYPE)
	IF(INFORM.LE.0) GO TO  1514
	INFORM=1
	KFORM=1
	CALL CRTCLR(0)
	KTYPEC=KTYPES(2,ITYPE)
1517	ID=MTY(KTYPEC)
	IF(ID.LE.0) GO TO 1514
	IF(INFORM.GT.20) GO TO 1570
	IX=INARR(3,ID)
	CALL CRTWRT(INFORM,0,MARRAY(IX))
	INFORM=INFORM+1
	KTYPEC=KTYPEC+1
	GO TO 1517
1570	CALL CRTERR(0,0,'FORM LIMITED TO 20 LINES PER TYPE..')
	CALL EXIT
C..
C..	ASK TYPE QUESTIONS
C..
1514	CONTINUE
C..CHECK IF START OF LINK
	LTYPE1=LTYPE1+1
	IF(LTYPE1.EQ.1.OR.LTYPE.EQ.KBTYPE(1,ITYPE)) GO TO 1504
C..SEE IF OK TO LINK
	IF(KNTRX.EQ.0) INPUT(1)=LTYPE
	IF(KNTRX.NE.0) INPUT(1)=LTYPEO
	GO TO 1505
1504	CONTINUE
	KTYPEC=KTYPES(2,ITYPE)
	KTYPEX=KTYPEC
	IRTN=1
	IF(KFORM.EQ.1)MXFORM=INFORM+1
	IF(KFORM.EQ.1)INFORM=1
1515	CONTINUE
	ID=MTY(KTYPEC)
	IF(ID.EQ.0) GO TO 302
C**	TYPE 515,INARR(1,ID),IRTN,KTYPEC,ITYPE,ID
CCC	FORMAT(' INARR=',I7,' IR=',I7,'   KT=',I7,'  IT=',I7,'  ID=',I7)
	CALL OUTCR(INARR(1,ID),IRTN,KPNUM)
C..	CHECK FOR END
	IF(IEOF.GT.O) GO TO 31
C..	INCREASE COUNT (IRTN=0=TAB, +1=CR, =-1=ESC)
	KTYPEC=KTYPEC+IRTN
	IF(KFORM.EQ.1) INFORM=INFORM+IRTN
	IF(IRTN.EQ.0) KTYPEC=KTYPEC+1
	IF(KFORM.EQ.1.AND.IRTN.EQ.0) INFORM=INFORM+1
	IF(INARR(1,ID).LT.0.AND.KNTRX.EQ.0) KNTR=KNTR+1
	IF(KTYPEC.GE.KTYPEX) GO TO 1515
	KTYPEC=KTYPEX
	IRTN=1
	IF(KFORM.EQ.1) INFORM=1
	GO TO 1515
C..
C..	ASK RANDOM QUESTIONS
C..
1511	CONTINUE
	IRTN=1
	CALL CRTWRT(3,0,'FIELD --- ?')
	CALL CRTPOS(3,6)
	CALL CRTRED(INPUT,3,IACT,ISPEC)
	IF(ISPEC.LT.0) IACT=1
	IF(ISPEC.LT.0) INPUT(1)='@'
	IF(IACT.EQ.0) GO TO 1511
	IF(INPUT(1).EQ.'@'.AND.IRAND.LT.0) GO TO 30
	IF(INPUT(1).EQ.'@') IEOF=IEOF+1
	IF(INPUT(1).EQ.'@') GO TO 31
	IEOF=0
	LASTID=ID
	DECODE(IACT,154,INPUT,ERR=155)ID
154	FORMAT(I3)
1544	IF(ID.LE.0.OR.ID.GT.MAXIDX) GO TO 155
C***	TYPE 515,INARR(1,ID),IRTN,KTYPEC,ITYPE,ID
	CALL OUTCR(INARR(1,ID),IRTN,KPNUM)
	IF(IRTN.EQ.0) IRTN=1
	IF(IEOF.GT.0) GO TO 31
	IF(INARR(1,ID).LT.0.AND.KNTRX.EQ.0) KNTR=KNTR+1
	IF(IRTN.NE.-1) GO TO 1511
	ID=LASTID
	GO TO 1544
155	CALL CRTERR(INPUT,3,'INVALID FIELD NUMBER ENTERED..')
	GO TO 1511
C..
C..	READ IN HEADER STUFF IF EXISTS
C..
150	IEOF=0
	IF(IHEAD.LE.0) GO TO 20
	I=0
1111	IRTN=1
11	I=I+IRTN
111	IF(I.LT.1) GO TO 1111
	CALL OUTCR(INARR(1,I),IRTN,KPNUM)
	IF(IEOF.GT.0) GO TO 40
	IF(INARR(1,I).LT.0.AND.KNTRX.EQ.0) KNTR=KNTR+1
C..	IRTN=0=TAB, +1=CR, -1=ESC
	IF(IRTN.EQ.0) I=I+1
	IF(I+IRTN.LE.IHEAD) GO TO 11
C..
C..	DATA SECTION
C..
20	I=IDATA-1
	IRTN=1
42	I=I+IRTN
	IF(I.LT.IDATA) IRTN=1
	IF(I.NE.0.AND.I.LE.IHEAD) GO TO 111
	IF(I.LT.IDATA) GO TO 42
	CALL OUTCR(INARR(1,I),IRTN,KPNUM)
	IF(IEOF.GT.0) GO TO 30
	IF(INARR(1,I).LT.0.AND.KNTRX.EQ.0) KNTR=KNTR+1
	IF(IRTN.EQ.0) I=I+1
	IF(I+IRTN.LE.MAXID) GO TO 42
	I=MAXID+1
C..
C..	CHECK IF DATA ENTERED OK
C..
302	CONTINUE
C.. SET FLAG TO COUNT FIELDS
	KNTRX=0
	IF(KQEOF.EQ.0) GO TO 30
	IF(INFORM.EQ.0)
     1 CALL CRTYN(3,1,'*** ARE ALL FIELDS OK (D: Y) ?',IQ)
	IF(INFORM.GT.0)
     1 CALL CRTYN(INFORM,1,'*** ARE ALL FIELDS OK (D: Y) ?',IQ)
	IF(IQ.GE.1) GO TO 30
	IF(IQ.LT.0) IEOF=1
C.. SET FLAG TO NOT COUNT FIELDS
	KNTRX=1
	GO TO 34
C..
C..	OUTPUT RECORDS SECTION
C..
30	CONTINUE
	IF(INFORM.GT.0) CALL CRTCLR(MXFORM-1)
	IF(IRAND.LT.1.OR.INFORM.EQ.0) CALL CRTCLR(5)
	IRECO=0
C..CHECK FOR TYPE STUFF
	IF(NTYPE.GT.0) GO TO 31
C..
C..	SEE IF NO DATA AFTER EOF
C..
	IF(I.EQ.IDATA) GO TO 34
31	CONTINUE
	IF(IEOF.GT.1) GO TO 40
	IWRITE=0
	MAXWRT=0
  	CALL DOBYTE(INPUT,INPUT(MAXCOL),IBLANK)
	DO 32 I=1,NKOUT
C.. ID
	K1=KOUT(1,I)
C.. CHECK FOR END OF RECORD
	IF(K1.EQ.0) GO TO 33
C..  SEE IF DATA WRITTEN ON ID
	IF(INARR(1,K1).LT.0.AND.K1.GT.IHEAD) IWRITE=1
C.. OUTPUT COLUMN
	K2=KOUT(2,I)
C.. SIZE
	K3=INARR(2,K1)
	IF(K3.LT.0) K3=-K3
C..	LOCATION IN MARRAY
	K4=INARR(4,K1)
C..
C..	TRANSFER DATA OVER TO OUTPUT ARRAY
C..
	IF(MAXWRT.LT.K2+K3-1) MAXWRT=K2+K3-1
	CALL BYTEDO(INPUT(K2),INPUT(K2+K3-1),MARRAY(K4))
	GO TO 32
C..
C..	WRITE OUT DATA
C..
33	CONTINUE
	IF(IWRITE.LE.0) GO TO 330
C..	CHECK FOR SQUEEZE OPTION
	IF(ISQUZE.NE.1) GO TO 333
	CALL RIDBLK(INPUT,MAXWRT)
	CALL RIDCHA(INPUT,MAXWRT,'$','$')
332	IF(INPUT(MAXWRT).NE.' ') GO TO 333
	MAXWRT=MAXWRT-1
	IF(MAXWRT.GT.1) GO TO 332
333	CONTINUE
	WRITE(IXFILE,100)(INPUT(J),J=1,MAXWRT)
100	FORMAT(4(132A1))
	IRECO=IRECO+1
	KNTW=KNTW+1
	WRITE(IPR,101)KNTW,(INPUT(J),J=1,MAXWRT)
101	FORMAT(' RECORD',I5,':',7(80A1))
330	MAXWRT=0
	IWRITE=0
	CALL DOBYTE(INPUT,INPUT(MAXCOL),' ')
32	CONTINUE
C..
C..	FIX UP ID FOR NO WRITE
C..
	DO 331 I=1,MAXID
	IF(INARR(1,I).LT.0) INARR(1,I)=-INARR(1,I)
331	CONTINUE
C..
C..	CHECK FOR END OF DATA FOR NEW HEADER
C..
34	CONTINUE
	IF(IEOF.EQ.1.AND.NTYPE.GT.0) GO TO 1512
	IF(IEOF.EQ.1.AND.IHEAD.GT.0.AND.KCHEAD.EQ.1) GO TO 15
	IF(IEOF.EQ.1.AND.IRAND.GT.0) GO TO 15
	IF(IEOF.EQ.0.AND.NTYPE.GT.0) GO TO 1514
	IF(IEOF.EQ.0) GO TO 20
C..
C..	END OF INFO
C..
40	CLOSE (UNIT=IXFILE)
	CALL CRTCLR(0)
	WRITE(IPR,35)KNTR,KNTW
35	FORMAT('0* END OF DATA ENTRY *'//' * INPUT FIELDS =',I5
     1 //' * OUTPUT RECORDS=',I5)
	CALL EXIT
	END