1      SUBROUTINE EDMAI2(ISOURC,IEDINA,IDPSW)
2CCCCC PROGRAM EDMAIN      COMMENTED OUT TO MAKE IT A SUBROUTINE 7/92
3CCCCC THE ABOVE     SUBROUTINE   LINE WAS ADDED JULY 1992
4CCCCC THE    IDPSW   ARGUMENT (= DATAPLOT SWITCH) WAS ADDED JULY 1993
5C
6C     PURPOSE--THIS IS THE SUBROUTINE VERSION OF THE MAIN ROUTINE
7C              FOR THE EDITOR.  IT IS THE SUBROUTINE VERSION BECAUSE
8C              IT MUST BE CALLED BY DATAPLOT.
9C              IT DIFFERS ONLY IN THAT--
10C                          1) PROGRAM EDMAIN  ==>   SUBROUTINE EDMAI2
11C                          2) CALL EXIT(1)    ==>   RETURN
12C
13C     PURPOSE--THIS IS THE SECONDARY MAIN ROUTINE FOR THE EDITOR
14C
15C     ORIGINAL VERSION (AS A SEPARATE ROUTINE)--JANUARY 19,1985
16C     UPDATED--APRIL  1990  ADD LIST OF UNSET VARAIBLES (FROM IBM-PC)
17C     UPDATED--APRIL  1990  DEFINE CPUMIN
18C     UPDATED--APRIL  1990  PUT DISK & DIRECTORY FOR HELP, MESS., ETC. FED FILES
19C     UPDATED--APRIL  1990  ALLOW    EXRR FILE.EXT   PLUS OLD   EXRR
20C     UPDATED--APRIL  1990  EXTEND OLD   EXRR (NO ARGS)   TO    EXRR FILE.EXT
21C     UPDATED--APRIL  1990  ZX COMMANDS = CALL ZX. COMMANDS
22C     UPDATED--MARCH  1991  ADD BYTE NUMBER TO STATUS
23C     UPDATED--MARCH  1991  \EDITOR CHANGED TO \FED   FOR I/O
24C     UPDATED--JULY   1992  STOP SWITCH SO EXIT FROM EDMAIN
25C     UPDATED--JULY   1992  FIX    ER   INFINITE LOOP PROBLEM
26C     UPDATED--AUGUST 1992  MODIFY FILE NAMES FOR PORTABILITY
27C     UPDATED--AUGUST 1992  RENAME TO AVOID DATAPLOT CONFLICTS
28C                              MAXCHA => MAXEDC
29C                              MAXLIN => MAXEDL
30C                              MAXCOM => MAXCMN
31C     UPDATED--APRIL  1993  DEFINE IMASK (WAS DONE IN EDINIT)
32C     UPDATED--APRIL  1993  DEFINE UNIX FILES
33C     UPDATED--MAY    1993  GUI/MENU
34C     UPDATED--JULY   1993  DEFINE IRD, IPR, ETC.
35C                           ONLY IF STAND-ALONE FED
36C     UPDATED--JULY   1993  DEFINE NON-PRINTING ASCII CHARACTERS
37C                           ONLY IF STAND-ALONE FED
38C     UPDATED--JULY   1993  DEFINE HOST
39C                           ONLY IF STAND-ALONE FED
40C     UPDATED--AUGUST 1993  COMPILE ERROR ON RS-6000
41C
42C---------------------------------------------------------------------
43C
44CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1992
45      CHARACTER*4 ISOURC
46CCCCC CHARACTER*80 IEDINA
47      CHARACTER (LEN=*) :: IEDINA
48CCCCC THE FOLLOWING LINE WAS ADDED    JULY 1993
49      CHARACTER*4 IDPSW
50C
51      INCLUDE 'DPCOPA.INC'
52C
53CCCCC CHARACTER*80 IFILE
54      CHARACTER (LEN=MAXFNC) :: IFILE
55      CHARACTER*12 ISTAT
56      CHARACTER*12 IFORM
57      CHARACTER*12 IACCES
58      CHARACTER*12 IREWR
59      CHARACTER*4 ISUBN0
60      CHARACTER*4 IERRFI
61      CHARACTER*4 IENDFI
62      CHARACTER*4 IREWIN
63C
64      CHARACTER*4 ID
65      CHARACTER*4 IHNAME
66      CHARACTER*4 IHNAM2
67      CHARACTER*4 IUSE
68      CHARACTER*12 ITEMP
69C
70      CHARACTER*4 IEOF
71      CHARACTER*4 ILCSW
72      CHARACTER*1 IANS0
73      CHARACTER*1 IANSV
74C
75      CHARACTER*4 IBLASW
76      CHARACTER*4 IEXEIM
77C
78      CHARACTER*240 ICTEMP
79C
80      CHARACTER*10 ICSEQN
81C
82      CHARACTER*4 IERASW
83      CHARACTER*4 IMANUF
84      CHARACTER*4 IMODEL
85      CHARACTER*4 IHARLC
86      CHARACTER*4 IHARL2
87C
88      CHARACTER*4 IEXESL
89      CHARACTER*4 IEXIST
90C
91CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1990
92      CHARACTER*4 ICJUNK
93C
94CCCCC THE FOLLOWING 5 LINES WERE ADDED MAY 1990
95CCCCC CHARACTER*80 ITEMNA
96      CHARACTER (LEN=MAXFNC) :: ITEMNA
97      CHARACTER*12 ITEMST
98      CHARACTER*12 ITEMFO
99      CHARACTER*12 ITEMAC
100      CHARACTER*12 ITEMRW
101C
102CCCCC THE FOLLOWING LINE WAS ADDED JULY 1992
103      CHARACTER*4 STOPSW
104C
105CCCCC THE FOLLOWING 3 LINES WERE ADDED AUGUST 1992
106      CHARACTER*6 INAME
107      CHARACTER*4 IBUGIN
108CCCCC OCTOBER 1993.  FOLLOWING IS DECLARED IN EDCOMM.INC
109CCCCC CHARACTER*80 IEDDIR
110CCCCC CHARACTER*80 IEDDI2
111      CHARACTER (LEN=MAXFNC) :: IEDDI2
112C
113CCCCC THE FOLLOWING 2 LINES WERE ADDED (FOR GUI/MENU)    MAY 1993
114CCCCC CHARACTER*80 IB
115CCCCC CHARACTER*80 STRING
116      CHARACTER (LEN=MAXSTR) :: IB
117      CHARACTER (LEN=MAXSTR) :: STRING
118CCCCC AUGUST 1993.  ADD FOLLOWING TO AVOID COMPILE ERROR
119      CHARACTER*4 IMODE1
120      CHARACTER*4 IMODE2
121      CHARACTER*4 ISITE1
122      CHARACTER*4 ISITE2
123CCCCC END CHANGE
124C
125      DIMENSION IHNAME(100)
126      DIMENSION IHNAM2(100)
127      DIMENSION IUSE(100)
128      DIMENSION IVALUE(100)
129      DIMENSION VALUE(100)
130C
131      DIMENSION IANS0(240)
132      DIMENSION IANSV(240)
133C
134      DIMENSION IHARLC(100)
135      DIMENSION IHARL2(100)
136C
137      CHARACTER*4 ISUBN1
138      CHARACTER*4 ISUBN2
139      CHARACTER*4 ISTEPN
140C
141C-----COMMON VARIABLES (EDITING)-----------------------------------------------
142C
143      INCLUDE 'DPCOHO.INC'
144      INCLUDE 'DPCONP.INC'
145      INCLUDE 'EDCOMM.INC'
146CCCCC THE FOLLOWING LINE WAS ADDED (FOR MENU/GUI)   MAY 1993
147      INCLUDE 'DPCODV.INC'
148C
149C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
150C
151CCCCC COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
152C
153C-----START POINT-------------------------------------------
154C
155      ISUBN1='EDMA'
156      ISUBN2='I2  '
157C
158CCCCC THE FOLLOWING SECTION OF SETTINGS WERE ADDED APRIL 1990
159CCCCC AS A RESULT OF UNSET VARIABLES AS DETECTED
160CCCCC BY THE OTG COMPILER ON MY IBM-PC 386
161C
162      NUMNAM=0
163      NUMINL=0
164      MAXINL=0
165      MAXCPL=0
166      IWIDTH=0
167      IPRINT='    '
168      IP2LI1=0
169      IP2LI1=0
170      IMAX=0
171      IFLIM1=0
172      IFLIM2=0
173      ICERAS='    '
174      IBLIM1=0
175      IBLIM2=0
176C
177      ICOLL1=1
178      ICOLL2=50
179      IWIDSV=240
180      IPPLIN=50
181      IPPOFF=0
182      ILPOFF=0
183      IPASS=0
184      IWIDT0=0
185C
186      IBLASW='YES'
187      IEXEIM='NO'
188      IERASW='ON'
189      IEXESL='-999'
190      IEXIST='-999'
191C
192CCCCC IF NON-DATAPLOT, THEN DEFINE IRD, IRP, ETC.     JULY 1993
193      IF(IDPSW.EQ.'OFF')THEN
194         IRD=5
195         IPR=6
196C
197         NUMBPC=8
198         NUMCPW=4
199         NUMBPW=32
200C
201         CPUMAX=10.0**15
202CCCCC    THE FOLLOWING LINE WAS ADDED APRIL 1990
203         CPUMIN=(-CPUMAX)
204      ENDIF
205C
206CCCCC IF NON-DATAPLOT, THEN DEFINE NON-PRINTING ASCII CHAR. JULY 1993
207      IF(IDPSW.EQ.'OFF')THEN
208         INULC=CHAR(0)
209         ISOHC=CHAR(1)
210         ISTXC=CHAR(2)
211         IETXC=CHAR(3)
212         IEOTC=CHAR(4)
213         IENQC=CHAR(5)
214         IACKC=CHAR(6)
215         IBELC=CHAR(7)
216         IBSC=CHAR(8)
217         IHTC=CHAR(9)
218         ILFC=CHAR(10)
219         IVTC=CHAR(11)
220         IFFC=CHAR(12)
221         ICRC=CHAR(13)
222         ISOC=CHAR(14)
223         ISIC=CHAR(15)
224         IDLEC=CHAR(16)
225         IDC1C=CHAR(17)
226         IDC2C=CHAR(18)
227         IDC3C=CHAR(19)
228         IDC4C=CHAR(20)
229         INAKC=CHAR(21)
230         ISYNC=CHAR(22)
231         IETBC=CHAR(23)
232         ICANC=CHAR(24)
233         IEMC=CHAR(25)
234         ISUBC=CHAR(26)
235         IESCC=CHAR(27)
236         IFSC=CHAR(28)
237         IGSC=CHAR(29)
238         IRSC=CHAR(30)
239         IUSC=CHAR(31)
240      ENDIF
241C
242CCCCC IF NON-DATAPLOT, THEN DEFINE THE HOST       JULY 1993
243      IF(IDPSW.EQ.'OFF')THEN
244         IHOST1='IBM-'
245         IHOST2='PC  '
246CCCCC    IHOST1='UNIX'
247CCCCC    IHOST2='    '
248         IMANUF='TEKT'
249         IMODEL='4014'
250      ENDIF
251C
252      IF(IDPSW.EQ.'OFF')THEN
253         IMODE1=' '
254         IMODE2=' '
255         IOPSY1=' '
256         IOPSY2=' '
257         ISITE1=' '
258         ISITE2=' '
259      ENDIF
260C
261      CALL EDINIT
262C
263CCCCC THE FOLLOWING LINE IS DELIBERATEDLY SET AT A DOUBLE BACKSLASH
264CCCCC TO ACCOMODATE BOTH NON-UNIX AND UNIX MACHINES.   APRIL 1993
265CCCCC IT WILL GENERATE A COMPILER WARNING              APRIL 1993
266CCCCC (BUT WILL SUCCESFULLY COMPILE) ON AN IBM-PC.     APRIL 1993
267CCCCC IMASK='\\'
268      IMASK='\'
269C
270CCCCC AUGUST 1992.  FOLLOWING SECTION MODIFIED.  FOR BETTER PORTABILITY
271CCCCC AND EASIER INSTALLATION, DEFINE
272CCCCC      EDITOR DIRECTOR    IEDDIR
273CCCCC      AND EDITOR PATH NAME   IED
274CCCCC      AND EDITOR CASE (PPER/LOWER) IEDCAS
275CCCCC      AND EDITRO FILE EXTENSION   IEDEXT
276CCCCC INITFO, USE THOSE NAMES HERE TO DEFINE THE FILES.  USE SAME
277CCCCC SCHEME AS INITFO.
278C
279      IBUGIN='OFF'
280CCCCC FEBRUARY 1995.  COMMENT OUT FOLLOWING LINE (DONE IN INITFO).
281CCCCC FOLLOWING LINE WIPES OUT DEFINITION IN INITFO.
282CCCCC DEFINE IEDDI2 TO BE NULL FOR FILES FOUND IN CURRENT DIRECTORY
283CCCCC IEDDIR=' '
284      IEDDI2=' '
285      NCNULL=0
286C
287CCCCC THE FOLLOWING 6 LINES WERE ADDED MAY 1990
288      ITEMNU=20
289CCCCC ITEMNA='C:\FED\FEDARG.TEX'
290      INAME='FEDARG'
291      IF(IEDCAS.EQ.'LOWE')INAME='fedarg'
292      NC=6
293      CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,ITEMNA,IBUGIN)
294C
295      ITEMST='UNKNOWN'
296      ITEMFO='FORMATTED'
297      ITEMAC='SEQUENTIAL'
298      ITEMRW='READONLY'
299C
300      IORINU=21
301      IORINA='-999'
302      IORIST='NEW'
303      IF(IHOST1.EQ.'HONE')IORIST='UNKNOWN'
304      IF(IHOST1.EQ.'PERK')IORIST='UNKNOWN'
305      IF(IHOST1.EQ.'NVE')IORIST='UNKNOWN'
306      IF(IHOST1.EQ.'205')IORIST='UNKNOWN'
307      IF(IHOST1.EQ.'CDC')IORIST='UNKNOWN'
308      IF(IHOST1.EQ.'IBM-')IORIST='UNKNOWN'
309      IF(IOPSY1.EQ.'UNIX')IORIST='UNKNOWN'
310      IORIFO='FORMATTED'
311      IORIAC='SEQUENTIAL'
312      IORIRW='READWRITE'
313C
314      ISAVNU=22
315CCCCC ISAVNA='EDSAVE.TEX'
316      INAME='EDSAVE'
317      IF(IEDCAS.EQ.'LOWE')INAME='edsave'
318      NC=6
319CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ISAVNA,IBUGIN)
320      CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ISAVNA,IBUGIN)
321C
322CCCCC ISAVST='UNKNOWN'
323      ISAVST='NEW'
324      IF(IHOST1.EQ.'HONE')ISAVST='UNKNOWN'
325      IF(IHOST1.EQ.'PERK')ISAVST='UNKNOWN'
326      IF(IHOST1.EQ.'NVE')ISAVST='UNKNOWN'
327      IF(IHOST1.EQ.'205')ISAVST='UNKNOWN'
328      IF(IHOST1.EQ.'CDC')ISAVST='UNKNOWN'
329      IF(IHOST1.EQ.'IBM-')ISAVST='UNKNOWN'
330      IF(IOPSY1.EQ.'UNIX')ISAVST='UNKNOWN'
331      ISAVFO='FORMATTED'
332      ISAVAC='SEQUENTIAL'
333      ISAVRW='READWRITE'
334C
335      IHELNU=23
336CCCCC IHELNA='FED$:EDHELP.TEX'
337CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386
338CCCCC IF(IHOST1.EQ.'IBM-')IHELNA='EDHELP.TEX'
339CCCCC IF(IHOST1.EQ.'IBM-')IHELNA='C:\FED\EDHELP.TEX'
340      INAME='EDHELP'
341      IF(IEDCAS.EQ.'LOWE')INAME='edhelp'
342      NC=6
343      CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,IHELNA,IBUGIN)
344C
345CCCCC IHELST='UNKNOWN'
346      IHELST='OLD'
347      IHELFO='FORMATTED'
348      IHELAC='SEQUENTIAL'
349      IHELRW='READONLY'
350C
351      ICOPNU=24
352CCCCC ICOPNA='EDCOPY.TEX'
353      INAME='EDCOPY'
354      IF(IEDCAS.EQ.'LOWE')INAME='edcopy'
355      NC=6
356CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ICOPNA,IBUGIN)
357      CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ICOPNA,IBUGIN)
358C
359CCCCC ICOPST='UNKNOWN'
360      ICOPST='NEW'
361      IF(IHOST1.EQ.'HONE')ICOPST='UNKNOWN'
362      IF(IHOST1.EQ.'PERK')ICOPST='UNKNOWN'
363      IF(IHOST1.EQ.'NVE')ICOPST='UNKNOWN'
364      IF(IHOST1.EQ.'205')ICOPST='UNKNOWN'
365      IF(IHOST1.EQ.'CDC')ICOPST='UNKNOWN'
366      IF(IHOST1.EQ.'IBM-')ICOPST='UNKNOWN'
367      IF(IOPSY1.EQ.'UNIX')ICOPST='UNKNOWN'
368      ICOPFO='FORMATTED'
369      ICOPAC='SEQUENTIAL'
370      ICOPRW='READWRITE'
371C
372      ICOMNU=25
373CCCCC ICOMNA='EDCOMM.TEX'
374      INAME='EDCOMM'
375      IF(IEDCAS.EQ.'LOWE')INAME='edcomm'
376      NC=6
377CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ICOMNA,IBUGIN)
378      CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ICOMNA,IBUGIN)
379C
380CCCCC ICOMST='UNKNOWN'
381      ICOMST='NEW'
382      IF(IHOST1.EQ.'HONE')ICOMST='UNKNOWN'
383      IF(IHOST1.EQ.'PERK')ICOMST='UNKNOWN'
384      IF(IHOST1.EQ.'NVE')ICOMST='UNKNOWN'
385      IF(IHOST1.EQ.'205')ICOMST='UNKNOWN'
386      IF(IHOST1.EQ.'CDC')ICOMST='UNKNOWN'
387      IF(IHOST1.EQ.'IBM-')ICOMST='UNKNOWN'
388      IF(IOPSY1.EQ.'UNIX')ICOMST='UNKNOWN'
389      ICOMFO='FORMATTED'
390      ICOMAC='SEQUENTIAL'
391      ICOMRW='READWRITE'
392C
393      ICALNU=26
394CCCCC ICALNA='EDCALL.TEX'
395      INAME='EDCALL'
396      IF(IEDCAS.EQ.'LOWE')INAME='edcall'
397      NC=6
398CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ICALNA,IBUGIN)
399      CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ICALNA,IBUGIN)
400C
401CCCCC ICALST='UNKNOWN'
402      ICALST='OLD'
403      ICALFO='FORMATTED'
404      ICALAC='SEQUENTIAL'
405CCCCC ICALRW='READWRITE'
406      ICALRW='READONLY'
407C
408      IPRINU=27
409      IF(IHOST1.EQ.'IBM-')THEN
410        IPRINA='PRN'
411      ELSE
412        IPRINA='PRINT.DAT'
413      ENDIF
414CCCCC FEBRUARY 1995.  REVERT TO UNKNOWN.  PRINTER OUTPUT WILL BE SENT
415CCCCC TO FILE ON NON-PC SYSTEMS.
416      IF(IHOST1.EQ.'IBM-')THEN
417        IPRIST='OLD'
418      ELSE
419        IPRIST='UNKNOWN'
420      ENDIF
421      IPRIFO='FORMATTED'
422      IPRIAC='SEQUENTIAL'
423      IPRIRW='READWRITE'
424C
425      ILISNU=28
426CCCCC ILISNA='EDLIST.TEX'
427      INAME='EDLIST'
428      IF(IEDCAS.EQ.'LOWE')INAME='edlist'
429      NC=6
430CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ILISNA,IBUGIN)
431      CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ILISNA,IBUGIN)
432C
433CCCCC ILISST='UNKNOWN'
434      ILISST='OLD'
435      ILISFO='FORMATTED'
436      ILISAC='SEQUENTIAL'
437      ILISRW='READONLY'
438C
439      IMESNU=29
440CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386
441CCCCC IF(IHOST1.EQ.'IBM-')IMESNA='EDMESS.TEX'
442CCCCC IF(IHOST1.EQ.'IBM-')IMESNA='C:\FED\EDMESS.TEX'
443      INAME='EDMESS'
444      IF(IEDCAS.EQ.'LOWE')INAME='edmess'
445      NC=6
446      CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,IMESNA,IBUGIN)
447C
448CCCCC IMESST='UNKNOWN'
449      IMESST='OLD'
450      IMESFO='FORMATTED'
451      IMESAC='SEQUENTIAL'
452      IMESRW='READONLY'
453C
454      ISYSNU=30
455CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386
456CCCCC IF(IHOST1.EQ.'IBM-')ISYSNA='EDSYST.TEX'
457CCCCC IF(IHOST1.EQ.'IBM-')ISYSNA='C:\FED\EDSYST.TEX'
458      INAME='EDSYST'
459      IF(IEDCAS.EQ.'LOWE')INAME='edsyst'
460      NC=6
461      CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,ISYSNA,IBUGIN)
462C
463CCCCC ISYSST='UNKNOWN'
464      ISYSST='OLD'
465      ISYSFO='FORMATTED'
466      ISYSAC='SEQUENTIAL'
467      ISYSRW='READONLY'
468C
469      ILOGNU=31
470CCCCC ILOGNA='EDLOGI.TEX'
471CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386
472CCCCC IF(IHOST1.EQ.'IBM-')ILOGNA='EDLOGI.TEX'
473CCCCC IF(IHOST1.EQ.'IBM-')ILOGNA='C:\FED\EDLOGI.TEX'
474      INAME='EDLOGI'
475      IF(IEDCAS.EQ.'LOWE')INAME='edlogi'
476      NC=6
477CCCCC FEBRUARY 1995.  FOR PC, EDLOGI IN FED DIRECTORY.  FOR NON-PC,
478CCCCC GET EDLOGI FROM CURRENT DIRECTORY (TO ALLOW USER TO CHANGE).
479      IF(IHOST1.EQ.'IBM-')THEN
480      CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,ILOGNA,IBUGIN)
481      ELSE
482      CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ILOGNA,IBUGIN)
483      ENDIF
484C
485CCCCC ILOGST='UNKNOWN'
486      ILOGST='OLD'
487      ILOGFO='FORMATTED'
488      ILOGAC='SEQUENTIAL'
489      ILOGRW='READONLY'
490C
491      INEWNU=32
492CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386
493CCCCC IF(IHOST1.EQ.'IBM-')INEWNA='EDNEWS.TEX'
494CCCCC IF(IHOST1.EQ.'IBM-')INEWNA='C:\FED\EDNEWS.TEX'
495CCCCC IF(IHOST1.EQ.'HONE')INEWNA='ednews.text'
496      INAME='EDNEWS'
497      IF(IEDCAS.EQ.'LOWE')INAME='ednews'
498      NC=6
499      CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,INEWNA,IBUGIN)
500C
501CCCCC INEWST='UNKNOWN'
502      INEWST='OLD'
503      INEWFO='FORMATTED'
504      INEWAC='SEQUENTIAL'
505      INEWRW='READONLY'
506C
507      IOPENU=33
508      IF(IHOST1.EQ.'IBM-')THEN
509        IOPENA='PRN'
510        IOPEST='OLD'
511      ELSE
512        IOPENA='PRINT.DAT'
513        IOPEST='UNKNOWN'
514      END IF
515      IOPEFO='FORMATTED'
516      IOPEAC='SEQUENTIAL'
517      IOPERW='READWRITE'
518C
519      ICOM='    '
520      ICOM2='    '
521      ICOMT='-999'
522      ICOMI=(-999)
523      ACOM=(-999.0)
524C
525C     ----------
526C
527      NUMCHA=10
528      ICHA(1)='A'
529      ICHA(2)='B'
530      ICHA(3)='C'
531      ICHA(4)='D'
532      ICHA(5)='E'
533      ICHA(6)='F'
534      ICHA(7)='G'
535      ICHA(8)='H'
536      ICHA(9)='I'
537      ICHA(10)='J'
538C
539      NUMLIN=4
540C
541      NUMROW=4
542      IPOINT(1)=1
543      IPOINT(2)=2
544      IPOINT(3)=3
545      IPOINT(4)=4
546C
547      ILOCC1(1)=1
548      ILOCC1(2)=4
549      ILOCC1(3)=6
550      ILOCC1(4)=8
551C
552      NUMCPL(1)=3
553      NUMCPL(2)=2
554      NUMCPL(3)=2
555      NUMCPL(4)=3
556C
557      ICURLN=1
558C
559      IEOF='NO'
560      IECHSW='OFF'
561      ILCSW='OFF'
562C
563      NUMCOM=0
564CCCCC MAXCMN=100   JULY 1993
565      DO310I=1,MAXCMN
566      ICOM3(I)='    '
567      ICOM4(I)='    '
568      ICOM5(I)='                              '
569      NCOM5(I)=0
570  310 CONTINUE
571C
572C     THE INTEGER VARIABLE ISEQNU IS THE CURRENT SEQUENCE NUMBER
573C     THAT IS USED IN THE CHANGE COMMAND
574C     TO DO AUTOMATIC SEQUENCING
575C     AS IN     LS XXXXXX
576C
577      ISEQNU=1
578      ICSEQN='1         '
579      NCSEQN=1
580C
581      IPRISW='OFF'
582C
583CCCCC THE FOLLOWING LINE WAS ADDED JULY 1992
584C
585      STOPSW='NO'
586C
587C     ----------
588C
589C               ********************************************************
590C               **  STEP 0.5--
591C               **  (FOR NBS UNIVAC COMPUTER ONLY)
592C               **  HAVE A DUMMY READ OF 1 LINE AFTER THE EDITOR  HEADER
593C               **  TO ABSORB AN EXTRANEOUS LINE GENERATED
594C               **  BY THE UNIVAC SYSTEM SOFTWARE WHEN FIRST ACCESSING T
595C               **  VIA @FED.
596C               ********************************************************
597C
598      IF(IHOST1.EQ.'UNIV')READ(IRD,501)
599  501 FORMAT(1X)
600C
601C               ****************************************************
602C               **  STEP 0.6--                                    **
603C               **  IF A SIGN-ON MESSAGE FILE                     **
604C               **  (CONSISTING OF CURRENT EDITOR   INFORMATION)  **
605C               **  EXISTS AT THIS COMPUTER INSTALLATION,         **
606C               **  WRITE OUT SUCH MESSAGES FOR THE ANALYST'S     **
607C               **  PERUSAL                                       **
608C               ****************************************************
609C
610      ISTEPN='0.6'
611      IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
612     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
613C
614      IF(IMESST.EQ.'NONE')GOTO690
615CCCCC IBUGS2='ON'
616      IF(IPASS.LE.1)CALL EDLIME
617  690 CONTINUE
618C
619C               ****************************
620C               **  STEP 11--             **
621C               **  READ IN BUG SWITCHES  **
622C               ****************************
623C
624CCCCC CALL EDERAS(IMANUF,IMODEL)     AUGUST 14, 1986
625C
626      IPASS=IPASS+1
627      IF(IPASS.GE.2)GOTO1190
628C
629CCCCC IBUGED='ON'
630CCCCC IBUGE2='ON'
631CCCCC IBUGE3='ON'
632CCCCC IBUGMA='ON'
633C
634 1190 CONTINUE
635C
636C               **************************************
637C               **  STEP 12--                       **
638C               **  READ IN FILE NAME TO BE EDITED  **
639C               **  AND DETERMINE STATUS OF FILE    **
640C               **************************************
641C
642CCCCC THE FOLLOWING SECTION WAS REWRITTEN JULY 1992
643CCCCC NUMCFI=80
644CCCCC IF(IHOST1.EQ.'VAX')GOTO1220
645CCCCC GOTO1223
646C
647C1220 CONTINUE
648CCCCC IF(IHOST1.EQ.'VAX'.AND.IPASS.EQ.1)CALL EDGETF(IORINA)
649CCCCC IF(IPASS.EQ.1)GOTO1229
650CCCCC WRITE(ICOUT,1221)
651C1221 FORMAT('NAME OF FILE TO BE EDITED = ?')
652CCCCC READ(IRD,1222)IORINA
653C1222 FORMAT(A80)
654CCCCC GOTO1229
655C
656      NUMCFI=80
657C
658      IF(IHOST1.EQ.'VAX')THEN
659         IF(IPASS.EQ.1)THEN
660            CALL EDGETF(IORINA)
661            GOTO1229
662         ENDIF
663         WRITE(ICOUT,1221)
664 1221    FORMAT('NAME OF FILE TO BE EDITED = ?')
665         CALL EDWRST('EDMAI2')
666         READ(IRD,1222)IORINA
667 1222    FORMAT(A80)
668         GOTO1229
669      ENDIF
670C
671CCCCC THE FOLLOWING SECTION IS FOR NON-VAX (ESPECIALLY IBM-PC)
672CCCCC THE FOLLOWING SECTION (TO 1229 CONTINUE) WAS CHANGED MAY 1990
673CCCCC THE FOLLOWING SECTION WAS CHANGED JULY 1992
674C
675      IF(ISOURC.EQ.'SUBR')THEN
676         IORINA=IEDINA
677      ENDIF
678C
679      IF(ISOURC.EQ.'FILE')THEN
680         IOUNIT=ITEMNU
681         IFILE=ITEMNA
682         ISTAT=ITEMST
683         IFORM=ITEMFO
684         IACCES=ITEMAC
685         IREWR=ITEMRW
686         ISUBN0='MAIN'
687         IERRFI='NO'
688C
689         CALL EDINFI(IFILE,IEXIST,ISUBN0,IERRFI)
690CCCCC    INQUIRE(FILE=IFILE,EXIST=ILEXIS,IOSTAT=IOS)
691         IF(IEXIST.EQ.'YES')GOTO1224
692         GOTO1226
693C
694 1224    CONTINUE
695CCCCC    WRITE(ICOUT,777)IEXIST
696CC777    FORMAT('IEXIST = ',A4)
697         CALL EDOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IREWR,ISUBN0,
698     1               IERRFI)
699         READ(IOUNIT,1225)IORINA
700 1225    FORMAT(A80)
701CCCCC    WRITE(ICOUT,778)IORINA
702CC778    FORMAT('FILE = ',A80)
703         CALL EDCLFI(IOUNIT,IENDFI,IREWIN)
704         IF(IORINA(1:4).EQ.'    ')GOTO1226
705         GOTO1229
706 1226    CONTINUE
707         WRITE(ICOUT,1227)
708 1227    FORMAT('NAME OF FILE TO BE EDITED = ?')
709         CALL EDWRST('EDMAI2')
710         READ(IRD,1228)IORINA
711 1228    FORMAT(A80)
712         GOTO1229
713      ENDIF
714C
715 1229 CONTINUE
716C
717      DO1235I=1,NUMCFI
718      IREV=NUMCFI-I+1
719      IF(IORINA(IREV:IREV).NE.' ')GOTO1239
720 1235 CONTINUE
721      IREV=0
722 1239 CONTINUE
723      NUMCFI=IREV
724C
725      ITEMP=IORIST
726      IORIST='UNKNOWN'
727      ID='ORIG'
728      CALL EDREFW(ID)
729      IORIST=ITEMP
730      NUMLOR=NUMLIN
731C
732CCCCC ID='SAVE'
733CCCCC CALL EDWRWF(ID)
734C
735CCCCC WRITE(ICOUT,1241)IORINA
736C1241 FORMAT('FILE              = ',A80)
737      WRITE(ICOUT,1241)(IORINA(I:I),I=1,NUMCFI)
738 1241 FORMAT('FILE              = ',80A1)
739      CALL EDWRST('EDMAI2')
740CCCCC WRITE(ICOUT,1242)IORIST
741C1242 FORMAT('FILE STATUS       = ',A4)
742      WRITE(ICOUT,1243)NUMLIN
743 1243 FORMAT('NUMBER OF LINES   = ',I8)
744      CALL EDWRST('EDMAI2')
745C
746CCCCC WRITE(ICOUT,999)
747  999 FORMAT(1X)
748CCCCC WRITE(ICOUT,1251)
749C1251 FORMAT('YOU ARE IN EDIT MODE--')
750      WRITE(ICOUT,1251)
751 1251 FORMAT('MODE (EDIT/INPUT) = EDIT')
752      CALL EDWRST('EDMAI2')
753CCCCC WRITE(ICOUT,1252)
754C1252 FORMAT('    TO TOGGLE INTO    INPUT MODE, ENTER      INPUT')
755CCCCC WRITE(ICOUT,1253)
756C1253 FORMAT('    TO TOGGLE BACK TO EDIT  MODE, ENTER      EDIT')
757CCCCC WRITE(ICOUT,1254)
758C1254 FORMAT('FOR GENERAL ON-LINE ASSISTANCE,   ENTER      HELP')
759CCCCC WRITE(ICOUT,999)
760C
761      NUMARG=0
762      CALL EDPRIN
763C
764C               **********************************************
765C               **  STEP 13--                               **
766C               **  OPEN THE COMMAND-SAVE (= JOURNAL) FILE  **
767C               **********************************************
768C
769      ISTEPN='13'
770      IF(IBUGFI.EQ.'ON'.OR.ISUBRO.EQ.'CALL')
771     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
772C
773      IOUNIT=ICOMNU
774      IFORM=ICOMFO
775      IFILE=ICOMNA
776      ISTAT=ICOMST
777      IACCES=ICOMAC
778      IREWR=ICOMRW
779      ISUBN0='MAIN'
780      IERRFI='NO'
781C
782      IF(IORINA.NE.ICOMNA.AND.IORINA.NE.ISAVNA)
783     1CALL EDOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IREWR,ISUBN0,IERRFI)
784C
785C               *************************************************************
786C               **  STEP 14--                                              **
787C               **  GENERATE A COMMAND STATEMENT (AND THEN EXECUTE IT)     **
788C               **  WHICH STATES THAT WE SHOULD    CALL EDSYST.TEX         **
789C               **  (THIS ALLOWS US TO EXECUTE A SYSTEM "LOGIN" FILE       **
790C               **  WHEN SIGNING ONT THE EDITOR WHICH IN TURN ALLOWS       **
791C               **  AN IMPLEMENTORTO EASILY TAILOR THE EDITOR              **
792C               **  FOR AN INDIVIDUAL SITE).                               **
793C               *************************************************************
794C
795      ISTEPN='14'
796      IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
797     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
798C
799      ICTEMP(1:5)='CALL '
800      ICTEMP(6:85)=ISYSNA(1:80)
801      NCTEMP=85
802      IF(IPASS.LE.1)CALL EDCOST(ICTEMP,NCTEMP)
803      IEXEIM='YES'
804      IEXESL='YES'
805      GOTO2300
806C
807C               *************************************************************
808C               **  STEP 15--                                              **
809C               **  GENERATE A COMMAND STATEMENT (AND THEN EXECUTE IT)     **
810C               **  WHICH STATES THAT WE SHOULD    CALL EDLOGI.TEX         **
811C               **  (THIS ALLOWS US TO EXECUTE A USER "LOGIN" FILE         **
812C               **  WHEN SIGNING ONTO THE EDITOR WHICH IN TURN ALLOWS      **
813C               **  A USER TO EASILY TAILOR THE EDITOR                     **
814C               *************************************************************
815C
816 1500 CONTINUE
817      ISTEPN='15'
818      IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
819     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
820C
821      IOUNIT=ILOGNU
822      IFORM=ILOGFO
823      IFILE=ILOGNA
824      ISTAT=ILOGST
825      IACCES=ILOGAC
826      IREWR=ILOGRW
827      ISUBN0='MAIN'
828      IERRFI='NO'
829C
830      CALL EDINFI(IFILE,IEXIST,ISUBN0,IERRFI)
831      IF(IERRFI.EQ.'YES')GOTO1590
832      IF(IEXIST.EQ.'NO')GOTO1590
833C
834      ICTEMP(1:5)='CALL '
835      ICTEMP(6:85)=ILOGNA(1:80)
836      NCTEMP=85
837      IF(IPASS.LE.1)CALL EDCOST(ICTEMP,NCTEMP)
838      IEXEIM='YES'
839      GOTO2300
840C
841 1590 CONTINUE
842C
843C               **************************
844C               **  STEP 21--           **
845C               **  WRITE OUT A PROMPT  **
846C               **************************
847C
848 2100 CONTINUE
849      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN
850         WRITE(ICOUT,999)
851         CALL EDWRST('EDMAI2')
852         WRITE(ICOUT,2101)
853 2101    FORMAT('----------START OF NEW CYCLE----------')
854         CALL EDWRST('EDMAI2')
855      ENDIF
856C
857      ISTEPN='21'
858      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
859     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
860      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN
861         WRITE(ICOUT,2102)ICCALL,ICXQT,ILCSW,IEOF,IPROSW
862 2102    FORMAT('ICCALL,ICXQT,ILCSW,IEOF,IPROSW = ',
863     1   A4,2X,A4,2X,A4,2X,A4,2X,A4)
864         CALL EDWRST('EDMAI2')
865      ENDIF
866C
867CCCCC IPRISW='OFF'
868      IALL='OFF'
869      IEOF='NO'
870C
871      IF(ICCALL.EQ.'ON')GOTO2190
872C
873      IF(IPROSW.EQ.'ON')GOTO2110
874      GOTO2190
875C
876 2110 CONTINUE
877      IF(IMODE.EQ.'EDIT')GOTO2120
878      GOTO2140
879C
880 2120 CONTINUE
881      IF(IHOST1.EQ.'VAX ')GOTO2130
882      IF(0.LE.ICURLN.AND.ICURLN.LE.9)THEN
883         WRITE(ICOUT,2121)ICURLN
884 2121    FORMAT(5X,I1,'> ')
885         CALL EDWRST('EDMAI2')
886      ENDIF
887      IF(10.LE.ICURLN.AND.ICURLN.LE.99)THEN
888         WRITE(ICOUT,2122)ICURLN
889 2122    FORMAT(4X,I2,'> ')
890         CALL EDWRST('EDMAI2')
891      ENDIF
892      IF(100.LE.ICURLN.AND.ICURLN.LE.999)THEN
893         WRITE(ICOUT,2123)ICURLN
894 2123    FORMAT(3X,I3,'> ')
895         CALL EDWRST('EDMAI2')
896      ENDIF
897      IF(1000.LE.ICURLN.AND.ICURLN.LE.9999)THEN
898         WRITE(ICOUT,2124)ICURLN
899 2124    FORMAT(2X,I4,'> ')
900         CALL EDWRST('EDMAI2')
901      ENDIF
902      IF(10000.LE.ICURLN.AND.ICURLN.LE.99999)THEN
903         WRITE(ICOUT,2125)ICURLN
904 2125    FORMAT(1X,I5,'> ')
905         CALL EDWRST('EDMAI2')
906      ENDIF
907      GOTO2190
908C
909 2130 CONTINUE
910      IF(0.LE.ICURLN.AND.ICURLN.LE.9)THEN
911         WRITE(ICOUT,2131)ICURLN
912 2131    FORMAT(5X,I1,'> ')
913         CALL EDWRST('EDMAI2')
914      ENDIF
915      IF(10.LE.ICURLN.AND.ICURLN.LE.99)THEN
916         WRITE(ICOUT,2132)ICURLN
917 2132    FORMAT(4X,I2,'> ')
918         CALL EDWRST('EDMAI2')
919      ENDIF
920      IF(100.LE.ICURLN.AND.ICURLN.LE.999)THEN
921         WRITE(ICOUT,2133)ICURLN
922 2133    FORMAT(3X,I3,'> ')
923         CALL EDWRST('EDMAI2')
924      ENDIF
925      IF(1000.LE.ICURLN.AND.ICURLN.LE.9999)THEN
926         WRITE(ICOUT,2134)ICURLN
927 2134    FORMAT(2X,I4,'> ')
928         CALL EDWRST('EDMAI2')
929      ENDIF
930      IF(10000.LE.ICURLN.AND.ICURLN.LE.99999)THEN
931         WRITE(ICOUT,2135)ICURLN
932 2135    FORMAT(1X,I5,'> ')
933         CALL EDWRST('EDMAI2')
934      ENDIF
935      GOTO2190
936C
937 2140 CONTINUE
938      ICURLP=ICURLN+1
939      IF(IHOST1.EQ.'VAX ')GOTO2140
940      IF(0.LE.ICURLP.AND.ICURLP.LE.9)THEN
941         WRITE(ICOUT,2141)ICURLP
942 2141    FORMAT(5X,I1,'>   ')
943         CALL EDWRST('EDMAI2')
944      ENDIF
945      IF(10.LE.ICURLP.AND.ICURLP.LE.99)THEN
946         WRITE(ICOUT,2142)ICURLP
947 2142    FORMAT(4X,I2,'>   ')
948         CALL EDWRST('EDMAI2')
949      ENDIF
950      IF(100.LE.ICURLP.AND.ICURLP.LE.999)THEN
951         WRITE(ICOUT,2143)ICURLP
952 2143    FORMAT(3X,I3,'>   ')
953         CALL EDWRST('EDMAI2')
954      ENDIF
955      IF(1000.LE.ICURLP.AND.ICURLP.LE.9999)THEN
956         WRITE(ICOUT,2144)ICURLP
957 2144    FORMAT(2X,I4,'>   ')
958         CALL EDWRST('EDMAI2')
959      ENDIF
960      IF(10000.LE.ICURLP.AND.ICURLP.LE.99999)THEN
961         WRITE(ICOUT,2145)ICURLP
962 2145    FORMAT(1X,I5,'>   ')
963         CALL EDWRST('EDMAI2')
964      ENDIF
965      GOTO2190
966
967C
968      IF(0.LE.ICURLP.AND.ICURLP.LE.9)THEN
969         WRITE(ICOUT,2151)ICURLP
970 2151    FORMAT(5X,I1,'>   ')
971         CALL EDWRST('EDMAI2')
972      ENDIF
973      IF(10.LE.ICURLP.AND.ICURLP.LE.99)THEN
974         WRITE(ICOUT,2152)ICURLP
975 2152    FORMAT(4X,I2,'>   ')
976         CALL EDWRST('EDMAI2')
977      ENDIF
978      IF(100.LE.ICURLP.AND.ICURLP.LE.999)THEN
979         WRITE(ICOUT,2153)ICURLP
980 2153    FORMAT(3X,I3,'>   ')
981         CALL EDWRST('EDMAI2')
982      ENDIF
983      IF(1000.LE.ICURLP.AND.ICURLP.LE.9999)THEN
984         WRITE(ICOUT,2154)ICURLP
985 2154    FORMAT(2X,I4,'>   ')
986         CALL EDWRST('EDMAI2')
987      ENDIF
988      IF(10000.LE.ICURLP.AND.ICURLP.LE.99999)THEN
989         WRITE(ICOUT,2155)ICURLP
990 2155    FORMAT(1X,I5,'>   ')
991         CALL EDWRST('EDMAI2')
992      ENDIF
993      GOTO2190
994C
995 2190 CONTINUE
996C
997C               ********************************
998C               **  STEP 22--                 **
999C               **  READ IN A COMMAND LINE.   **
1000C               **  DETERMINE WHERE ITS LAST  **
1001C               **  NON-BLANK CHARACTER IS.   **
1002C               ********************************
1003C
1004      ISTEPN='22'
1005      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1006     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1007      IWIDTH=80
1008      DO2205I=1,IWIDTH
1009      IANS(I)=' '
1010 2205 CONTINUE
1011C
1012      IF(ICXQT.EQ.'ON')GOTO2210
1013      IF(ICCALL.EQ.'ON')GOTO2220
1014      IF(TCMENU.EQ.'ON')GOTO2230
1015      GOTO2280
1016C
1017 2210 CONTINUE
1018      ISTEPN='22.1'
1019      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1020     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1021      IWIDTH=(-999)
1022      IF(IXQT.EQ.1)IWIDTH=NCHH1
1023      IF(IXQT.EQ.2)IWIDTH=NCHH2
1024      IF(IXQT.EQ.3)IWIDTH=NCHH3
1025      IF(IXQT.EQ.4)IWIDTH=NCHH4
1026      IF(IXQT.EQ.5)IWIDTH=NCHH5
1027      IF(IXQT.EQ.6)IWIDTH=NCHH6
1028      IF(IXQT.EQ.7)IWIDTH=NCHH7
1029      IF(IXQT.EQ.8)IWIDTH=NCHH8
1030      IF(IXQT.EQ.9)IWIDTH=NCHH9
1031      IF(IXQT.EQ.10)IWIDTH=NCHH10
1032      IF(IWIDTH.LE.0)GOTO2219
1033      DO2211I=1,IWIDTH
1034      IF(IXQT.EQ.1)IANS(I)=IHOLS1(I:I)
1035      IF(IXQT.EQ.2)IANS(I)=IHOLS2(I:I)
1036      IF(IXQT.EQ.3)IANS(I)=IHOLS3(I:I)
1037      IF(IXQT.EQ.4)IANS(I)=IHOLS4(I:I)
1038      IF(IXQT.EQ.5)IANS(I)=IHOLS5(I:I)
1039      IF(IXQT.EQ.6)IANS(I)=IHOLS6(I:I)
1040      IF(IXQT.EQ.7)IANS(I)=IHOLS7(I:I)
1041      IF(IXQT.EQ.8)IANS(I)=IHOLS8(I:I)
1042      IF(IXQT.EQ.9)IANS(I)=IHOLS9(I:I)
1043      IF(IXQT.EQ.10)IANS(I)=IHOL10(I:I)
1044 2211 CONTINUE
1045 2219 CONTINUE
1046      ICXQT='OFF'
1047      IXQT=(-999)
1048      GOTO2290
1049C
1050 2220 CONTINUE
1051      ISTEPN='22.2'
1052      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1053     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1054      READ(ICALNU,2221,END=2225)(IANS(I),I=1,IWIDTH)
1055 2221 FORMAT(240A1)
1056      GOTO2290
1057C
1058 2225 CONTINUE
1059      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1060     1WRITE(ICOUT,2226)
1061 2226 FORMAT('-----AN END OF FILE WAS ENCOUNTERED-----')
1062      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1063      ISTEPN='2225'
1064      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1065     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1066      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1067     1WRITE(ICOUT,2227)ICCALL,ICXQT,ILCSW,IEOF,IPROSW
1068 2227 FORMAT('ICCALL,ICXQT,ILCSW,IEOF,IPROSW = ',
1069     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
1070      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1071      IEOF='YES'
1072CCCCC REWIND ICALNU
1073CCCCC CLOSE(UNIT=ICALNU)
1074      IOUNIT=ICALNU
1075      IENDFI='OFF'
1076      IREWIN='ON'
1077      CALL EDCLFI(IOUNIT,IENDFI,IREWIN)
1078C
1079      ICCALL='OFF'
1080      IF(IEXESL.EQ.'YES')GOTO2228
1081      GOTO2229
1082 2228 CONTINUE
1083      IEXESL='DONE'
1084      GOTO1500
1085 2229 CONTINUE
1086      IF(ILCSW.EQ.'EXMA')GOTO4100
1087      GOTO2100
1088C
1089CCCCC THE FOLLOWING SECTION WAS ADDED (FOR GUI/MENU)   MAY 1993
1090 2230 CONTINUE
1091      ISTEPN='22.3'
1092      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1093     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1094CTURB CALL TCGECO(IB,NUMCHA,IBUGE2,ISUBRO)
1095      IWIDTH=NUMCHA
1096      IF(NUMCHA.LE.0)GOTO2239
1097      DO2231I=1,NUMCHA
1098      IANS(I)=IB(I:I)
1099 2231 CONTINUE
1100 2239 CONTINUE
1101      GOTO2290
1102C
1103 2280 CONTINUE
1104      ISTEPN='22.8'
1105      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1106     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1107C
1108CCCCC WRITE(IPR,777)LOOPCT
1109CC777 FORMAT('FROM EDMAI2--LOOPCT = ',I8)
1110      IF(LOOPCT.GE.1)THEN
1111         DO2281I=1,LOOPIW
1112            IANS(I)=LOOPST(I:I)
1113 2281    CONTINUE
1114         LOOPCT=LOOPCT-1
1115      ELSE
1116         READ(IRD,2282,END=2285)(IANS(I),I=1,IWIDTH)
1117 2282    FORMAT(240A1)
1118      ENDIF
1119C
1120      GOTO2290
1121 2285 CONTINUE
1122      WRITE(ICOUT,2286)
1123 2286 FORMAT('-----AN END OF FILE WAS ENCOUNTERED-----')
1124      CALL EDWRST('EDMAI2')
1125      IF(IMODE.EQ.'INPU')CALL EDEDIT
1126      GOTO2100
1127C
1128 2290 CONTINUE
1129C
1130C               *********************************
1131C               **  STEP 22A--                 **
1132C               **  SAVE THE COMMAND LINE      **
1133C               *********************************
1134C
1135      IF(IORINA.NE.ICOMNA.AND.IORINA.NE.ISAVNA)
1136     1WRITE(ICOMNU,2291)(IANS(I),I=1,IWIDTH)
1137 2291 FORMAT(80A1)
1138C
1139CCCCC THE FOLLOWING SECTION WAS ADDED (FOR GUI/MENU)   MAY 1993
1140C               **************************************************
1141C               **  STEP 22B--                                  **
1142C               **  WRITE OUT (= APPEND) THE COMMAND LINE       **
1143C               **  TO A COMPLETE COMMAND LOG FILE              **
1144C               **  SO AS TO ALLOW SCROLLING ON THE C-SIDE.     **
1145C               **************************************************
1146C
1147      IF(TCMENU.EQ.'ON')THEN
1148         DO2292I=1,80
1149            STRING(I:I)=IANS(I)
1150 2292    CONTINUE
1151CTURB    CALL TCWRCO(STRING,ISUBRO)
1152      ENDIF
1153C
1154C               *********************************
1155C               **  STEP 23--                  **
1156C               **  DEBLANK THE COMMAND LINE   **
1157C               *********************************
1158C
1159 2300 CONTINUE
1160      ISTEPN='23'
1161      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1162     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1163      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1164     1WRITE(ICOUT,2301)IWIDTH,IANS(1)
1165 2301 FORMAT('IWIDTH,IANS(1) = ',I8,2X,A1)
1166      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1167C
1168      IEXEIM='NO'
1169      CALL EDDEBL(IANS,IWIDTH)
1170C
1171C               ****************************************
1172C               **  STEP 24--                         **
1173C               **  TREAT THE REPEAT (R) COMMAND CASE **
1174C               ****************************************
1175
1176      ISTEPN='24'
1177      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1178     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1179      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1180     1WRITE(ICOUT,2401)IWIDTH,IANS(1)
1181 2401 FORMAT('IWIDTH,IANS(1) = ',I8,2X,A1)
1182      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1183C
1184      IF(IWIDTH.EQ.1.AND.IANS(1).EQ.'R')GOTO2410
1185      IF(IWIDTH.EQ.1.AND.IANS(1).EQ.'r')GOTO2410
1186      GOTO2420
1187C
1188 2410 CONTINUE
1189      DO2411I=1,240
1190      IANS(I)=IANSV(I)
1191 2411 CONTINUE
1192      IWIDTH=IWIDSV
1193      GOTO2490
1194C
1195 2420 CONTINUE
1196      DO2421I=1,240
1197      IANSV(I)=IANS(I)
1198 2421 CONTINUE
1199      IWIDSV=IWIDTH
1200      GOTO2490
1201C
1202 2490 CONTINUE
1203C
1204C               *********************************
1205C               **  STEP 25--                  **
1206C               **  ECHO BACK THE COMMAND LINE **
1207C               **  (IF CALLED FOR)            **
1208C               *********************************
1209C
1210      IF(IECHSW.EQ.'ON')CALL EDECCO
1211C
1212C               ******************************************************
1213C               **  STEP 26--                                       **
1214C               **  DECOMPOSE THE INSTRUCTION LINE INTO COMPONENTS  **
1215C               ******************************************************
1216C
1217      ICOMT='-999'
1218      CALL EDTYPE(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM)
1219C
1220C               *****************************************
1221C               **  STEP 27--                          **
1222C               **  CONVERT THE COMMAND AND ARGUMENTS  **
1223C               **  TO UPPER CASE                      **
1224C               *****************************************
1225C
1226      CALL EDUPP4(ICOM,ICOM)
1227      CALL EDUPP4(ICOM2,ICOM2)
1228C
1229      IF(NUMARG.LE.0)GOTO2790
1230      DO2700I=1,NUMARG
1231      IHARLC(I)=IHARG(I)
1232      IHARL2(I)=IHARG2(I)
1233      CALL EDUPP4(IHARG(I),IHARG(I))
1234      CALL EDUPP4(IHARG2(I),IHARG2(I))
1235 2700 CONTINUE
1236 2790 CONTINUE
1237C
1238C               *****************************************
1239C               **  STEP 41--                          **
1240C               **  TREAT THE LOCATE-CALL   CASE       **
1241C               *****************************************
1242C
1243 4100 CONTINUE
1244      ISTEPN='41'
1245      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1246     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1247      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1248     1WRITE(ICOUT,4101)ILCSW
1249 4101 FORMAT('ILCSW = ',A4)
1250      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1251      IF(ILCSW.EQ.'OFF')GOTO4105
1252      GOTO4106
1253 4105 CONTINUE
1254      IF(ICOM.EQ.'LC')GOTO4110
1255      GOTO4190
1256 4106 CONTINUE
1257      IF(ILCSW.EQ.'EXLO')GOTO4120
1258      IF(ILCSW.EQ.'CAMA')GOTO4130
1259      IF(ILCSW.EQ.'EXMA'.AND.IEOF.EQ.'NO')GOTO4140
1260      IF(ILCSW.EQ.'EXMA'.AND.IEOF.EQ.'YES')GOTO4150
1261      GOTO4190
1262C
1263 4110 CONTINUE
1264      ISTEPN='41.1'
1265      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1266     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1267      IWIDT0=IWIDTH
1268      DO4111I=1,IWIDTH
1269      IANS0(I)=IANS(I)
1270      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')
1271     1WRITE(ICOUT,4112)I,IANS(I),IANS0(I)
1272 4112 FORMAT('I,IANS(I),IANS0(I) = ',I8,2X,A1,2X,A1)
1273      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1274 4111 CONTINUE
1275      ILCSW='EXLO'
1276      GOTO4100
1277C
1278 4120 CONTINUE
1279      ISTEPN='41.2'
1280      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1281     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1282      IANS(1)='L'
1283      IANS(2)='O'
1284      IANS(3)=' '
1285      IWIDTH=2
1286      J=3
1287      IF(IWIDT0.LT.4)GOTO4128
1288      DO4121I=4,IWIDT0
1289      IF(IANS0(I).EQ.' ')IWIDTH=J
1290      IF(IANS0(I).EQ.' ')GOTO4128
1291      J=J+1
1292      IANS(J)=IANS0(I)
1293      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')
1294     1WRITE(ICOUT,4122)I,J,IANS0(I),IANS(J)
1295 4122 FORMAT('I,J,IANS0(I),IANS(J) = ',2I8,2X,A1,2X,A1)
1296      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1297 4121 CONTINUE
1298      IWIDTH=J
1299 4128 CONTINUE
1300      ICOM='LO'
1301      CALL EDLOCA
1302      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')
1303     1WRITE(ICOUT,4129)ICURLN,NUMLIN
1304 4129 FORMAT('ICURLN,NUMLIN = ',2I8)
1305      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1306      ILCSW='CAMA'
1307      IF(ICURLN.GT.NUMLIN)ILCSW='OFF'
1308      IF(ICURLN.GT.NUMLIN)GOTO2100
1309      GOTO4100
1310C
1311 4130 CONTINUE
1312      ISTEPN='41.4'
1313      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1314     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1315      IANS(1)='C'
1316      IANS(2)='A'
1317      IANS(3)='L'
1318      IANS(4)='L'
1319      IANS(5)=' '
1320      IARGUM=1
1321      J=5
1322      IF(IWIDT0.LT.4)GOTO4134
1323      DO4131I=4,IWIDT0
1324      IF(IANS0(I).EQ.' ')IARGUM=IARGUM+1
1325      IF(IARGUM.EQ.1)GOTO4131
1326      IF(IARGUM.EQ.2.AND.IANS0(I).EQ.' ')GOTO4131
1327      J=J+1
1328      IANS(J)=IANS0(I)
1329      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')
1330     1WRITE(ICOUT,4132)I,J,IANS0(I),IANS(J)
1331 4132 FORMAT('I,J,IANS0(I),IANS(J) = ',2I8,2X,A1,2X,A1)
1332      IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1333 4131 CONTINUE
1334 4134 CONTINUE
1335      IWIDTH=J
1336      ICOM='CALL'
1337      CALL EDCALL
1338C
1339      IF(IERROR.EQ.'YES'.AND.IEXESL.EQ.'YES')GOTO4135
1340      GOTO4136
1341 4135 CONTINUE
1342      IEXESL='DONE'
1343      GOTO1500
1344 4136 CONTINUE
1345      IF(IERROR.EQ.'YES')GOTO2100
1346      ILCSW='EXMA'
1347      GOTO2100
1348C
1349 4140 CONTINUE
1350      ISTEPN='41.5'
1351      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1352     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1353      GOTO4190
1354C
1355 4150 CONTINUE
1356      ISTEPN='41.6'
1357      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1358     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1359      IEOF='NO'
1360      ILCSW='EXLO'
1361      GOTO4100
1362C
1363 4190 CONTINUE
1364      ISTEPN='41.9'
1365      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1366     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1367C
1368C               *************************************************
1369C               **  STEP 61--                                  **
1370C               **  SEARCH FOR VARIOUS EDITOR INSTRUCTIONS     **
1371C               **  AND (IF FOUND) CARRY OUT THE INSTRUCTION.  **
1372C               *************************************************
1373C
1374      ISTEPN='61'
1375      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1376     1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2)
1377      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')
1378     1WRITE(ICOUT,6101)ILCSW
1379 6101 FORMAT('ILCSW = ',A4)
1380      IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2')
1381CCCCC IF(ICOM.EQ.'EXIT')GOTO9000
1382C
1383      IF(ICOM.EQ.'PP'.AND.IERASW.EQ.'ON')GOTO6110
1384      GOTO6115
1385 6110 CONTINUE
1386      ICOM='ERAS'
1387      ICOM2='E   '
1388      CALL EDSEUC
1389      IF(IFOUND.EQ.'NO')CALL EDERAS(IMANUF,IMODEL)
1390      ICOM='PP  '
1391      ICOM2='    '
1392      GOTO6119
1393 6115 CONTINUE
1394      CALL EDSEUC
1395      IF(IFOUND.EQ.'YES')GOTO6200
1396      GOTO6119
1397 6119 CONTINUE
1398C
1399      CALL EDSEAR(IMARK,ICOLL1,ICOLL2,IBLASW,ISHIFN,IEXEIM,
1400     1            ISEQNU,ICSEQN,NCSEQN,IPPLIN,IPPOFF,
1401     1            IERASW,IMANUF,IMODEL,
1402     1            ILPOFF,
1403     1            IHARLC,STOPSW)
1404CCCCC1IHARLC,IHARL2,STOPSW)
1405C
1406CCCCC THE FOLLOWING LINE WAS ADDED JULY 1992
1407      IF(STOPSW.EQ.'YES')GOTO9000
1408CCCCC IF(IEXEIM.EQ.'YES')ILCSW='EXMA'
1409      IF(IEXEIM.EQ.'YES')GOTO2300
1410      IF(IFOUND.EQ.'YES')GOTO6200
1411C
1412CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1990
1413CCCCC TO ALLOW FOR    Z   COMMAND = CALL Z.
1414CCCCC Z1 COMMAND = CALL Z1.    ...    Z5 COMMAND = CALL Z5.
1415      IF(IWIDTH.GE.3)GOTO6149
1416      IF(IWIDTH.LE.0)GOTO6149
1417      IF(IANS(1).EQ.'Z')GOTO6140
1418      GOTO6149
1419 6140 CONTINUE
1420      ICJUNK=' '
1421      IWJUNK=IWIDTH
1422      IF(IWIDTH.EQ.2)ICJUNK=IANS(2)
1423      IANS(1)='C'
1424      IANS(2)='A'
1425      IANS(3)='L'
1426      IANS(4)='L'
1427      IANS(5)=' '
1428      IANS(6)='Z'
1429      IANS(7)='.'
1430      IWIDTH=7
1431      IF(IWJUNK.EQ.2)IANS(7)=ICJUNK(1:1)
1432      IF(IWJUNK.EQ.2)IANS(8)='.'
1433      IF(IWJUNK.EQ.2)IWIDTH=8
1434      GOTO2300
1435 6149 CONTINUE
1436C
1437      WRITE(ICOUT,6181)
1438 6181 FORMAT('NO MATCH FOUND FOR COMMAND.')
1439      CALL EDWRST('EDMAI2')
1440      IF(IFOUND.EQ.'NO')WRITE(ICOUT,6182)(IANS(I),I=1,IWIDTH)
1441 6182 FORMAT('COMMAND LINE--',100A1)
1442      IF(IFOUND.EQ.'NO')CALL EDWRST('EDMAI2')
1443C
1444C               **************************************************
1445C               **  STEP 62--                                   **
1446C               **  LOOP BACK AND GET ANOTHER INSTRUCTION LINE  **
1447C               **************************************************
1448C
1449 6200 CONTINUE
1450CCCCC THE FOLLOWING COMPLETE SECTION WAS UPDATED APRIL 1990
1451CCCCC SO CAN SAY     EXRR JUNK.DAT     AS A SINGLE COMMAND
1452CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   JULY 1992
1453CCCCC IF(ICOM.EQ.'ER')GOTO6220
1454CCCCC IF(ICOM.EQ.'ERR')GOTO6230
1455      IF(ICOM.EQ.'EXR')GOTO6230
1456      IF(ICOM.EQ.'EXRR')GOTO6240
1457      IF(ICOM.EQ.'ABR')GOTO6230
1458      IF(ICOM.EQ.'ABRR')GOTO6240
1459      GOTO2100
1460C
1461CCCCC FEBRUARY 1995.  IF NO FILE NAME GIVEN, PUT IN INFINITE LOOP.
1462CCCCC IN THIS CASE, SET STOPSW TO ON.
1463      IF(NUMARG.LE.0)THEN
1464        STOPSW='ON'
1465        GOTO9000
1466      ENDIF
1467      DO6221I=1,77
1468      IP3=I+3
1469      IORINA(I:I)=IANS(IP3)
1470 6221 CONTINUE
1471      IORINA(78:80)='   '
1472      GOTO1229
1473C
1474 6230 CONTINUE
1475CCCCC IF(NUMARG.LE.0)GOTO1000
1476      IF(NUMARG.LE.0)THEN
1477        STOPSW='ON'
1478        GOTO9000
1479      ENDIF
1480      DO6231I=1,76
1481      IP4=I+4
1482      IORINA(I:I)=IANS(IP4)
1483 6231 CONTINUE
1484      IORINA(77:80)='    '
1485      GOTO1229
1486C
1487 6240 CONTINUE
1488CCCCC IF(NUMARG.LE.0)GOTO1000
1489      IF(NUMARG.LE.0)THEN
1490        STOPSW='ON'
1491        GOTO9000
1492      ENDIF
1493      DO6241I=1,75
1494      IP5=I+5
1495      IORINA(I:I)=IANS(IP5)
1496 6241 CONTINUE
1497      IORINA(76:80)='     '
1498      GOTO1229
1499C
1500C               *****************
1501C               **  STEP 90--  **
1502C               **  EXIT       **
1503C               *****************
1504C
1505 9000 CONTINUE
1506CCCCC STOP
1507CCCCC CALL EXIT(1)     COMMENTED OUT TO MAKE IT A SUBROUTINE  7/92
1508      RETURN
1509      END
1510