Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/ecap/ecapla.for
There is 1 other file named ecapla.for in the archive. Click here to see a list.
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