Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/ecapla.f4
There are no other files named ecapla.f4 in the archive.
C	THIS PROGRAM WAS OBTAINED FROM DECUS (N0. 10-34) AND 
C	SUBSTANTIALLY MODIFIED AT WESTERN MICHIGAN UNIVERSITY.
C	ELECTRONIC CIRCUIT ANALYSIS PROGRAM
C
C
C		MODIFIED FOR PDP-10 BY SAM ANEMA
C		26 MAR 72 (VERSION 1A)
C
C		TRANSCIENT ANALYSIS ADDED BY RUSS BARR
C		9 DEC 72 (VERSION 1B)
C
C		MINOR REVISION 27 DEC 72
C
C		MODIFIED TO RUN  WITHOUT CHAINING BY DAVE SCHULZ
C		26 JUN 74 (VERSION 1C)
C
C		MODIFIED TO BE MORE COMPATABLE WITH A
C		TIME SHARING SYSTEM BY DAVE SCHULZ
C		3 MAR 75 (VERSION 2A)
C
C		HELP AND IONCE MODS - RUSS BARR.
C		15 JUL 75 (VERSION 3)
C
C			LOAD PROCEDURE:
C				COM/F10 ECAPLA,ECAPDC,ECAPAC,ECAPTR
C				R LINK
C				@ECAP
C
C			EXTERNAL ROUTINES:
C
C				USAGE
C				IOB
C
C	 IMAGE LOADER (ECA)
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
C	FOLLOWING ARE COMMON TO LANG. INTERP. ONLY
C
	COMMON /LANG/MODEL(0/15,125),IPLACE(6),ISTORE(6),ERRCHK,NEXT
     1,ITAB(20),ITRACK(20),NEXADS
	DIMENSION ICTL(0/20),IHELP(11)
C
	DATA (ICTL(I),I=0,20)/15,'B','L','H','E','C','D','A','M','N','S
     1','T',' ','	','*','R','X','X','X','X','X'/
C
	DATA IPLACE/0,10,70,75,95,105/
C
C
C
C
	IDLG=-1
	IRSP=-4
	NDEVO=6
C
	IONCE=0
C
C

	WRITE(IDLG,101)
C	CALL USAGE('ECAP')
10	NDEVI=4
	NEXT=10
C	ZERO ALL BUT MODEL
	CALL ECA08
C	ZERO MODEL
	CALL ECA08A
	CALL IOB(0)
	IF(IDVI.NE.'TTY') GOTO 99
	IF(IONCE.NE.0)GO TO 100
	WRITE(IDLG,131)
	IONCE=1
	GO TO 132
100	WRITE(IDLG,102)
132	NDEVI=IRSP
C	READ IN LINE OF TEXT
99	READ(NDEVI,103,END=100) (NWORDS(J),J=1,72)
	ICOL=0
97	ICOL=ICOL+1
	DO 1 I=1,ICTL(0)
C	B=BRANCH=2
C	L=LIST=3
C	H=HELP=4
C	E=EXIT=5
C	C=COMMENT=6
C	D=DC=7
C	A=AC=8
C	M=MUTUAL INDUCTANCE=9
C	N=NEW MODEL=10
C	S=SAVE MODEL OR SWITCH=11
C	T=TR OR TRANSCONDUCTANCE=12
C	'SPACE' POSSIBLE LINE CONTINUED=66
C	'^I'   "             "     " =13
C	'*' MEANS SYSTEM CONTROL=14
C	'R' MEANS REMOVE SOL. CTL. LINE=40
C
	IF(NWORDS(ICOL).EQ.ICTL(I)) GOTO(2,3,4,5,6,7,8,9,10,11,12,66,
     113,14,40),I
1	CONTINUE
CODING FOR STORING SOL. CTL.
	CALL STORE1(6)
	IF(ERRCHK) 30,99,31
C	CODING TO DECODE BRANCH
C
2	CALL STORE1(2)
	IF(ERRCHK) 30,99,31
C
C	CODING FOR LISTING MODEL
3	L=0
	DO 32 I=1,5
	IF(ISTORE(I).EQ.0) GOTO 32
	L=1
	DO 33 J=IPLACE(I)+1,ISTORE(I)+IPLACE(I)
33	WRITE(IDLG,117) (MODEL(K,J),K=1,MODEL(0,J))
32	CONTINUE
	IF(ISTORE(6).EQ.0) GOTO 49
	L=1
	DO 50 J=1,ISTORE(6)
50	WRITE(IDLG,117) (MODEL(K,IPLACE(6)+ITAB(J)),K=
     11,MODEL(0,IPLACE(6)+ITAB(J)))
49	IF(L.EQ.0) WRITE(IDLG,104)
	GOTO 100
C
C	CODING FOR HELP
4	WRITE(IDLG,119)
	GOTO 100
	DO 15 I=1,11
15	IHELP(I)=0
	WRITE(IDLG,105)
	READ(IRSP,106) (IHELP(J),J=1,10)
	DO 16 I=1,11
	IF(IHELP(I).NE.0) GOTO(17,18,19,20,21,22,23,24,25,26),IHELP(I)
	GOTO 100
17	WRITE(IDLG,107)
	GOTO 16
18	WRITE(IDLG,108)
	GOTO 16
19	WRITE(IDLG,109)
	GOTO 16
20	WRITE(IDLG,110)
	GOTO 16
21	WRITE(IDLG,111)
	GOTO 16
22	WRITE(IDLG,112)
	GOTO 16
23	WRITE(IDLG,113)
	GOTO 16
24	WRITE(IDLG,114)
	GOTO 16
25	WRITE(IDLG,115)
	GOTO 16
26	WRITE(IDLG,116)
16	CONTINUE
	CALL EXIT
C
C	CODING FOR EXIT
5	CALL RELEAS(NDEVO)
	IF(IDVO.EQ.'LPT') CALL PRINTS(NAMO,2,1,NCOPYS)
	CALL EXIT
C
C	CODING FOR STORING COMMENTS
6	CALL STORE1(1)
	IF(ERRCHK) 30,99,31
C
C	CODING FOR DC ANALYSIS
7	NTR1=1
	KTYPE(1)=1
C	ZERO ALL BUT MODEL
COMMON TO DC, AC, AND TR
98	CALL ECA08
	MAC=1
	NMAX=0
	NNODE=0
	HNODE=0
	KTO=0
	NTR=NTR1
	NSTORE=0
	L=0
	DO 38 I=2,5
	IF(ISTORE(I).EQ.0) GOTO 38
	L=1
	DO 39 J=IPLACE(I)+1,ISTORE(I)+IPLACE(I)
	DECODE(75,118,MODEL(1,J)) NWORDS
	CALL ECA00(1)
39	CONTINUE
38	CONTINUE
	IF(NOEXEC) 67,67,61
67	IF(ISTORE(6).EQ.0) GOTO 43
C
CODING TO DEFINE OUTPUT DEVICE
C
60	CALL IOB(1)
C
CODING TO OUTPUT COMMENTS
C
	IF(ISTORE(1).EQ.0) GOTO 46
	DO 47 I=1,ISTORE(1)
47	WRITE(NDEVO,117) (MODEL(J,I),J=1,MODEL(0,I))
C
COMPILE SOL. CTL.
C
46	L=1
	NQUIT=0
	DO 51 J=1,ISTORE(6)
	DECODE(75,118,MODEL(1,IPLACE(6)+ITAB(J))) NWORDS
	DO 52 K=1,5
	IF(NWORDS(K).EQ.'B') GOTO 73
	IF((NWORDS(K).GT.'/').AND.(NWORDS(K).LT.':')) NWORDS
     1(K)=' '
52	CONTINUE
73	DO 68 L1=1,75
	IF(NWORDS(L1).EQ.' ') GOTO 68
	IF(NWORDS(L1).EQ.'	') GOTO 68
	GOTO 69
68	CONTINUE
	PAUSE 'SYSTEM ERROR'
69	IF((NWORDS(L1).EQ.'B').OR.(NWORDS(L1).EQ.'N')) GOTO 70
	GOTO 71
70	DO 72 L2=1,75-L1
72	NWORDS(L2)=NWORDS(L2+L1-1)
71	CALL ECA00(1)
	IF(NQUIT) 51,51,61
51	CONTINUE
43	IF(L.NE.0) GOTO 44
	WRITE(IDLG,104)
	GOTO 100
44	IF(KTO.GT.1) GOTO 65
	ITRANS=3
45	CALL ECA00(0)
	IF(NQUIT)65,65,61
65	WRITE(NDEVO,121)
	GOTO 100
C
C	CODING FOR AC ANALYSIS
8	NTR1=2
	KTYPE(1)=2
	GOTO 98
C
C	CODING TO DECODE MUTUAL INDUCTANCE
9	CALL STORE1(3)
	IF(ERRCHK) 30,99,31
C
C	CODING TO DETERMINE SAVE OR SWITCH
11	IF(NWORDS(ICOL+1).EQ.'A')GOTO 28
C
C	CODING TO DECODE SWITCH
	CALL STORE1(4)
	IF(ERRCHK) 30,99,31
C
C	CODING FOR SAVING MODEL
28	CALL IOB(1)
	L=0
	DO 34 I=1,5
	IF(ISTORE(I).EQ.0) GOTO 34
	L=1
	DO 35 J=IPLACE(I)+1,ISTORE(I)+IPLACE(I)
35	WRITE(NDEVO,123) (MODEL(K,J),K=1,MODEL(0,J))
34	CONTINUE
	IF(ISTORE(6).EQ.0) GOTO 54
	L=1
	DO 55 J=1,ISTORE(6)
55	WRITE(NDEVO,123) (MODEL(K,IPLACE(6)+ITAB(J)),K=1
     1,MODEL(0,IPLACE(6)+ITAB(J)))
54	IF(L.EQ.0) WRITE(IDLG,104)
	IF(IDVO.NE.'LPT')GO TO 100
	CALL RELEAS(NDEVO)
	CALL PRINTS(NAMO,2,0,NCOPYS)
	IDVO=0
	GOTO 100
