-
Notifications
You must be signed in to change notification settings - Fork 0
/
instal.for
188 lines (148 loc) · 4.09 KB
/
instal.for
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
IMPLICIT INTEGER (A-Z)
PARAMETER MAXOPT=20
PARAMETER MAXKWD=20
PARAMETER MAXKW1=21
PARAMETER MAXLVL=20
DOUBLE PRECISION KWD, KWDS, OPTKWD, FLAG, FILNAM
DIMENSION REST(19), FLAG(MAXLVL), FILNAM(1)
DIMENSION KWDS(MAXKW1), OPTP1(MAXOPT), OPTP2(MAXOPT)
DIMENSION OPTKWD(MAXOPT), ASCNUM(MAXOPT)
DATA ASCNUM/'1','2','3','4','5','6','7','8','9','10',
1 '11','12','13','14','15','16','17','18','19','20'/
C*** INITIALIZE
OPEN (file='INSTAL.DOC',ACCESS='SEQIN',UNIT=20)
OPEN (file='INSTAL.RNO',ACCESS='SEQOUT',UNIT=21)
LEVEL=1
FLAG(LEVEL)='BASE'
DO 100 IX=1,MAXKW1
100 KWDS(IX)=0
C*** SCAN FILE AND COPY TO OUTPUT
1000 READ (20,1001,END=9000) PRFX, IBGN, KWD, REST
1001 FORMAT(2A4,A8,A1,2A4,A1,15A4)
1010 ILEN=1
DO 1015 IX=2,19
1015 IF (REST(IX).NE.' ') ILEN=IX
IF (PRFX.NE.'.C 1') GOTO 1020
IF (IBGN.EQ.';COM') GOTO 1000
IF (IBGN.EQ.';IF ') GOTO 2000
IF (IBGN.EQ.';OR ') GOTO 2500
IF (IBGN.EQ.';AN ') GOTO 2600
IF (IBGN.EQ.';END') GOTO 3000
1020 IF (FLAG(LEVEL).EQ.0) GOTO 1000
IF (PRFX.NE.'.C 1') GOTO 1030
IF (IBGN.EQ.';Q: ') GOTO 4000
IF (IBGN.EQ.';ON ') GOTO 5000
IF (IBGN.EQ.';RD ') GOTO 6000
IF (IBGN.EQ.';OF ') GOTO 7000
IF (IBGN.NE.';T: ') PAUSE 'GARBAGE'
TYPE 1002,KWD,(REST(IX),IX=1,ILEN)
1002 FORMAT (1X,A8,A1,2A4,A1,15A4)
GOTO 1000
1030 WRITE (21,1001) PRFX,IBGN,KWD,(REST(IX),IX=1,ILEN)
GOTO 1000
C*** CONDITIONAL: SCAN FOR MATCHING KEYWORD
2000 LEVEL=LEVEL+1
IF (LEVEL.GT.MAXLVL) PAUSE 'MAXLVL'
2101 FLAG(LEVEL)=0
IF (FLAG(LEVEL-1).EQ.0) GOTO 1000
DO 2100 IX=1,MAXKWD
IF (KWDS(IX).EQ.KWD) GOTO 2200
IF (KWDS(IX).EQ.0) GOTO 1000
2100 CONTINUE
GOTO 1000
2200 FLAG(LEVEL)=KWD
IF (DEBUG.NE.0) TYPE 2201,(FLAG(J),J=2,LEVEL)
2201 FORMAT (' BEGIN: ',20(A8,2X))
GOTO 1000
C*** OR
2500 IF(FLAG(LEVEL).NE.0) GOTO 1000
IF(LEVEL.LE.1) PAUSE 'OR WITHOUT IF'
GOTO 2101
C*** AND
2600 IF(FLAG(LEVEL).EQ.0) GOTO 1000
IF(LEVEL.LE.1) PAUSE 'AND WITHOUT IF'
GOTO 2101
C*** END OF CONDITIONAL
3000 IF (LEVEL.LE.1) PAUSE 'UNMATCHED *END'
LEVEL=LEVEL-1
IF (DEBUG.EQ.0.OR.FLAG(LEVEL+1).EQ.0) GOTO 1000
TYPE 3001,(FLAG(J),J=2,LEVEL+1)
3001 FORMAT (' END: ',20(A8,2X))
GOTO 1000
C*** ASK A QUESTION
4000 TYPE 1002,KWD,REST
NUMOPT=0
DO 4100 IX=1,MAXOPT
4010 READ (20,1001) PRFX, IBGN, KWD, REST
IF (PRFX.NE.'.C 1') GOTO 4200
IF (IBGN.EQ.';COM') GOTO 4010
ILEN=1
DO 4013 J=2,19
4013 IF (REST(J).NE.' ') ILEN=J
IF (IBGN.NE.';T: ') GOTO 4020
TYPE 1002,KWD,(REST(J),J=1,ILEN)
GOTO 4010
4020 IF (IBGN.NE.';A: ') GOTO 4200
TYPE 4021,IX,REST(2),REST(3),(REST(J),J=5,ILEN)
4021 FORMAT (' ',I2,'. ',2A4,1X,15A4)
NUMOPT=IX
OPTKWD(IX)=KWD
OPTP1(IX)=REST(2)
OPTP2(IX)=REST(3)
4100 CONTINUE
C*** AND GET A RESPONSE
4200 IF (NUMOPT.EQ.0) PAUSE 'NO OPTIONS'
TYPE 4201
4201 FORMAT (/,' >>',$)
ACCEPT 4202,USR1,USR2
4202 FORMAT (2A4)
DO 4300 IX=1,NUMOPT
IF (USR1.EQ.OPTP1(IX).AND.USR2.EQ.OPTP2(IX)) GOTO 4400
IF (USR1.EQ.ASCNUM(IX).AND.USR2.EQ.' ') GOTO 4400
4300 CONTINUE
TYPE 4301
4301 FORMAT (' ? NOT AN AVAILABLE OPTION')
GOTO 4200
C FOUND THE KEYWORD
4400 DO 4450 J=1,MAXKWD
IF (KWDS(J).EQ.0) KWDS(J)=OPTKWD(IX)
IF (KWDS(J).EQ.OPTKWD(IX)) GOTO 1010
4450 CONTINUE
PAUSE 'MAXKWD'
GOTO 1010
C*** SET AN OPTION DIRECTLY
5000 DO 5100 J=1,MAXKWD
IF (KWDS(J).EQ.0) KWDS(J)=KWD
IF (KWDS(J).EQ.KWD) GOTO 1000
5100 CONTINUE
PAUSE 'MAXKWD'
GOTO 1000
C*** READ FROM ANOTHER FILE
6000 CLOSE (UNIT=20)
C KLUDGE BECAUSE ONLY GET 8 CHARS - JB 4/12
IF(KWD .EQ. 'INSTAL.D') KWD='INSTAL.DOC'
FILNAM(1)=KWD
OPEN (UNIT=20,file=FILNAM(1),ACCESS='SEQIN')
LEVEL=1
GOTO 1000
C*** CLEAR AN OPTION
7000 IF(KWD .EQ. 'ALL') GOTO 7030
J=MAXOPT+1
DO 7010 IX=1,MAXOPT
7010 IF (KWDS(IX).EQ.KWD) J=IX
IF (J.GT.MAXOPT) GOTO 1000
DO 7020 IX=J,MAXOPT
7020 KWDS(IX)=KWDS(IX+1)
GOTO 1000
C CLEAR ALL OPTION
7030 DO 7035 IX=1,MAXKW1
7035 KWDS(IX)=0
GOTO 1000
C*** END IT ALL
9000 IF (LEVEL.NE.1) TYPE 9002
9002 FORMAT (' ?SOURCE FILE ENDS IN A CONDITIONAL')
TYPE 9003
9003 FORMAT (' Document is in the file INSTAL.RNO')
9001 STOP
END