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