C	CODING TO DETERMINE TR OR TRANS.
12	IF(NWORDS(ICOL+1).EQ.'R')GOTO 29
C
C	CODING TO DECODE TRANSCONDUCTANCE
	CALL STORE1(5)
	IF(ERRCHK) 30,99,31
C
C	CODING FOR TRANSIENT ANALYSIS
29	NTR1=3
	START=0.
	FINISH=0.
	OPEN=1E7
	SHORT=.01
	KTYPE(1)=3
	GOTO 98
C
CODING FOR SPACE AND TAB
C
66	IF(ICOL.LT.6) GOTO 97
13	DO 57 I=1,72
	IF((NWORDS(I).GT.' ').OR.(NWORDS(I).LT.'	')) GOTO 63
57	CONTINUE
	GOTO 56
63	IF(I.GE.7) GOTO 58
	DO 59 J=75,I,-1
59	NWORDS(J)=NWORDS(J-(7-I))
	DO 64 J=1,6
64	NWORDS(J)=' '
C
CODING FOR GIVING LINE NUMBERS IF NONE
C
58	ENCODE(5,120,K)NEXT
	DECODE(5,122,K)(NWORDS(I),I=1,5)
	CALL STORE1(6)
	IF(ERRCHK) 30,99,31
56	M3=40
	IF(NWORDS(6).EQ.'*') M3=41
	GOTO 48
14	ITRANS=7
	NQUIT=0
	CALL ECA07
	GOTO 100
30	M3=42
	GOTO 48
31	M3=43
	GOTO 48
C
CODING TO CALL ERROR SUBROUTINE
C
48	ITRANS=6
62	KCOL=50
	CALL ECA07
	NQUIT=0
	IF(M3.EQ.43) NOEXEC=NOEXEC-1
	GOTO 100
61	ITRANS=8
	GOTO 62
C
CODING TO REMOVE SOLUTION CTL. LINE
C
40	CALL STORE1(7)
	IF(ERRCHK)48,100,31
101	FORMAT(/,' WMU ELECTRONIC CIRCUIT ANALYSIS PROGRAM
     . (VERSION 3) '////)
102	FORMAT(' READY')
103	FORMAT(72A1)
104	FORMAT(' *** MODEL DOES NOT EXIST ***'/)
105	FORMAT(1X,'HELP IS AVALIABLE IN THE FOLLOWING AREAS'/,
     1'  SYSTEM CONTROL		1'/,'  SOLUTION CONTROL	2'/,'  MODEL
     2 MODIFICATION     3'/,'  INPUT AND OUTPUT	4
     3'/,'  DC ANALYSIS		5'/,'  AC ANALYSIS
     3		6'/,'  TRANSIENT ANALYSIS	7'//,'  ENTER AS M
     4ANY NUMBERS AS YOU LIKE SEPERATED BY COMMAS'/,' 0 FOR RETURN'/)
106	FORMAT(10I)
107	FORMAT('HELP1')
108	FORMAT('HELP2')
109	FORMAT('HELP3')
110	FORMAT('HELP4')
111	FORMAT('HELP5')
112	FORMAT('HELP6')
113	FORMAT('HELP7')
114	FORMAT('HELP8')
115	FORMAT('HELP9')
116	FORMAT('HELP10')
117	FORMAT(1X,15A5)
118	FORMAT(75A1)
119	FORMAT(' WHEN PROMPTED BY A "READY", YOU HAVE THE ',
     1'FOLLOWING CHOICE',/,' OF COMMANDS:',//,
     1' DC		START DC ANALYSIS',/,
     1' AC		START AC ANALYSIS',/,
     1' TR		START TRANSIENT ANALYSIS',/,
     1' LIST		LIST CURRENT MODEL ON TERMINAL',/,
     1' REMOVE NN	REMOVE SOLUTION CONTROL LINE "NN"',/,
     1' SAVE		STORE CURENT MODEL',/,
     1' NEW		INPUT A NEW MODEL',/,
     1' EXIT		CLOSE OUTPUT FILES AND EXIT FROM ECAP',/,
     1' HELP		TYPE THIS TEXT',/,
     1/,' IN ADDITION, YOU MAY ALSO ENTER A NEW LINE OR RETYPE A',
     1' LINE PREVIOUSLY',/,' ENTERED.',/,' THIS VERSION DIFFERS ',
     1'FROM THE IBM VERSIONS MAINLY IN THAT THE TYPE',/,' OF ANAL',
     1'YSIS(DC,AC,OR TR) IS A "COMMAND" GIVEN AFTER INPUTING',
     1' THE MODEL,',/,' INSTEAD OF BEING PART OF THE MODEL.',/)
120	FORMAT(I5)
121	FORMAT('1')
122	FORMAT(5A1)
123	FORMAT(15A5)
131	FORMAT(' READY(TYPE HELP IF NEEDED)')
	END
		SUBROUTINE STORE1(IWHAT)
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(188)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C	FOLLOWING ARE COMMON TO LANG. INTERP. ONLY
C
	COMMON /LANG/MODEL(0/15,125),IPLACE(6),ISTORE(6),ERRCHK,NEXT
     1,ITAB(20),ITRACK(20),NEXADS
C
	DIMENSION ISYCHK(6),ITEMP(20)
	EQUIVALENCE (ITEMP(1),XXX(1))
	DATA ISYCHK/10,60,5,20,10,20/
	ERRCHK=0
	IF(IWHAT-7) 21,22,21
CODING TO REMOVE TRAILING SPACES
C
21	DO 1 I=72,1,-1
	IF(NWORDS(I).NE.' ') GOTO 2
1	CONTINUE
	PAUSE 1
2	LEN=I/5+1
	ICOL=ICOL+1
	KCOL=5
	IF(IWHAT.EQ.6)GOTO 8
	CALL ECA09
	IF(NQUIT) 5,5,4
5	NUM=TNUM
	IF(NUM.EQ.0)NUM=1
	IF(NUM.GT.ISYCHK(IWHAT)) GOTO 6
	MODEL(0,NUM+IPLACE(IWHAT))=LEN
	ENCODE(75,101,MODEL(1,NUM+IPLACE(IWHAT))) NWORDS
	IF(ISTORE(IWHAT).LT.NUM) ISTORE(IWHAT)=NUM
	RETURN
8	DO 19 ICOL=1,5
	IF(NWORDS(ICOL).NE.' ') GOTO 20
19	CONTINUE
20	CALL ECA09
	IF(NQUIT) 14,14,4
C
CODING TO CHECK IF ALREADY ON LIST
C
14	NUM=TNUM
	DO 15 I=1,ISTORE(6)
	IF(ITRACK(ITAB(I)).EQ.NUM) GOTO 16
15	CONTINUE
	ISTORE(6)=ISTORE(6)+1
	IF(ISTORE(6).GT.ISYCHK(6)) GOTO 6
	MODEL(0,IPLACE(6)+NEXADS)=LEN
	ENCODE(75,101,MODEL(1,IPLACE(6)+NEXADS))NWORDS
	ITRACK(NEXADS)=NUM
	ITAB(ISTORE(6))=NEXADS
C
CODING TO SORT LIST
C
18	IF(ISTORE(6).LT.2) GOTO 31
	DO 11 I=1,ISTORE(6)
	DO 12 J=1,ISTORE(6)-1
	K=J+1
	IF(ITRACK(ITAB(J)).LT.ITRACK(ITAB(K)))GOTO 12
	ITEMP2=ITAB(J)
	ITAB(J)=ITAB(K)
	ITAB(K)=ITEMP2
12	CONTINUE
11	CONTINUE
31	NEXT=10+ITRACK(ITAB(ISTORE(6)))
	DO 13 I=1,20
	DO 29 J=1,ISTORE(6)
	IF(I.EQ.ITAB(J)) GOTO 13
29	CONTINUE
	GOTO 30
13	CONTINUE
	PAUSE 'LISFUL'
30	NEXADS=I
	RETURN
C
C	ALREADY ON LIST
C
16	ENCODE(75,101,MODEL(1,IPLACE(6)+ITAB(I))) NWORDS
	MODEL(0,IPLACE(6)+ITAB(I))=LEN
	GOTO 18
C
CODING TO REMOVE SOL. CTL. FROM MODEL
C
22	DO 23 ICOL=1,72
	IF(NWORDS(ICOL).EQ.' ') GOTO 24
23	CONTINUE
	M3=45
	GOTO 6
24	ICOL=ICOL+1
	KCOL=72
	CALL ECA09
	IF(NQUIT)25,25,4
25	NUM=TNUM
	DO 26 I=1,ISTORE(6)
	IF(ITRACK(ITAB(I)).EQ.NUM) GOTO 27
26	CONTINUE
	TYPE 66,NUM,ISTORE(6),(ITRACK(I),I=1,5)
66	FORMAT(6I)
	M3=46
	GOTO 6
27	ISTORE(6)=ISTORE(6)-1
	DO 28 J=I,ISTORE(6)+1-I
28	ITAB(J)=ITAB(J+1)
	GOTO 18
4	ERRCHK=1
	RETURN
6	ERRCHK=-1
	RETURN
101	FORMAT(75A1)
	END
	SUBROUTINE ECA00(NCTL)
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
99999      IF ( NTRACE ) 3, 4, 3
 2    FORMAT(' LANG MAINLINE- ECA ENTERED. KTO = ',I3 )
 3    WRITE(NDEVO, 2) KTO
4	IF(NCTL) 12,8000,12
C	CODING TO INSERT PROPER # OF SPACES IN LIEU OF A TAB
  12  I1 = 1
   7  IF ( NWORDS( I1 ) .EQ. 4967112768 ) GO TO 6
      IF (  I1  -  72  )  10, 92, 92
   6  DO 9 I2 = ( 72 ), (I1 + 8), ( -1 )
      NWORDS( I2 ) = NWORDS ( I2 - 7 )
   9  CONTINUE
      DO 11 I2 = I1, ( I1 + 7 )
      NWORDS( I2 ) = ' '
  11  CONTINUE
  10  I1 = I1 + 1
      GO TO 7
92	CONTINUE
      KCARD = KCARD + 1
      IF ( NWORDS( 1 ).EQ.NMCD(2, 1))GO TO 100
 7777 KCOL = 6
      DO 1002 ICOL = 7, 72
      IF ( NWORDS( ICOL ).EQ.4967112768 )GO TO 1002
 70   IF ( NWORDS( ICOL ).EQ.NBLANK )GO TO 1002
 1001 KCOL = KCOL + 1
      NWORDS( KCOL ) = NWORDS( ICOL )
 1002 CONTINUE
  777 NQUIT = 0
      M1 = 1
      DO 24 ICOL = 1, 5
C
      IF ( NWORDS(ICOL).EQ.4967112768 )GO TO 24
C
 71   IF ( NWORDS(ICOL).EQ.NBLANK )GO TO 24
   21 DO 23 LTYPE = 1, 4
      IF ( NWORDS( ICOL ).EQ.KLABEL( LTYPE ))GO TO 17
   23 CONTINUE
      GO TO 104
   24 CONTINUE
      IF ( KCOL - 6 ) 500, 1126, 125
 1126 M3 = 4
      GO TO 805
  104 ITRANS = 1
      GO TO 126
  109 ITRANS = 2
  126 CALL ECA04
      GO TO ( 500, 500, 500, 100, 110, 110 ), ITRANS
  125 CALL ECA06
8000      GO TO ( 5, 500, 46, 100, 110, 110 ), ITRANS
   46 IF ( NOEXEC ) 500, 5004, 4667
 5004 IF ( IRTN - 1 ) 5006, 5006, 5005
 5005 GO TO ( 136, 137, 138 ), NTR
 5006 IF(IDATA) 778,778,779
C
CODING TO WRITE HEADING IN ECAP.DAT
C
779	CALL OFILE(20,'ECAP')
	ANS='DC'
	IF(NTR.EQ.2) ANS='AC'
	IF(NTR.LT.3) GOTO 776
	ANS='TR'
776	WRITE(20,119) ANS,NNODE,NMAX,(NPRINT(I),I=1,6)
119	FORMAT(A2,2I,6I1)
778	MAC = 0
   47 MAC=MAC+1
      MACFLO = KTYPE( MAC )
      GO TO ( 210, 210, 214, 216, 219, 220, 220, 238, 226, 228, 230 ),
     1 MACFLO
  210 NNODE = HNODE
      DO 3000 K=1,NNODE
      DO 2999 L = 1, NMAX
      IF ( NINIT( L ).EQ.K )GO TO 3000
 2998 IF ( NFIN( L ).EQ.K )GO TO 3000
 2999 CONTINUE
      NOEXEC=NOEXEC+1
      WRITE(IDLG, 3001 ) K
 3000 CONTINUE
      DO 3205 K = 1, NMAX
      IF ( MODE1 ( K )) 3205, 3202, 3205
 3202 WRITE(IDLG, 3003 ) K
      NOEXEC=NOEXEC+1
 3205 CONTINUE
      IRTN = 1
      IF( NOEXEC )500,5005,4667
C
C
C	EXECUTION IMPOSSIBLE
C
4667	NQUIT=1
	GOTO 100
 136	CONTINUE
	CALL ECA20
	KTO=2
	GOTO 101
  137 IF(OMEGA)1390,1390,1370
 1370 	CONTINUE
	CALL ECA40
	KTO=3
	GOTO 101

  138 IF(DELTA)1381,1381,1380
 1381 IF(NEQUIM)1390,1390,1382
 1382 DELTA = 1.E-6
 1380 	CONTINUE
	CALL ECA70
	KTO=4
101	ISEQ=0
	NTRACE=0
	NEQUIM=0
	CALL ECA01
	MAC=0
	MO=0
	NOEXEC=0
	NQUIT=0
	KCARD=0
	M1=-1
	GOTO 100
1390	M3=47
	ITRANS=6
	CALL ECA07
      GO TO 4667
  214 IF ( NEQUIM ) 500, 210, 218
  218 TRADE = SHORT
      SHORT = OPEN
      OPEN = TRADE
      GO TO 210
  216 GO TO ( 94, 95, 500 ), NTR
   94 IRTN=3
      GO TO 136
   95 IRTN = 3
      GO TO 137
  220 WRITE(IDLG, 231 )
  219 MAC=0
      MO = 0
      GO TO 100
  226 CONTINUE
C	CALL USER01
      GO TO 100
  228 CONTINUE
C	CALL USER02
      GO TO 100
  230 CONTINUE
C	CALL USER03
      GO TO 100
  238 CALL EXIT
C
C
C
C
  231 FORMAT (// 25H ILLEGAL INPUT STATEMENT.//)
 3001 FORMAT(//9H NODE NO.I4,13H  IS MISSING.//)
 3003 FORMAT(//11H BRANCH NO.I4,13H  IS MISSING.//)
  500 ITRANS = 5
      GO TO 110
  805 ITRANS = 6
      GO TO 110
 1000 ITRANS = 7
      NQUIT=0
  110 CALL ECA07
      GO TO 100
   17 ITRANS = 1
      GO TO 1713
   19 ITRANS = 2
 1713 CALL ECA02
      GO TO ( 500, 500, 1313, 100, 110, 110 ), ITRANS
 1313 GO TO ( 1314,1314,1315,1315,1315,1315,1315,1315,1314 ), INVAL
 1314 CALL ECA03
      GO TO 1316
 1315 CALL ECA05
 1316 GO TO ( 500, 1713, 1713, 100, 110, 110 ), ITRANS
    5 CONTINUE
100	RETURN
	END
C
	SUBROUTINE ECA01
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
      IF ( NTRACE ) 1, 1, 3
    2 FORMAT(' LANG SUBR-ECA01 ENTERED.')
 3    WRITE(NDEVO , 2)
C
1     NMCD ( 1, 1 ) =  'D'
      NMCD ( 2, 1 ) =  'C'
      NMCD ( 1, 2 ) =  'A'
      NMCD ( 2, 2 ) =  'C'
      NMCD ( 1, 3 ) =   'T'
      NMCD ( 2, 3 ) =   'R'
      NMCD ( 1, 4 ) =   'M'
      NMCD ( 2, 4 ) =   'O'
      NMCD ( 1, 5 ) =   'E'
      NMCD ( 2, 5 ) =   'X'
      NMCD ( 1, 6 ) =  'C'
      NMCD ( 2, 6 ) =   'O'
      NMCD ( 1, 7 ) =   'R'
      NMCD ( 2, 7 ) =   'E'
      NMCD ( 1, 8 ) =   'E'
      NMCD ( 2, 8 ) =   'N'
      NMCD ( 1, 9 ) =   'I'
      NMCD ( 2, 9 ) =   'U'
      NMCD ( 1, 10 ) =  '2'
      NMCD ( 2, 10 ) =  'U'
      NMCD ( 1, 11 ) =  '3'
      NMCD ( 2, 11 ) =  'U'
      KPUNC ( 1 ) =     '='
      KPUNC ( 2 ) =     '('
      KPUNC ( 3 ) =     ','
      KPUNC ( 4 ) =     ')'
      KPUNC ( 5 ) =     '/'
      KLABEL ( 1 ) =   'B'
      KLABEL ( 2 ) =    'T'
      KLABEL ( 3 ) =    'M'
      KLABEL ( 4 ) =    'S'
      INPUTB ( 1 ) =    'N'
      INPUTB ( 2 ) =   'B'
      INPUTB ( 3 ) =    'R'
      INPUTB ( 4 ) =    'G'
      INPUTB ( 5 ) =    'E'
      INPUTB ( 6 ) =    'I'
      INPUTB ( 7 ) =    'L'
      INPUTB ( 8 ) =   'C'
      INPUTB ( 9 ) =    'O'
      NBCD ( 1 ) =      '*'
      NBCD ( 2 ) =      '+'
      NBCD ( 3 ) = '-'
      NBCD ( 4 ) =      '0'
      NBCD ( 5 ) =      '1'
      NBCD ( 6 ) =      '2'
      NBCD ( 7 ) =      '3'
      NBCD ( 8 ) =      '4'
      NBCD ( 9 ) =      '5'
      NBCD ( 10 ) =     '6'
      NBCD ( 11 ) =     '7'
      NBCD ( 12 ) =     '8'
      NBCD ( 13 ) =     '9'
      NBCD ( 14 ) =     '.'
      NBCD ( 15 ) =     'E'
      NBCD ( 16 ) =     ' '
      NBCD ( 17 ) =     ','
      NBCD ( 18 ) =     ')'
      NBCD ( 19 ) =     '('
      NBCD ( 20 ) =     '/'
      INDC ( 1, 1 ) =   'P'
      INDC ( 2, 1 ) =   'R'
      INDC ( 1, 2 ) =   'D'
      INDC ( 2, 2 ) =   'A'
      INDC ( 1, 3 ) =   'T'
      INDC ( 2, 3 ) =   'Y'
      INDC ( 1, 4 ) =   'P'
      INDC ( 2, 4 ) =   'L'
      INDC ( 1, 5 ) =   'L'
      INDC ( 2, 5 ) =   'O'
      INDC ( 1, 6 ) =   'S'
      INDC ( 2, 6 ) =   'E'
      INDC ( 1, 7 ) =   'W'
      INDC ( 2, 7 ) =   'O'
      INDC ( 1, 8 ) =   'S'
      INDC ( 2, 8 ) =   'T'
      INDC ( 1, 9 ) =  'C'
      INDC ( 2, 9 ) =   'H'
      INDC ( 1, 10 ) =  'F'
      INDC ( 2, 10 ) =  'R'                                                     0
      INDC ( 1, 11 ) =  'O'
      INDC ( 2, 11 ) =  'U'
      INDC ( 1, 12 ) =  '1'
      INDC ( 2, 12 ) =  'E'
      INDC ( 1, 13 ) =  '2'
      INDC ( 2, 13 ) =  'E'
      INDC ( 1, 14 ) =  '3'
      INDC ( 2, 14 ) =  'E'
      INDC ( 1, 15 ) =  'I'
      INDC ( 2, 15 ) =  'N'
      INDC ( 1, 16 ) =  'T'
      INDC ( 2, 16 ) =  'I'
      INDC ( 1, 17 ) =  'F'
      INDC ( 2, 17 ) =  'I'
      INDC ( 1, 18 ) =  'S'
      INDC ( 2, 18 ) =  'H'
      INDC ( 1, 19 ) =  'O'
      INDC ( 2, 19 ) =  'P'
      INDC ( 1, 20 ) =  'E'
      INDC ( 2, 20 ) =  'Q'
      KOUT ( 1, 1 ) =   'N'
      KOUT ( 2, 1 ) =   'V'
      KOUT ( 1, 2 ) =  'C'
      KOUT ( 2, 2 ) =  'A'
      KOUT ( 1, 3 ) =  'C'
      KOUT ( 2, 3 ) =   'V'
      KOUT ( 1, 4 ) =  'B'
      KOUT ( 2, 4 ) =  'A'
      KOUT ( 1, 5 ) =  'B'
      KOUT ( 2, 5 ) =   'V'
      KOUT ( 1, 6 ) =  'B'
      KOUT ( 2, 6 ) =   'P'
      KOUT ( 1, 7 ) =   'S'
      KOUT ( 2, 7 ) =   'E'
      KOUT ( 1, 8 ) =   'W'
      KOUT ( 2, 8 ) =   'O'
      KOUT ( 1, 9 ) =   'S'
      KOUT ( 2, 9 ) =   'T'
      KOUT ( 1, 10 ) =  'M'
      KOUT ( 2, 10 ) =  'I'
      EQUIVN ( 1 ) = 0.0
      EQUIVN ( 2 ) = 0.0
      EQUIVN ( 3 ) = 0.0
      EQUIVN ( 4 ) = 0.0
      EQUIVN ( 5 ) = 1.0
      EQUIVN ( 6 ) = 2.0
      EQUIVN ( 7 ) = 3.0
      EQUIVN ( 8 ) = 4.0
      EQUIVN ( 9 ) = 5.0
      EQUIVN ( 10 ) = 6.0
      EQUIVN ( 11 ) = 7.0
      EQUIVN ( 12 ) = 8.0
      EQUIVN ( 13 ) = 9.0
      EQUIVN ( 14 ) = 0.0
      EQUIVN ( 15 ) = 0.0
      EQUIVN ( 16 ) = 0.0
      EQUIVN ( 17 ) = 0.0
      EQUIVN ( 18 ) = 0.0
      EQUIVN ( 19 ) = 0.0
      EQUIVN ( 20 ) = 0.0
      NBLANK =          ' '
      RETURN
      END
	SUBROUTINE ECA02
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 34H LANG SUBR-ECA-02 ENTERED. ITRANS=I2 )
 3    WRITE(NDEVO , 2) ITRANS
    4 GO TO ( 17, 19, 2310 ), ITRANS
   17 ICOL=ICOL+1
      IF( ICOL - 5 ) 1717, 1717, 1808
C
 1717 IF ( NWORDS ( ICOL ).EQ.4967112768 )GO TO 17
C
   40 IF ( NWORDS( ICOL ).EQ.NBLANK )GO TO 17
      GO TO 1714
 1808 M3 = 14
      GO TO 805
 1714 CALL ECA09
      IF ( NQUIT ) 500, 1734, 805
 1734 IF ( ICOL - 6 ) 1723, 1809, 1809
 1809 M3 = 15
      GO TO 805
 1723 NUM = TNUM
      IF ( MO ) 500, 1720, 18
 1720 GO TO ( 1710, 1711, 1712, 1713 ), LTYPE
 1710 NMAX = MAX0(NMAX,NUM)
      IF (NMAX - 150) 18,18,2711
 2711 M3 = 16
      GO TO 805
 1711 NTERMS = NTERMS + 1
      IF ( NTERMS - 150 ) 401, 401, 2274
  401 IF ( NUM - 150 ) 18, 18, 2274
 2274 M3 = 17
      GO TO 805
 1712 NLTRMS = NLTRMS + 1
      IF ( NLTRMS - 25 ) 402, 402, 2273
  402 IF ( NUM - 25 ) 18, 18, 2273
 2273 M3 = 18
      GO TO 805
 1713 NOSW = NOSW + 1
      IF ( NTR - 2 ) 771, 771, 770
  771 M3 = 25
      GO TO 805
  770 IF ( NOSW - 150 ) 403, 403, 2277
  403 IF ( NUM - 150 ) 18, 18, 2277
 2277 M3 = 19
      GO TO 805
   18 NOEL = 0
      NOE = 0
      NOI = 0
      NOIC = 0
      ICOL = 6
 19   ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 2022, 2022, 100
 2022 IF (NWORDS(ICOL).EQ.KPUNC(3))GO TO 19
 2222 IF(NWORDS(ICOL).EQ.KPUNC(4))GO TO 19
 2223 IF(NWORDS(ICOL).EQ.NBCD(1))GO TO 100
   22 KO = 0
      DO 24 INVAL = 1, 8
      IF(NWORDS(ICOL).EQ.INPUTB(INVAL))GO TO 1721
 24   CONTINUE
      M3 = 20
      GO TO 805
  181 IF ( MO ) 500, 76, 183
  183 ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 184, 184, 100
  184 IF ( NWORDS( ICOL).EQ.KPUNC( 4 ))GO TO 19
      GO TO 183
 1721 IF(MO) 500, 23, 1722
 1722 IF(INVAL-2) 23, 23, 1724
 1724 NUMMO=NUMMO+1
      IF ( NUMMO - 50 )1725,1725,1726
 1726 M3=34
      GO TO 805
 1725 MOBRN(NUMMO)=NUM
      MOPARM(NUMMO)=INVAL-2
   23 GO TO( 181, 73, 61, 74, 71, 71, 90, 90 ), INVAL
   73 IF(NWORDS(ICOL+1).EQ.INPUTB(5))GO TO 75
      GO TO 181
   74 IF ( NWORDS( ICOL+1 ).NE.KLABEL( 3 ))GO TO 56
   78 INVAL=9
      ICOL = ICOL + 1
      KG=1
      IF ( MO ) 500, 61, 67
   67 MOPARM( NUMMO ) = - 2
      GO TO 61
   75 INVAL = 9
      KG = 0
      ICOL = ICOL + 3
      IF ( MO ) 500, 61, 60
   60 NUMMO=NUMMO+1
      IF(NUMMO-50)1728,1728,1727
 1727 M3=34
      GO TO 805
 1728 MOBRN(NUMMO)=NUM
      MOPARM(NUMMO)=2
   61 NOEL = NOEL + 1
      IF ( NOEL - 1 ) 500, 76, 809
  809 M3 = 22
      GO TO 805
   71 IF(NWORDS(ICOL+1).EQ.INPUTB(9))GO TO 72
  650 IF(NWORDS(ICOL+1).EQ.NBCD(4))GO TO 72
   65 IF ( INVAL - 6 ) 62, 63, 500
   62 NOE = NOE + 1
      IF ( NOE - 1 ) 500, 76, 816
  816 M3 = 23
      GO TO 805
   63 NOI = NOI + 1
      IF ( NOI - 1 ) 500, 76, 811
  811 M3 = 24
      GO TO 805
   72 KO=1
      ICOL = ICOL + 1
      IF ( NTR - 3 ) 813, 66, 500
  813 M3 = 27
      GO TO 805
   66 NOIC = NOIC + 1
      IF ( NOIC - 1 ) 500, 76, 815
  815 M3 = 26
      GO TO 805
   90 IF( NTR - 2 ) 990, 91, 91
  990 M3 = 33
      GO TO 805
   91 IF( INVAL - 7 ) 500, 80, 61
   80 IF ( MO ) 500, 61, 58
   58 IF ( LTYPE - 3 ) 61, 59, 61
   59 MOPARM(NUMMO)=7
      GO TO 61
   56 IF ( MO ) 500, 61, 57
   57 MOPARM(NUMMO)=-1
      GO TO 61
   76 ICOL = ICOL + 1
      IF(ICOL-KCOL)52,1185,1185
   52 IF ( INVAL - 2 ) 53, 53, 54
   53 IF ( NWORDS( ICOL ).EQ.KPUNC( 2 ))GO TO 70
   54 IF ( NWORDS( ICOL ).EQ.KPUNC(1))GO TO 70
      GO TO 804
 1185 M3 = 21
      GO TO 805
   70 ITOL=0
      NP=0
      IPC=0
 25   LL = 1
 2310 ICOL=ICOL+1
      IF ( ICOL - KCOL ) 26, 26, 100
   26 IF(INVAL-2) 2667,2667,2666
 2666 IF(ITOL-1)  110,111,111
 2667 IF(NWORDS(ICOL).EQ.KPUNC(1))GO TO 2310
 2668 IF(NWORDS(ICOL).EQ.KPUNC(2))GO TO 2310
      GO TO 29
 110  IF (NWORDS(ICOL).EQ.KPUNC(1))GO TO 2310
   27 ITOL=1
      IF(NWORDS(ICOL).EQ.KPUNC(2))GO TO 2502
 2586 IF(NTR-3) 29, 2587, 500
 2587 IF(KO)500,2505,29
 111  IF (NWORDS(ICOL).EQ.KPUNC(2))GO TO 2502
 2023 IF (NWORDS(ICOL).EQ.KPUNC(4))GO TO 2501
 2024 IF(NWORDS(ICOL).EQ.KPUNC(3))GO TO 2500
 2026 IF(MO) 500, 2025, 2224
 2224 IF(IPC-1) 2025, 2505, 2025
 2025 IF (NWORDS(ICOL).EQ.KPUNC(5))GO TO 2503
      GO TO 29
 2500 IF ( NP ) 804, 2027, 2505
 2027 IF(MO) 500, 19, 2225
 2225 IF(IPC-1) 19, 182, 19
 2501 NP=NP-1
      IF (ITOL-3)  2506,2310,2506
 2506 IPC=1
      IF ( MO ) 500, 1313, 2504
 2504 ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 111, 111, 3915
 2502 NP=1
 2505 ITOL=ITOL+1
      IF ( NP ) 804, 29, 2310
 2503 ITOL=4
      GO TO 2310
   29 CALL ECA09
      IF ( NQUIT ) 500, 2377, 805
 2377 IF(MO) 500, 1313, 182
  182 GO TO(3911,3912,3913,3916,3914,3918),ITOL
 3916 NUMMO=NUMMO+1
      IF(NUMMO-50)3911,3911,3925
 3925 M3=34
      GO TO 805
 3911 VFIRST(NUMMO)=TNUM
      GO TO 3914
 3912 IF(IPC) 500, 3914, 3915
 3914 VSECND(NUMMO)=TNUM
      VLAST( NUMMO ) = TNUM
      GO TO 2310
 3915 VSECND( NUMMO ) = VFIRST( NUMMO ) - TNUM * ABS ( VFIRST( NUMMO ))
      VLAST( NUMMO ) = VFIRST( NUMMO ) + TNUM * ABS ( VFIRST( NUMMO ))
      GO TO 19
 3913 IF(IPC) 500, 3917, 3918
 3918 MOSTEP( NUMMO ) = VSECND( NUMMO )
 3917 VLAST(NUMMO)=TNUM
      IF(NTR-2) 19, 3919, 19
 3919 IF ( ITOL - 5 ) 3921, 19, 19
 3921 IF ( INVAL - 5 ) 3920, 3922, 3920
 3920 IF ( INVAL - 6 ) 19, 3922, 19
 3922 IPC = 0
      GO TO 2310
 1313 ITRANS = 3
      GO TO 9996
  100 ITRANS = 4
      GO TO 9996
  500 ITRANS = 5
      GO TO 9996
 804  M3 = 35
	M3=20
  805 ITRANS = 6
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT (34H LANG SUBR-ECA-02 EXIT.    ITRANS=I4)
 9998 WRITE(NDEVO , 9997 )ITRANS
 9999 RETURN
      END
	SUBROUTINE ECA03
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 34H LANG SUBR-ECA-03 ENTERED. ITRANS=I2,8H  INVAL=I2 )
 3    WRITE(NDEVO , 2) ITRANS, INVAL
    4 GO TO ( 371, 372, 373, 373, 373, 373, 373, 373, 80 ), INVAL
 371  GO TO (195,196) , LL
  195 NINIT( NUM ) = TNUM
      IF ( TNUM - HNODE ) 207, 207, 206
  206 IF ( TNUM - 50.0 ) 2206, 2206, 2207
 2207 M3 = 32
      GO TO 805
 2206 HNODE = TNUM
 207  LL=2
 961  ICOL=ICOL+1
      IF ( ICOL - KCOL ) 962, 962, 100
  962 IF(NWORDS(ICOL).EQ.KPUNC(3))GO TO 961
  129 IF ( LTYPE - 4 ) 29, 780, 500
   29 CALL ECA09
      IF ( NQUIT ) 500, 4, 805
  780 IF ( NWORDS( ICOL ).EQ.KPUNC( 2 ))GO TO 961
   78 IF ( NWORDS( ICOL ).EQ.KPUNC( 4 ))GO TO 210
   79 IF ( KS -150  ) 29, 2007, 2007
 2007 M3 = 29
      GO TO 805
  210 ICOL=ICOL+1
      IF ( ICOL - KCOL ) 217, 214, 214
  217 IF(NWORDS(ICOL).NE.INPUTB(9))GO TO 210
  211 IF ( NWORDS( ICOL+1 ).EQ.INDC( 1,10 ))GO TO 213
  212 IF(NWORDS(ICOL+1).EQ.INPUTB(1))GO TO 215
      GO TO 214
  213 LABEL( NUM ) = 1
      GO TO 100
  215 LABEL( NUM ) = 2
      GO TO 100
  214 M3 = 31
      GO TO 805
  196 NFIN( NUM ) = TNUM
      IF ( TNUM - HNODE ) 19, 19, 197
  197 IF ( TNUM - 50.0 ) 2197, 2197, 2207
 2197 HNODE = TNUM
      GO TO 19
 372  GO TO (379,380),LL
 379  GO TO ( 804, 381, 382, 385 ), LTYPE
  381 ICOLT( NUM ) = TNUM
      GO TO 207
  382 ICOLM( NUM ) = TNUM
      GO TO 207
  385 LINK1D( NUM ) = TNUM
      LIST4( NUM ) = 0
      GO TO 207
 380  GO TO ( 804, 383, 384, 386 ), LTYPE
  383 IROWT( NUM ) = TNUM
      GO TO 19
  384 IROWM( NUM ) = TNUM
      GO TO 19
  386 LIST4( NUM ) = LIST4( NUM ) + 1
      KS = KS + 1
      LINK1E( KS ) = TNUM
      GO TO 961
  373 M3 = 1
      GO TO 805
   80 IF(KG) 500, 82, 81
   81 GO TO(3891,3892,3893),ITOL
 3891 YTERM( NUM ) = TNUM
      GO TO 3894
 3892 IF(IPC) 500,3894,3895
 3894 YTERML( NUM ) = TNUM
      YTERMH( NUM ) = TNUM
      GO TO 2310
 3895 YTERML( NUM ) = YTERM( NUM ) - TNUM * ABS ( YTERM( NUM ))
      YTERMH( NUM ) = YTERM( NUM ) + TNUM * ABS ( YTERM( NUM ))
      GO TO 19
 3893 YTERMH( NUM ) = TNUM
      GO TO 19
   82 NBRN = ICOLT( NUM )
      GO TO (83,84,420),ITOL
   83 YTERM( NUM ) = TNUM * Y( NBRN )
      GO TO 86
   84 IF(IPC)500,400,3895
  400 IF(NTR-3)86,410,500
  410 YTERML(NUM)=TNUM*YMIN(NBRN)
      YTERMH(NUM)=TNUM*YMAX(NBRN)
      GO TO 2310
  420 IF(NTR-3)85,430,500
  430 YTERMH(NUM)=TNUM*YMAX(NBRN)
      GO TO 19
   86 YTERML( NUM ) = TNUM * Y( NBRN )
      YTERMH( NUM ) = TNUM * Y( NBRN )
      GO TO 2310
   85 YTERMH( NUM ) = TNUM * Y( NBRN )
   19 ITRANS = 2
   39 IF( ICOL + 1 - KCOL ) 9996, 9996, 100
 2310 ITRANS = 3
      GO TO 39
  100 ITRANS = 4
      GO TO 9996
  500 ITRANS = 5
      GO TO 9996
 804  M3=36
  805 ITRANS = 6
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT (34H LANG SUBR-ECA-03 EXIT.    ITRANS=I4)
 9998 WRITE(NDEVO, 9997 ) ITRANS, INVAL
 9999 RETURN
      END
	SUBROUTINE ECA04
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 34H LANG SUBR-ECA-04 ENTERED. ITRANS=I2 )
 3    WRITE(NDEVO, 2) ITRANS
    4 GO TO ( 104, 109 ), ITRANS
  104 IF( NWORDS( ICOL ).NE.INPUTB( 5 ))GO TO 106
  105 KE=KE+1
      KELAST = 1
      ETIME(KE,2)= -1.0
      IF ( KE - 5 ) 15, 15, 1105
 1105 M3 = 2
      GO TO 805
  106 IF( NWORDS(ICOL).NE.INPUTB(6))GO TO 132
  107 KI=KI+1
      KELAST = -1
      ATIME(KI,2)=-1.0
      IF ( KI - 5 ) 15, 15, 1107
 1107 M3 = 3
      GO TO 805
  132 M3 = 5
      GO TO 805
 15   ICOL=ICOL+1
      IF ( ICOL - 6 ) 20, 806, 806
C
 20   IF ( NWORDS( ICOL ).EQ.4967112768 )GO TO 15
C
   40 IF ( NWORDS( ICOL ).EQ.NBLANK )GO TO 15
      GO TO 120
  806 M3 = 6
      GO TO 805
  120 CALL ECA09
      IF ( NQUIT ) 500, 134, 805
  134 IF ( ICOL - 6 ) 135, 807, 807
  807 M3 = 7
      GO TO 805
  135 M2 = 1
      M1 = 0
      ICOL = 6
      IF ( KELAST ) 28, 500, 30
   28 LISTI( KI ) = TNUM
      GO TO 108
   30 LISTE( KE ) = TNUM
  108 ITOL = -1
  109 ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 128, 128, 100
  128 IF ( NWORDS( ICOL ).EQ.KPUNC( 3 ))GO TO 109
   98 IF ( NWORDS( ICOL ).EQ.KPUNC( 2 ))GO TO 108
   99 IF ( NWORDS( ICOL ).EQ.KPUNC( 4 ))GO TO 109
  102 IF(NWORDS(ICOL).EQ.INDC(1,1))GO TO 202
  200 IF(NWORDS(ICOL).EQ.INDC(1,6))GO TO 203
      GO TO 201
  202 IF(KELAST)204,500,205
  204 ATIME(KI,2)=0.0
      GO TO 109
  205 ETIME(KE,2)=0.0
      GO TO 109
  203 IF(KELAST)206,500,207
  206 ATIME(KI,2)=1.0
      GO TO 208
  207 ETIME(KE,2)=1.0
  208 ICOL=ICOL+2
      GO TO 109
  201 CALL ECA09
      IF ( NQUIT ) 500, 127, 805
  127 IF ( M2 - 126 ) 400, 400, 4414
  400 IF ( KELAST ) 401, 500, 411
  401 IF ( ITOL ) 402, 500, 403
  402 ATIME( KI,M2 ) = TNUM
      GO TO 414
  403 AMPTR( KI,M2 ) = TNUM
      NUMI( KI ) = M2
      GO TO 415
  411 IF ( ITOL ) 412, 500, 413
  412 ETIME( KE,M2 ) = TNUM
      GO TO 414
  413 ETR( KE,M2 ) = TNUM
      NUME( KE ) = M2
  415 M2 = M2 + 1
  414 ITOL = 1
      GO TO 109
 4414 M3 = 8
      GO TO 805
  100 ITRANS = 4
      GO TO 9996
  500 ITRANS = 5
      GO TO 9996
  805 ITRANS = 6
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT (34H LANG SUBR-ECA-04 EXIT.    ITRANS=I4)
 9998 WRITE(NDEVO, 9997) ITRANS
 9999 RETURN
      END
	SUBROUTINE ECA05
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 34H LANG SUBR-ECA-05 ENTERED. ITRANS=I2,8H  INVAL=I2 )
 3    WRITE(NDEVO, 2) ITRANS, INVAL
    4 GO TO ( 371, 371, 373, 374, 375, 376, 377, 378, 371 ), INVAL
  371 M3 = 1
      GO TO 805
  373 IF ( MODE1( NUM )) 500, 3733, 3734
 3733 NUMBR = NUMBR + 1
      MODE1( NUM ) = 2
 3734 IF(NTR-3)3856,3857,500
 3857 TNUM=1./TNUM
      GO TO 3749
 3856 GO TO (3851,3852,3853),ITOL
 3851 Y( NUM ) = 1.0 / TNUM
      YMIN( NUM ) = Y( NUM )
      GO TO 3854
 3852 IF (IPC)  500,3854,3855
 3854 YMAX( NUM ) = 1.0 / TNUM
      GO TO 2310
 3855 YMIN( NUM ) = Y( NUM ) / ( 1.0 + TNUM )
      YMAX( NUM ) = Y( NUM ) / ( 1.0 - TNUM )
      GO TO 19
 3853 YMIN( NUM ) = 1.0 / TNUM
      GO TO 19
  374 IF ( MODE1( NUM )) 3749, 3743, 3749
 3743 NUMBR = NUMBR + 1
      IF ( NTR - 3 ) 3742, 3741, 500
 3741 MODE1( NUM ) = 2
      GO TO 3749
 3742 MODE1( NUM ) = - 2
 3749 GO TO (3744,3745,3746),ITOL
 3744 Y( NUM ) = TNUM
      GO TO 3747
 3745 IF(IPC) 500,3747, 3748
 3747 YMIN( NUM ) = TNUM
      YMAX( NUM ) = TNUM
      GO TO 2310
 3748 YMIN( NUM ) = Y( NUM ) * ( 1.0 - TNUM )
      YMAX( NUM ) = Y( NUM ) * ( 1.0 + TNUM )
      GO TO 19
 3746 YMAX( NUM ) = TNUM
      GO TO 19
  375 GO TO (3911,3912,3913,3916),ITOL
 3911 IF(KO) 500, 73, 74
   74 E( NUM ) = TNUM
      GO TO 19
   73 E( NUM ) = TNUM
      GO TO 3914
 3912 IF (IPC)  500,3914,3915
 3914 EMIN( NUM ) = TNUM
      GO TO 3913
 3915 EMIN( NUM ) = E( NUM ) - TNUM * ABS ( E( NUM ))
      EMAX( NUM ) = E( NUM ) + TNUM * ABS ( E( NUM ))
      GO TO 2310
 3913 EMAX( NUM ) = TNUM
      GO TO 2310
 3916 EPHA ( NUM ) = TNUM * 0.01745329
      GO TO 19
  376 GO TO(3921,3922,3923,3926),ITOL
 3921 IF(KO) 500, 75, 76
   76 AMP( NUM ) = TNUM
      GO TO 19
   75 AMP( NUM ) = TNUM
      GO TO 3924
 3922 IF (IPC)  500,3924,3925
 3924 AMPMIN( NUM ) = TNUM
      GO TO 3923
 3925 AMPMIN( NUM ) = AMP( NUM ) - TNUM * ABS ( AMP( NUM ))
      AMPMAX( NUM ) = AMP( NUM ) + TNUM * ABS ( AMP( NUM ))
      GO TO 2310
 3923 AMPMAX( NUM ) = TNUM
      GO TO 2310
 3926 AMPPHA ( NUM ) = TNUM * 0.01745329
      GO TO 19
 377  GO TO ( 393, 804, 395, 804 ), LTYPE
  393 IF ( MODE1( NUM )) 500, 3931, 3734
 3931 NUMBL = NUMBL + 1
      MODE1( NUM ) = 3
      GO TO 3734
  395 IF(ITOL-2) 1395, 1396, 1399
 1395 FLM(NUM)=TNUM
      GO TO 1397
 1396 IF(IPC) 500, 1397, 1398
 1397 FLML(NUM)=TNUM
      FLMH(NUM)=TNUM
      GO TO 2310
 1398 FLML(NUM)=FLM(NUM)-TNUM*ABS(FLM(NUM))
      FLMH(NUM)=FLM(NUM)+TNUM*ABS(FLM(NUM))
      GO TO 19
 1399 FLMH(NUM)=TNUM
      GO TO 19
  378 IF ( MODE1( NUM )) 500, 3783, 3749
 3783 NUMBC = NUMBC + 1
      MODE1( NUM ) = 1
      GO TO 3749
   19 ITRANS = 2
   39 IF( ICOL + 1 - KCOL ) 9996, 9996, 100
 2310 ITRANS = 3
      GO TO 39
  100 ITRANS = 4
      GO TO 9996
  500 ITRANS = 5
      GO TO 9996
 804  M3 = 37
  805 ITRANS = 6
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT ( 34H LANG SUBR-ECA-05 EXIT.    ITRANS=I4 )
 9998 WRITE(NDEVO, 9997) ITRANS
 9999 RETURN
      END
	SUBROUTINE ECA06
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 26H LANG SUBR-ECA-06 ENTERED. )
 3    WRITE(NDEVO, 2)
    4 CONTINUE
  125 M1 = 1
      ICOL = 7
  121 DO 10 K = 1, 11
      IF (NWORDS(ICOL).NE.NMCD(1,K))GO TO 10
 6    IF (NWORDS(ICOL+1).EQ.NMCD(2,K))GO TO 7
 10   CONTINUE
      GO TO 104
7	IF(K-4) 5,17,17
17	 MAC = MAC + 1
	 IF(MAC-6) 11, 135, 500
   11 KTYPE( MAC ) = K
      IF(K-4) 5,7000,9
 7000 IF ( NTR - 3 ) 7003, 7002, 7002
 7002 M3 = 9
      GO TO 805
 7003 IF ( MAC - 1 ) 500, 90, 7001
 7001 MAC=MAC-1
  90  MO = 1
      IWCOUT(3)=0
      IWCOUT(4)=0
      IRTN=1
      MSEQ = 0
      NPRINT(7)=0
      NUMMO=0
      GO TO 100
    9 IF ( K - 8 ) 4046, 5, 93
 4046 IF ( K - 6 ) 46, 4047, 4047
  104 IF((NWORDS(ICOL).EQ.INDC(1,2)).AND.(NWORDS(ICOL+1).EQ.
     1INDC(2,2))) IDATA=1
	DO 16 MTYPE = 1, 20
      IF(NWORDS(ICOL).NE.INDC(1,MTYPE))GO TO 16
   12 IF ( NWORDS( ICOL+1 ).EQ.INDC( 2,MTYPE ))GO TO 13
 16   CONTINUE
 4047 M3 = 10
      GO TO 805
  135 M3 = 30
      GO TO 805
   13 ICOL=ICOL+1
      IF ( ICOL - KCOL ) 159, 159, 100
 159  IF ( MTYPE - 10 ) 162, 447, 447
 447  IF ( MTYPE - 20 ) 161, 140, 500
  162 IF ( MTYPE - 4 ) 157, 140, 140
  161 IF(NWORDS(ICOL).EQ.KPUNC(1))GO TO 160
      GO TO 13
  157 ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 166, 100, 100
  166 IF ( NWORDS( ICOL ).NE.KPUNC( 3 ))GO TO 157
  163 ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 174, 100, 100
  174 DO 180 K = 1, 10
      IF ( NWORDS( ICOL ).NE.KOUT( 1,K ))GO TO 180
  178 IF ( NWORDS( ICOL+1 ).EQ.KOUT( 2,K ))GO TO 179
  180 CONTINUE
      IF ( NWORDS( ICOL ).NE.KOUT( 2,1 ))GO TO 220
  200 IF ( NWORDS( ICOL+1 ).NE.KOUT( 2,8 ))GO TO 220
  210 K = 1
      GO TO 179
  220 IF ( NWORDS( ICOL ).NE.KOUT( 1,2 ))GO TO 250
  230 IF ( NWORDS( ICOL+1 ).NE.INDC( 2,11 ))GO TO 250
  240 K = 2
      GO TO 179
  250 M3 = 11
      GO TO 805
  179 NPRINT ( K ) = 1
      GO TO 157
  160 ICOL=ICOL+1
      IF ( ICOL - KCOL ) 165, 165, 100
  165 CALL ECA09
      IF ( NQUIT ) 500, 167, 805
  167 IF(MO) 500, 140, 906
  906 IF ( MTYPE - 10 ) 140, 139, 140
  140 MTYPE1 = MTYPE - 3
      GO TO ( 850,851,45,8009,45,146,147,148,149,150,151,152,
     1   154,153,81,82,490),MTYPE1
 8009 I = 0
 8010 IF(NWORDS(ICOL).EQ.KPUNC(3))GO TO 8005
 8001 ICOL=ICOL+1
      IF(ICOL-KCOL)8010,8010,8050
 8005 ICOL=ICOL+1
      IF( ICOL - KCOL ) 8006, 8006, 8050
 8006 I = 1
      CALL ECA09
      IF(NQUIT)500,8020,805
 8020 K=TNUM
      J=(K-1)/25+1
      L = MOD( K-1, 25 ) + 1
      IF(MO)500,8030,8040
 8040 J=J+2
 8030 IWCOUT(J)=2**(L-1)+IWCOUT(J)
      GO TO 8010
 8050 IF( I ) 500, 8060, 8090
 8060 IF(MO)500,8070,8080
 8070 IWCOUT(1)= 33554431
      IWCOUT(2)= IWCOUT(1)
      GO TO 45
 8080 IWCOUT(3)= 33554431
      IWCOUT(4)= IWCOUT(3)
      GO TO 45
 8090 I = 0
      GO TO 45
  490 NEQUIM = 1
      GO TO 100
  850 M3 = 12
      GO TO 805
  851 M3 = 13
      GO TO 805
   45 IF ( MO ) 500, 440, 340
  340 IF ( MTYPE1 - 4 ) 345, 349, 350
  440 IF ( MTYPE1 - 4 ) 445, 49, 50
  445 IF ( ISEQ ) 500, 446, 100
  446 ISEQ = 1
      GO TO 100
   49 IF(ISEQ-3)51,53,51
   51 ISEQ=2
      GO TO 100
   50 IF(ISEQ-2)52,53,52
   52 ISEQ=3
      GO TO 100
   53 ISEQ=4
      GO TO 100
  345 IF ( MSEQ ) 500, 346, 100
  346 MSEQ = 1
      GO TO 100
  349 IF ( MSEQ - 3 ) 351, 353, 351
  351 MSEQ = 2
      GO TO 100
  350 IF ( MSEQ - 2 ) 352, 353, 352
  352 MSEQ = 3
      GO TO 100
  353 MSEQ = 4
      GO TO 100
  146 GO TO 4047
  147 OMEGA = TNUM * 6.283185
      GO TO 100
  154 DELTA = TNUM
      GO TO 100
  148 MAJOR=TNUM
      GO TO 100
  149 ERROR1 = TNUM
      GO TO 100
  150 ERROR2=TNUM
      GO TO 100
  151 ERROR3 = TNUM
      GO TO 100
  152 START=TNUM
      GO TO 100
  153 FINISH=TNUM
      GO TO 100
   81 SHORT=TNUM
      GO TO 100
   82 OPEN=TNUM
      GO TO 100
  169 ICOL=ICOL+1
      IF ( ICOL - KCOL ) 171, 171, 100
  171 IF(NWORDS(ICOL).EQ.KPUNC(2))GO TO 173
  172 IF ( NWORDS( ICOL ).EQ.KPUNC( 4 ))GO TO 173
  177 IF ( NWORDS( ICOL ).NE.NBCD( 2 ))GO TO 165
  181 NREC = 2
      GO TO 169
  173 MO =MO +1
      GO TO 169
  139 GO TO (907,175,176),MO
  907 NUMMO=NUMMO+1
      IF ( NUMMO - 50 ) 909, 909, 908
 908  M3 = 34
      GO TO 805
 909  MOPARM(NUMMO) = 8
      VFIRST(NUMMO)=TNUM
      NREC = 1
      GO TO 169
  175 MOSTEP( NUMMO ) = TNUM
      VSECND( NUMMO ) = TNUM
      GO TO 169
  176 VLAST(NUMMO)=TNUM
      MO=1
      GO TO 100
   93 NOEXEC=0
      MO=0
      GO TO 100
5      ITRANS = 1
      GO TO 9996
   46 ITRANS = 3
      GO TO 9996
  100 ITRANS = 4
      GO TO 9996
  500 ITRANS = 5
      GO TO 9996
  805 ITRANS = 6
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT (34H LANG SUBR-ECA-06 EXIT.    ITRANS=I4)
 9998 WRITE(NDEVO, 9997) ITRANS
 9999 RETURN
      END
	SUBROUTINE ECA07
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
	DIMENSION IRRTBL(50,0/9),A(2)
	DATA A/' ','^'/
C
C	ERROR TABLE
C
	DATA (IRRTBL(1,I),I=0,9)/1,'INCORRECTLY FORMED DATA GROUP',
     #3*0/
	DATA (IRRTBL(2,I),I=0,9)/2,'MORE THAN 5 TIME-DEPENDENT VOLTAGE
     1 SOURCES'/
	DATA (IRRTBL(3,I),I=0,9)/2,'MORE THAN 5 TIME-DEPENDENT CURRENT
     1 SOURCES'/
	DATA (IRRTBL(5,I),I=0,9)/1,'CHARACTER IS NOT "B,T,M,S,E OR I"',
     #2*0/
	DATA (IRRTBL(6,I),I=0,9)/2,'NUMBER OF A TIME-DEPENDENT SOURCE
     1 OMITTED'/
	DATA (IRRTBL(9,I),I=0,9)/1,'MODIFY NOT ALLOWED IN TRANSIENT AN
     .ALYSIS',0/
	DATA (IRRTBL(20,I),I=0,9)/1,'CHARACTER IS NOT "B,N,R,G,E,I,L,C"'
     #,2*0/
	DATA (IRRTBL(22,I),I=0,9)/1,'TOO MANY DATA SUBGROUPS',4*0/
	DATA (IRRTBL(27,I),I=0,9)/1,'E0 OR I0 NOT ALLOWED IN AC OR DC',
     #2*0/
	DATA (IRRTBL(28,I),I=0,9)/1,'ILLEGAL CHARACTER IN NUMBER',3*0/
	DATA (IRRTBL(31,I),I=0,9)/1,'INITIAL COND. OF SWITCH IMPROPERLY
     . DEFINED'/
 	DATA (IRRTBL(32,I),I=0,9)/1,'NODE NUMBER EXCEEDS 20',4*0/
	DATA (IRRTBL(33,I),I=0,9)/1,'L OR C NOT ALLOWED IN DC',4*0/
	DATA (IRRTBL(42,I),I=0,9)/1,'TOO MANY DATA GROUPS',5*0/
	DATA (IRRTBL(43,I),I=0,9)/1,'CHARACTER NOT DEFINED IN SYSTEM
     . CONTROL',0/
	DATA (IRRTBL(46,I),I=0,9)/1,'NUMBER NOT IN MODEL',5*0/
	DATA (IRRTBL(47,I),I=0,9)/2,'FREQUENCY OR TIME STEP IMPR
     .OPERLY DEFINED'/
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 34H LANG SUBR-ECA-07 ENTERED. ITRANS=I2 )
 3    WRITE(NDEVO, 2) ITRANS
    4 GO TO ( 500, 500, 500, 100, 500, 805, 1000,8000 ), ITRANS
  500 M3 = 1
      WRITE(IDLG, 3004 )
      GO TO 238
  805 GOTO(11,12,13,14,15),IRRTBL(M3,0)
11	WRITE(IDLG,701)(NWORDS(J),J=1,KCOL)
	WRITE(IDLG,703)(A(1),J=1,ICOL),A(2)
703	FORMAT(72A1)
901	WRITE(IDLG,704) M3,(IRRTBL(M3,J),J=1,9)
704	FORMAT(' ***ERROR # ',I2,3X,9A5)
	GOTO 900
12	GOTO 901
13	CONTINUE
14	CONTINUE
15	CONTINUE
  900 NQUIT = 1
	NOEXEC=NOEXEC+1
      GO TO 100
 1000 IF(NWORDS(2).NE.NMCD(1,3))GO TO 2200
 1100 IF(NWORDS(3).NE.NMCD(2,3))GO TO 501
 1200 NTRACE = 1
      GO TO 2500
 2200 IF ( NWORDS( 2 ).NE.INDC( 1, 6 ))GO TO 2600
 2300 IF(NWORDS(3).NE.INDC(1,7))GO TO 501
 2400 NSWTCH=0
      ICOL=8
 2503 IF ( NWORDS(ICOL).EQ.KPUNC(3))GO TO 2502
 2501 ICOL = ICOL + 1
      IF ( ICOL - 72 ) 2503, 2503, 2500
 2502 ICOL = ICOL + 1
      CALL ECA09
      IF (NQUIT) 500,2504,501
 2504 K=TNUM
      NSWTCH = 2**(K-1)+NSWTCH
      GO TO 2503
 2600 IF ( NWORDS( 2 ).NE.KLABEL( 1 ))GO TO 2700
 2601 IF ( NWORDS( 3 ).NE.NMCD( 2, 1 )) GO TO 501
 2602 KPUNC( 1 ) = '#'
      KPUNC( 2 ) = '%'
      KPUNC( 4 ) = '<'
      NBCD( 2 ) = '&'
      NBCD( 18 ) = '<'
      NBCD( 19 ) = '%'
      GO TO 2500
 2700 IF ( NWORDS( 2 ).NE.INPUTB( 5 )) GO TO 501
 2701 IF ( NWORDS( 3 ).NE.KLABEL( 1 )) GO TO 501
 2702 KPUNC( 1 ) = '='
      KPUNC( 2 ) = '('
      KPUNC( 4 ) = ')'
      NBCD( 2 ) = '+'
      NBCD( 18 ) = ')'
      NBCD( 19 ) = '('
      GO TO 2500
 501  WRITE(IDLG,502)
 502  FORMAT(//,' INVALID SYSTEM CONTROL CARD - - IGNORED',//)
 2500 WRITE(IDLG, 701 ) ( NWORDS ( J ), J = 1, 72 )
      GO TO 100
  701 FORMAT ( 1H 72A1 )
 3004 FORMAT( //13H ERROR NO.  1,/,34H ALL AC, DC, OR TRANSIENT JOBS ARE
     141H ABANDONED BECAUSE OF LANGUAGE OR MACHINE/
     240H FAILURE. CONTROL IS RETURNED TO MONITOR //)
C
C
C
C
  238 CALL EXIT
8000	WRITE(IDLG,8001) NOEXEC
8001	FORMAT('-%%%% ',I3,2X,'ERROR(S) WERE DETECTED, EXECUTION
     1 IMPOSSIBLE'//)
	NOEXEC=0
  100 CONTINUE
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT (34H LANG SUBR-ECA-07 EXIT.    ITRANS=I4)
 9998 WRITE(NDEVO, 9997) ITRANS
 9999 RETURN
      END
	SUBROUTINE ECA08
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
C	FOLLOWING ARE COMMON TO LANG. INTERP. ONLY
C
	COMMON /LANG/MODEL(0/15,125),IPLACE(6),ISTORE(6),ERRCHK,NEXT
     1,ITAB(20),ITRACK(20),NEXADS
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 38H LANG ZEROING SUBR-ECA-08 ENTERED.    )
 3    WRITE(NDEVO,2) 
    4 CONTINUE
      MAC = 0
      HNODE = 0
      NEQUIM = 0
      NOEXEC = 0
      NQUIT = 0
      KS = 0
      M1 = -1
      KCARD = 1
      KG = 0
      TNUM = 0.0
      DO 1010 I = 1, 10
 1010 NPRINT( I ) = 0
      DO 1011 I = 1, 65
      IROWT( I ) = 0
      ICOLT( I ) = 0
      YTERM( I ) = 0.0
      YTERML( I ) = 0.0
 1011 YTERMH( I ) = 0.0
      DO 1015 I = 1, 50
       MOSTEP(I)=0
      VFIRST( I ) = 0.0
      VSECND( I ) = 0.0
      VLAST( I ) = 0.0
      IROWM( I ) = 0
      ICOLM( I ) = 0
      FLM( I ) = 0.0
      FLML( I ) = 0.0
      FLMH( I ) = 0.0
 1015 MOBRN( I ) = 0
      DO 1020 I = 1, 65
      NINIT( I ) = 0
      NFIN( I ) = 0
      MODE1( I ) = 0
      E(I) = 0.0
      EMIN(I)=0.
      EMAX(I)=0.
      AMP(I)=0.
      AMPMIN(I)=0.
      AMPMAX(I)=0.
      Y(I)=0.
      YMIN( I ) = 0.0
      YMAX ( I ) = 0.0
      EPHA(I)=0.
 1020 AMPPHA( I ) = 0.0
      DO 1040 I=1,5
      ETIME(I,1)= 0.0
      ETIME(I,2)= 0.0
      ATIME(I,1)= 0.0
      ATIME(I,2)= 0.0
      DO 1040 J = 1, 65
      ETR( I,J ) = 0.0
 1040 AMPTR( I,J ) = 0.0
      DO 1050 I=1,4
 1050 IWCOUT(I)=0
      NMAX = 0
      NNODE = 0
      NTERMS = 0
      NUMBL = 0
      NUMBR = 0
      NUMBC = 0
      NLTRMS = 0
      IRTN = 1
      MAJOR=1
      DELTA=0.0
      ERROR1 = 0.001
      ERROR2=.001
      ERROR3 = 1.0
 1055 ISEQ = 0
      MSEQ = 0
      MO = 0
      NUMMO = 0
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT ( 39H LANG ZEROING SUBR-ECA-08 EXIT.    NTR=I4 )
 9998 WRITE(NDEVO, 9997) NTR
 9999 RETURN
      END
	SUBROUTINE ECA08A
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
C	FOLLOWING ARE COMMON TO LANG. INTERP. ONLY
C
	COMMON /LANG/MODEL(0/15,125),IPLACE(6),ISTORE(6),ERRCHK,NEXT
     1,ITAB(20),ITRACK(20),NEXADS
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 45H LANG MODEL ZEROING SUBR-ECA-08A ENTERED.    )
 3    WRITE(NDEVO,2) 
    4 CONTINUE
	IDATA=0
	NSWTCH=0
	NTR=0
	KTO=1
	CALL ECA01
	NTRACE=0
	KI=0
	KE=0
	NEXT=10
	DO 1000 I=1,6
1000	ISTORE(I)=0
	DO 1001 I=1,125
	MODEL(0,I)=0
	DO 1001 J=1,15
1001	MODEL(J,I)=' '
	DO 1002 J=1,20
	XXX(J)=0
	ITAB(J)=0
1002	ITRACK(J)=0
	NEXADS=1
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT ( 46H LANG MODEL ZEROING SUBR-ECA-08A EXIT.    NTR=I4 )
 9998 WRITE(NDEVO, 9997) NTR
 9999 RETURN
      END
	SUBROUTINE ECA09
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2150 WORDS)
C
	COMMON /MAIN1/AMP(65),AMPMAX(65),AMPMIN(65),E(65),EMAX(65)
     1	,EMIN(65),ERROR1,ICOLT(65),IROWT(65),IRTN,KTO,ISEQ,MO,MODE1
     2	(65),MSEQ,NFIN(65),NINIT(65),NMAX,NNODE,NPRINT(10),NSWTCH,
     3	NTERMS,NTRACE,NUMBC,NUMBL,NUMBR,NUMMO,Y(65),YMAX(65),YMIN(65)
     4	,YTERM(65),YTERMH(65),YTERML(65),IDATA
C
C
C
C	FOLLOWING ARE COMMON TO ALL SUBROUTINES (2090 WORDS)
C	THESE DO NOT MATCHUP TO ALL SUBROUTINES
C
	COMMON /MAIN2/VFIRST(50),VSECND(50),VLAST(50),MOBRN(50),
     1	MOPARM(50),MOSTEP(50),IWCOUT(4),NLTRMS,DELTA,IROWM(50),
     2	ICOLM(50),FLML(50),FLMH(50),FLM(50),EPHA(65),AMPPHA(65),NREC,
     3	MAJOR,ERROR2,ERROR3,ETIME(5,2),ATIME(5,2),ETR(5,65),
     4	AMPTR(5,65),XXX(180)
C
C
C
C	FOLLOWING ARE USED INDIVIDUALLY BY LANG.,DC,AC,TR.(918 WORDS)
C
	COMMON /MAIN3/NWORDS(75),NMCD(2,20),KLABEL(4),KPUNC(5),
     1	INDC(2,20),INPUTB(9),NBCD(20),EQUIVN(20),KOUT(2,10),
     2	YYY(430)
C
C
C	FOLLOWING CAN NEVER BE DESTROYED USED BY LANG. (36 WORDS)
C
	COMMON /MAIN5/IPRINT,KTYPE(5),NBLANK,NOEXEC,ITOL,NEQUIM,
     1	IPC,INVAL,LL,ICOL,LTYPE,KCOL,NQUIT,ITRANS,KO,KS,KELAST,
     2	NUM,M1,M2,M3,KCARD,KG,NP,NTR,MAC,HNODE,TNUM,NOEL,NOE,
     3	NOI,NOIC
C
C
C
C	FOLLOWING ARE USED IN LANG. AND TR. 
C
	DIMENSION LIST4(65),LABEL(65),LISTE(65),LISTI(5),NUME(5)
     1	,NUMI(5),LINK1D(65),LINK1E(65)
C
	EQUIVALENCE (YTERM(1),LIST4(1)),(ISEQ,START),(MSEQ,FINISH),
     1 (NUMMO,SHORT),(VFIRST(2),LABEL(1)),(IWCOUT(2),KE),(IWCOUT(3),KI),
     2 (IWCOUT(4),NOSW),(DELTA,OMEGA),(FLM(1),LISTE(1)),
     3 (FLM(6),LISTI(1)),(FLM(11),NUME(1)),(FLM(16),NUMI(1)),
     4 (EPHA(1),LINK1D(1)),(AMPPHA(1),LINK1E(1)),(VFIRST(1),OPEN)
C
C
C
C	FOLLOWING ARE FOR INPUT AND OUTPUT SUBROUTINES
C
C	IDLG-DIALOG INPUT DEV.
C	IRSP-DIALOG OUTPUT DEV.
C	NDEVI-INPUT DEV.
C	NDEVO-OUTPUT DEV.
C
	COMMON /IOBLK/IDLG,IRSP,NDEVI,NDEVO,IDVI,IDVO,ICODE,IBNK,NAMI(2)
	COMMON /IOBLKA/NAMO(2),IPJ,IPG,NCOPYS,ITYCH
C
C
C
	DOUBLE PRECISION ACCUM
C
C	NUMERICAL EXTRACTION ROUTINE FOR INTERPETING BCD NUMERALS INTO
C	F,I,E FORMATS
C
C
    1 IF ( NTRACE ) 3, 4, 3
    2 FORMAT ( 41H LANG EXTRAC SUBR-ECA-09 ENTERED.   ICOL=I4 )
 3    WRITE(NDEVO, 2) ICOL
    4 TNUM = 0.0
      KOUNT = 0
      MINUS=0
      MINUSE=0
      NPART=0
      NE = 0
      NGOE=0
      ACCUM = 0.0D0
      GO TO 101
  100 ICOL = ICOL + 1
      IF ( ICOL - KCOL ) 101, 101, 35
  101 DO 77 KEY = 1, 20
      IF ( NWORDS( ICOL ).EQ.NBCD( KEY ))GO TO 22
C
   92 IF ( NWORDS( ICOL ) .EQ. 4967112768 )GO TO 90
C
   77 CONTINUE
      M3 = 28
      GO TO 432
C
   90  KEY = 16
C
22     IF(KEY-3) 100, 6, 9
    6 IF(NGOE) 500, 7, 8
    7 MINUS=1
      GO TO 100
    8 MINUSE=1
      GO TO 100
    9 IF(KEY-14) 12,18, 10
   12 IF(NGOE) 500, 185, 33
   18 NPART = 1
      GO TO 100
   10 IF(KEY-16) 21, 35, 35
  185 IF(NPART) 500, 187, 186
  186 KOUNT = KOUNT + 1
  187 ACCUM = ACCUM *1.D1 + (KEY - 4)
      GO TO 100
   21 NGOE = 1
      GO TO 100
   33 NE = NE * 10 + (KEY - 4)
      GO TO 100
   35 IF(MINUSE) 500, 40, 39
  500 M3 = 1
  432 NQUIT = 1
      GO TO 43
   39 NE = - NE
   40 NE = NE - KOUNT
      IF ( NE ) 27, 28, 27
   27 ACCUM = ACCUM * 1.D1**NE
   28 TNUM = ACCUM
      IF(MINUS) 36, 43, 36
   36 TNUM = - TNUM
   43 ICOL = ICOL - 1
 9996 IF ( NTRACE ) 9998, 9999, 9998
 9997 FORMAT(41H LANG EXTRAC SUBR-ECA-09 EXIT.      ICOL=I4,
     1   8H   TNUM=1PG15.8 )
 9998 WRITE(NDEVO, 9997) ICOL,TNUM
 9999 RETURN
      END