	SUBROUTINE XQTCMD(ICODE)
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
C SPREAD SHEET COMMAND PROCESSOR
C Created as a gift to the world by G. Everhart because our installation
C can't affort $4000 for a commercial one. PUBLIC DOMAIN.
C with thanks to the DECUS library which provided the calculator
C program on which this is based.
	INCLUDE 'VKLUGPRM.FTN'
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32 ! REAL ROWS, COLS
C	PARAMETER DRW = 8
C	PARAMETER DCL = 8 ! DISPLAY MAX ROWS, COLS.
C	PARAMETER RRCL = 1024
C PARAMETER RRCL=RRW*RCL
      PARAMETER CUP = 1, CUU = 2, CUD = 3, CUF = 4, CUB = 5, DECDWL = 6
     $, DECDHL = 7, DECRC = 8, DECSC = 9, DECSWL = 10, ED = 11, EL = 12
     $, SGR = 13, NEL = 14, SCS = 15, SM = 16, RM = 17, ANSI = 18
C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON
C SCREEN. ROW 0 IN DISPLAY IS THE 27 ACCUMULATORS A-Z AND %, WITH
C % BEING THE LAST-COMPUTED VALUE FROM THE CALC PROGRAM, WHICH
C KNOWS HOW TO ACCESS THE DATA BUT IS JUST PASSED COMMAND STRINGS
C FROM THE DISK BASED FILE HERE.
	LOGICAL*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	LOGICAL*1 LET1,LET2,FORM2(128),NMSH(80)
	COMMON/NMSH/NMSH
	REAL*8 XVBLS(RRWP,RCLP)
	INTEGER KPYBAK
	INTEGER*2 IOLVL
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	COMMON/IOLVL/IOLVL
C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
	DIMENSION FORM(128),FVLD(RRWP,RCLP)
	LOGICAL*1 DFE,FVWRK,FVWRK2
	DIMENSION DFE(12)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
C FVLD=2 = CONST NUMERIC ONLY, COMPUTED. =3, CONST, NEEDS CALC.
C
C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2
C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN.
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	INTEGER*2 ILNFG,ILNCT,RCF,NCEL
	COMMON/NCEL/NCEL
	LOGICAL*1 ILINE(106)
	COMMON/ILN/ILNFG,ILNCT,ILINE
	INTEGER*2 IC1POS,IC2POS
	COMMON/ICPOS/IC1POS,IC2POS
	LOGICAL*1 OARRY(100)
	INTEGER*2 OSWIT,OCNTR
	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	LOGICAL*1 AVBLS(100,27),VBLS(8,RRWP,RCLP)
	REAL*8 XAC,ZAC
	EQUIVALENCE(XAC,AVBLS(1,27)),(ZAC,AVBLS(1,26))
	REAL*8 XXAC,XYAC
	EQUIVALENCE(XXAC,AVBLS(1,24)),(XYAC,AVBLS(1,25))
	LOGICAL*1 ARGSTR(52,4)
	COMMON/ARGSTR/ARGSTR
C	EQUIVALENCE(ARGSTR(1,1),VBLS(1,1,1))
C USE VBLS ENTRIES THAT WOULD CORRESPOND TO THE UNUSED SPACE
C IN VBLS ARRAY FOR ACCUMULATORS A-Z TO HOLD UP TO 4 ARGUMENTS
C FROM A COMMAND < WHICH READS IN SPACE-DELIMITED ARGUMENTS.
C THIS WILL ALLOW INTERACTIVE ENTRY OF DATA AND AUTO
C SUBSTITUTION OF ARGUMENTS VIA THE EDit COMMAND.
	EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1))
	EQUIVALENCE(JVBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	COMMON/KLVL/KLVL
	LOGICAL*1 DEFVB(12)
	COMMON/DEFVBX/DEFVB
	INTEGER*2 FORMFG,RCFGX,PZAP,RCONE
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
C  AND VM INHIBITS. (SETS TO 1).
C
C DISPLAY ARRAY WILL KEEP A COPY OF VARIABLES DISPLAYED AND FORMATS
C USED LOCALLY WHICH DISPLAY ROUTINE CAN USE TO SEE WHAT ACTUALLY
C NEEDS TO BE REFRESHED ON SCREEN. DRWV AND DCLV ARE COLS, ROWS OF
C DISPLAY ACTUALLY USED FOR SCREEN.
	INTEGER*2 CWIDS(DRW)
C CWIDS IS WIDTHS IN CHARACTERS OF COLUMNS ON DISPLAY. NOTE THAT BECAUSE
C OF PECULIAR INVERSION WHICH I AM TOO LAZY TO CORRECT IT IS DIMENSIONED
C AS DRW NOT DCL.
	REAL*8 DVS(DRW,DCL)
	INTEGER*4 LDVS(2,DRW,DCL)
	EQUIVALENCE(LDVS(1,1,1),DVS(1,1))
	COMMON /FVLDC/FVLD
C	LOGICAL*1 DFMTS(10,DRW,DCL)
C 10 CHARACTERS PER ENTRY.
	COMMON/DSPCMN/DVS,CWIDS
C THISRW,THISCL = CURRENT DISPLAYED LOCS.
	INTEGER*2 THISRW,THISCL
C	LOGICAL*1 IBITMP(BRRCL)
C	COMMON/INITD/IBITMP
C FOLLOWING COMMON IS TO CONTROL "EXTERNAL" CALL OF XQTCMD
C TO ALLOW USE FROM INSIDE CELLS.
	LOGICAL*1 XTNCMD(80)
	INTEGER*2 XTCFG,XTNCNT,IPSET
	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C
	OSWIT=2
C ISSUE A PROMPT FOR COMMAND AND DO A COMMAND
C
C  COMMANDS INCLUDE:
C E = ENTER NUMBERS OR FORMULAS
C M = MOVE DIRECTION (1,2,3,4 = U,D,L,R)
C D = DISPLAY CHARACTERISTIC CHANGES
C
C DISPLAY ALTERING SUBCOMMANDS:
C  DL V1:V2 RN:M OR CN:M - DISPLAY VARIABLE RANGE V1:V2 AT DISPLAY
C  ROW OR COL N THRU M.
C  RN:M MEANS ACROSS A ROW ON DISPLAY STARTING AT DISPLAY COORD N,M
C  CN:M MEANS DOWN A DISPLAY COLUMN STARTING AT DISPLAY COORD N,M
C  DF V1:V2 [FORMAT]
C  SET FORMAT FOR DISPLAY OF V1 THRU V2 TO [FORMAT] (NOT INCL. [])
C  A OR L DESIGNATOR SAYS SHOW TEXT IN FORMULA BUFFER. ELSE SHOW
C  NUMBER VALUE AT THAT LOC.
C  DT V1:V2 F OR I - SET NUMERIC TYPE OF V1 THRU V2 TO FLOAT OR INT.
C  DW N,M - SET WIDTH OF COL. N TO M CHARS WIDE.
C  DB MC,MR - SET MAX COLS TO MC, MAX ROWS TO MR.
C
C V = VIEWSCREEN UPDATE. REDISPLAY EVERYTHING FROM SCRATCH.
C VF = VIEW BUT DISPLAY FORMULAS ALL LOCS.
C VM = DISABLE REDRAWING SCREEN UNTIL A V IS SEEN.
C C = COPY NUMBERS/FORMULAS/DISPLAY STUFF(FORMAT)/ALL/RELOCATING
C 1,2,3,4 = MOVE CURSOR UP,DOWN,LEFT,RIGHT 1 ROW/COL
C (THESE DO NOT INVALIDATE CALCULATION SO RECALCULATION IS NOT
C DONE FOR THESE COMMANDS.)
C F FILENAME/NNN  FILL SCREEN (DISPLAYED PART ONLY) FROM FILENAME,
C    SKIPPING NNN RECORDS FIRST IF CALLED FOR. /NNN PART OPTIONAL.
C  (SPLITS STUFF READ IN ACROSS COLUMNS CURRENTLY DEFINED AND
C   SETS FVLD FOR DISPLAY OF TEXT, NOT #S.)
C A[R/A] n [R/C] ADDS/SUBTRACTS (INSERTS/DELETES) n ROWS OR COLUMNS
C   AT CURENT LOCATION. AR/AA SELECTS RELOCATING/ABSOLUTE.
C R = RECALCULATE SHEET. RM = RECALCULATE MANUALLY ONLY (R RESETS)
C K = DROP INTO CALC CALCULATOR (*E RETURNS TO SHEET)
C L = LOCATE CURSOR (MOVE TO POSITION ON SHEET)
C (L VARIABLE IS THE COMMAND, AND IT LOCATES ORIGIN ON PHYSICAL
C SHEET. WILL ALSO MOVE CURSOR ON DISPLAY SHEET IF THAT CELL IS
C DISPLAYED, BUT OTHERWISE DOES NOT DISPLAY THE NUMBER.)
C Z = ZERO FORMULA/NUMBERS (OR ALL SHEET)
C  ZERO VARIABLE ZEROES THAT VARIABLE
C  ZERO VARIABLE1:VARIABLE2 ZEROES THAT RANGE (ROW OR COL)
C  ZERO * ZEROES ALL OF THE SHEET.
C X = EXIT (RETURNS TO OS)
C P = PUT NUMBERS TO FILE. ALWAYS GENERATES P#+nn#+mm forms based on
C current location.
C G = GET NUMBERS OUT OF FILE. USES CURRENT ORIGIN FROM L COMMAND OR 1,1
C TO ENTER NUMBERS (ALLOWS COMBINING DATA).
C W = WRITE SCREEN ON PRINTER (HARDCOPY FORMAT APPROX. AS DISPLAY.)
C OA VARIABLE = SET ORIGIN OF DISPLAY SHEET TO VARIABLE LOC IN
C  PHYSICAL SHEET (CLAMPED TO MAX. SIZE OF SHEET). STARTS AT R1,C1 OF
C  DISPLAY SHEET.
C OR VARIABLE = SET ORIGIN OF DISPLAY SHEET TO LOC'N OF VARIABLE IN
C  PHYSICAL SHEET. MODIFIES DISPLAY SHEET STARTING AT CURRENT DISPLAY
C  LOCATION RATHER THAN AT 1,1.
C 
C NOTE THAT N-ARY FUNCTIONS ARE FNAME[ARGS,ARGS,...]
C AND RANGES ARE CELL1:CELLN. MULTIPLE COMMANDS IN FORMULA ARE
C DELIMITED BY \ CHARACTER.
C
C RETURN CODES:
C IF ICODE=1, COMMAND JUST MOVES ON DISPLAY, SO NO NEED TO RECALCULATE
C THE ENTIRE SHEET.
C ICODE =-1 ==> REINITIALIZE DISPLAY DEFAULTS
C ICODE =2  ==> REDRAW WHOLE SCREEN
C ICODE =-2 ==> NEW SPREAD SHEET FILE SETUP.
C OTHER: ALL OK.

498	CONTINUE
	KLVL=1
	ICODE=3
C DEFAULT RETURN CODE SAYING ALL WELL
C FIRST DISPLAY CURRENT CELL AGAIN IN NORMAL.
	THISRW=DROW
	THISCL=DCOL
	FORM(1)=0
C GET IN THE CURRENT FORMAT WHEREVER WE ARE, EVEN IF NOT ON DISPLAY SHEET.
	IRRX=(PCOL-1)*RRW+PROW
	CALL WRKFIL(IRRX,FORM,0)
C	READ(7'IRRX)FORM
	IF(THISRW.LE.0.OR.THISCL.LE.0)GOTO 200
	N1=NRDSP(THISRW,THISCL)
	N2=NCDSP(THISRW,THISCL)
	IXLSTC=THISCL
	IXLSTR=THISRW
	IF(THISCL.GT.DCLV.OR.THISRW.GT.DRWV)GOTO 200
C REDRAW LAST DISPLAYED CELL IN NORMAL (I.E., NOT REVERSE) VIDEO.
C	IF(FVLD(N1,N2).EQ.0)GOTO 200
C ONLY REDRAW NUMBERS. DIRECT DISPLAY OR NOTHING GETS IGNORED.
	J=8
	IRRX=(N2-1)*RRW+N1
C ADD 6 COLS FOR LABELS
	DO 1 M1=1,DROW
C FIND DISPLAY COLUMN TO USE
1	J=J+CWIDS(M1)
	J=J-CWIDS(DROW)
C USE THISCL+1 TO LET 1ST ROW BE LABELS.
	ICCC=THISCL+2
C JVTINC = 1 IF VT100, 0 IF VT52
C SAVE PHYS COORDS BEING DISPLAYED NEXT. FVLD CAN BE TESTED FOR NUMERICS
C DIRECTLY, IF UVT100 NEEDS THAT ACCESS.
	IC1POS=N1
	IC2POS=N2
	IF(PZAP.NE.0)GOTO 3607
	CALL UVT100(CUP,ICCC,J+JVTINC) !SELECT ROW "THISCL", COL "J"
	CALL UVT100(SGR,7)
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IF(FVLD(1,1).EQ.0)WRITE(6,5538)
5538	FORMAT('>-<')
3607	CONTINUE
C WE CAN BE SURE THE COLUMN IS 3 WIDE OR MORE...
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IF(FVLD(1,1).EQ.0)GOTO 200
C	IRRX=(N2-1)*RRW+N1
C SELECT REVERSE VIDEO
	DO 5540 KKKK=1,100
5540	CMDLIN(KKKK)=32
	CALL WRKFIL(IRRX,FORM,0)
C	READ(7'IRRX)FORM
	IF(FORM(120).LE.0)GOTO 200
	IF(FVLD(1,1).LT.0.OR.FORMFG.NE.0)
     1  ENCODE(100,8201,CMDLIN)(FORM(II),II=1,100)
8201	FORMAT(128A1)
	IF(FORMFG.NE.0)GOTO 4320
	DO 6301 KKK=1,9
	KKKK=FORM(KKK+119)
C	KKKK=DFMTS(KKK,THISRW,THISCL)
6301	DFE(KKK+1)=MAX0(32,KKKK)
	DFE(11)=32
C 32 = ASCII SPACE
	DFE(1)='('
	DFE(12)=')'
	CALL TYPGET(N1,N2,TYPE(1,1))
	IF(TYPE(1,1).EQ.2.AND.FVLD(1,1).GT.0)
     1  ENCODE(100,DFE,CMDLIN)DVS(THISRW,THISCL)
	IF(TYPE(1,1).NE.2.AND.FVLD(1,1).GT.0)
     1  ENCODE(100,DFE,CMDLIN)LDVS(1,THISRW,THISCL)
C REDRAW THIS COL. WITH REVERSE VIDEO HERE.
4320	IF(PZAP.EQ.0)WRITE(6,9000)(CMDLIN(II),II=1,CWIDS(THISRW))
9000	FORMAT(128A1)
	IF(PZAP.EQ.0)CALL UVT100(SGR,0)
C NOTE THIS REDRAWS PREVIOUS COL. IN REVERSE VIDEO.
C NO CARRIAGE CTL
200	CONTINUE
	IF(PZAP.NE.0)GOTO 3608
	CALL UVT100(CUP,LDSPR,1)
	CALL UVT100(EL,2)
	IF(FORM(1).LE.0)GOTO 222
9092	FORMAT(I5,' Used. Curr=',64A1,50A1)
	WRITE(6,9092)NCEL,(FORM(II),II=1,109)
C3608	CONTINUE
222	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
C NOTE PROW IS ACROSS TOP, PCOL IS DOWN SIDE
C PROW GOES AS ID1, ALPHAS
C PCOL GOES AS ID2, NUMERICS
	CALL IN2AS(PROW,FORM)
C NOTE PCOL STARTS AT 2 FOR NORMAL SHEET VARIABLES. PCOL=1 IS FOR ACCUMULATORS
	CALL UVT100(SGR,0)
	WRITE(6,9001)(FORM(I),I=1,4),PCOL-1
9001	FORMAT(4A1,I4,'>')
3608	CONTINUE
	IF(XTCFG.NE.0)GOTO 3870
	IF(IOLVL.NE.5)READ(IOLVL,9002,END=510,ERR=510)CMDLIN
C FOR READING THE CONSOLE, WE NEED A QIO$ TO CAPTURE ESCAPE SEQUENCES.
	IF(IOLVL.EQ.5)CALL GETTTL(CMDLIN)
	GOTO 3871
3870	CONTINUE
	XTCFG=0
	DO 3872 I=1,XTNCNT
	CMDLIN(I)=XTNCMD(I)
3872	CONTINUE
C COPY IN EXTERNAL COMMAND AND LET IT BE EXECUTED. IT'S THE USER'S
C PROBLEM IF THE COMMAND REQUIRES STILL FURTHER INPUT...
C ALSO NULL OUT SOME DELIMITER CHARS AFTER THE COMMAND READ IN.
	CMDLIN(XTNCNT+1)=0
	CMDLIN(XTNCNT+2)=0
3871	CONTINUE
9002	FORMAT(132A1)
	CMDLIN(132)=0
	CMDLIN(131)=0
	CMDLIN(130)=0
C  SAVE CURRENT PHYS ROW, COL IN AC'S X AND Y
	XXAC=PROW
	XYAC=PCOL
C ZAP IN SPECIAL FUNCTION KEY REPLIES INTO NORMAL FORMS
	CALL CMDMUN(CMDLIN)
	DO 9048 I=1,129
	K=130-I
C START AT BACK OF LINE AND ZAP WHITESPACE BY NULL TERMINATOR
	IF(CMDLIN(K).GT.32)GOTO 9049
	CMDLIN(K)=0
C ALSO GET RID OF POSSIBLE TRAILING CR, LF.
9048	CONTINUE
9049	CONTINUE
C
C THIS GETS COMMAND LINE IN. NOW ACTON IT.
C REPOS'N TO OLD LINE NOW.
	CALL UVT100(CUP,LCMDR,1)
C
C THE FOLLOWING SECTION IMPLEMENTS THE ADDITIONAL FUNCTION OF
C JOURNALING: (DONE ON VAX ONLY SINCE SPACE REQUIREMENTS FOR FILE
C OPERATIONS MAY BE A PROBLEM ON PDP11'S).
C	Command +J FILENAME will record all remaining
C	line inputs at this point in it. (Assumes JNLFLG=0 initially)
C	Command +N closes journal file.
	K=K+1
	IF(CMDLIN(1).EQ.'+'.AND.CMDLIN(2).EQ.'J'.AND.JNLFLG.NE.1)
     1   GOTO 4290
	IF(CMDLIN(1).EQ.'+'.AND.CMDLIN(2).EQ.'N')GOTO 4292
	IF(JNLFLG.EQ.1)WRITE(10,9002)(CMDLIN(IV),IV=1,K)
	GOTO 4291
4292	CONTINUE
	CLOSE(UNIT=10)
	JNLFLG=0
	GOTO 9990
4290	CONTINUE
	JNLFLG=1
C	USE WHATEVER FILE NAME THE USER HAS SUPPLIED AFTER THE +J
C	FOR FILE TO JOURNAL ONTO. (NO MORE QUESTIONS NEEDED.)
	CALL ASSIGN(10,CMDLIN(3))
	GOTO 9990
4291	CONTINUE
C
C
C ALLOW COMMENTS IF LINE BEGINS WITH * (JUST LIKE CALC)
	IF(CMDLIN(1).EQ.'*')GOTO 9990
C
C * NEW ****************
C ADD PLACE TO PUT IN USER COMMANDS. DEFAULT IS NONE EXIST, DO NOTHING
	IGOTIT=0
	CALL USRCMD(CMDLIN,ICODE,IGOTIT)
C WHEN WE GET A COMMAND, SET IGOTIT TO 1 AND WE THEN PROCESS COMMAND NORMALLY
	IF(IGOTIT.EQ.1)GOTO 9990
C * NEW ****************
C
C COMMAND -PROMPT  WILL READ FROM LUN 5 TO ARGSTR
C TERMINATING WITH SPACES.
	IF(CMDLIN(1).NE.'-')GOTO 350
	ICODE=1
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,9000)(CMDLIN(IV),IV=2,50)
	READ(5,9000,END=510,ERR=510)FORM2
	II=1
	KK=1
	DO 351 KKK=1,128
C LOAD UP OUR ARGUMENTS IN ARGSTR(N,1) TO ARGSTR(N,4)
	ARGSTR(KK,II)=FORM2(KKK)
	KK=KK+1
	ARGSTR(KK,II)=0
	IF(KK.LT.52)GOTO 352
354	KK=1
	II=II+1
	IF(II.GT.4)GOTO 353
352	CONTINUE
	IF(FORM2(KKK).GT.32)GOTO 351
C ON SPACE, GO TO THE NEXT ARGUMENT. ALSO SPILL INTO
C THE NEXT ARGUMENT IF WE SEE NO SPACES AND JUST TRAIL ALONG.
	GOTO 354
351	CONTINUE
353	GOTO 9990
350	CONTINUE
C
C ALLOW PROGRAMMED "REWIND" OF INPUT COMMAND LINE ON
C COMMAND LINE BEGINNING WITH "<". MAKE IT CONDITIONAL
C BY SAYING THAT IF % IS NEGATIVE WE WON'T DO IT.
	IF(CMDLIN(1).NE.'<')GOTO 356
	ICODE=1
	IF(XAC.GT.0.)REWIND IOLVL
	GOTO 9990
356	CONTINUE
C
C HANDLE @FILE COMAND TO CHANGE TO INPUT OFF THAT FILE.
	IF(CMDLIN(1).NE.'@')GOTO 511
C WOW, A FILE. (OR AT LEAST SO WE HOPE).
	CALL ASSIGN(3,CMDLIN(2))
C USE FACT THAT WE JUST NULL TERMINATED THE FILENAME PART AND SET
C IT TO BE LUN 3.
	IOLVL=3
C NOW GO BACK FOR ANOTHER COMMAND...NO SENSE WASTING RECALC TIME SINCE
C NOTHING HAS REALLY HAPPENED YET.
C NOTE EVERY READ TO LUN 3 HAS EOF/ERROR CHECK TO GO TO 510 TO RESET
C TO LUN 5 INPUT AND CLOSE FILE WE OPENED ON 3.
	GOTO 498
511	CONTINUE
C
C AA n R, AA n C, AR n R, AR n C COMMANDS
C
	IF(CMDLIN(1).NE.'A')GOTO 8845
C ADD ROWS OR COLUMNS (OR REMOVE THEM) AT THE CURRENT PHYSICAL LOCATION
C WHERE AA MEANS ADD ABSOLUTE (NO RELOCATION), AR MEANS ADD RELOCATING
C (RELOCATE ALL VARIABLES BELOW), AND R OR C SAYS TO ADD/SEBTRACT ROWS
C OR COLUMNS.
C
C FIRST COLLECT THE ARGUMENTS TO THE FUNCTION.
	KM1=3
	KM2=10
	CALL GN(KM1,KM2,ICNT,CMDLIN)
C GETS THE NUMBER. IF NO NUMBER SEEN OR ZERO, RETURNS 0. IGNORE THEN.
	IF(ICNT.EQ.0)GOTO 9990
	ICR=0
C LOOK FOR THE R OR C
C START AT CMDLIN(4) TO PASS THE AR/AA AND THE NUMBER IF ANY.
	DO 8844 KKK=4,50
	IF(CMDLIN(KKK).EQ.'R')ICR=1
	IF(CMDLIN(KKK).EQ.'C')ICR=2
	IF(ICR.NE.0)GOTO 8846
C SKIP OUT ON FIRST ROW OR COLUMN DESIGNATOR SEEN
8844	CONTINUE
8846	CONTINUE
	IF(ICR.EQ.0)GOTO 9990
	ICODE=2
C NOW WE HAVE ALL ARGUMENTS. SET UP FOR THE COPY AND PARASITE THE
C LOGIC USED FOR THE CA OR CR COMMANDS. (NOTE THAT 2ND CHARACTER
C IS A OR R IN CMDLIN ALREADY SO THOSE COMMANDS' LOGIC WILL BE OK.)
	JRTR=PROW
	JRTC=PCOL
	IF(ICR.EQ.2)JRTC=1
	IF(ICR.EQ.1)JRTR=1
C RELOC THESHOLD IS PHYSICAL CURRENT POSITION.
	IF(ICR.EQ.1)GOTO 8843
C INSERT OR DELETE COLUMNS
C FIRST FIGURE OUT HOW MANY COLUMNS MUST BE MOVED RIGHT
	KD=RRW-PROW-IABS(ICNT)+1
	IF(KD.LE.0)GOTO 9990
C CAN'T MOVE 0 COLUMNS. DOESN'T MAKE SENSE.
	DO 8842 KR=1,KD
	IRA=RRW-KR+1
C IRA IS DESTINATION COLUMN IN EACH LOOP.
	IF(ICNT.LT.0)IRA=PROW-1+KR
C IRS IS SOURCE COLUMN
	IRS=RRW-KR+1-ICNT
	IF(ICNT.LT.0)IRS=PROW+KR-ICNT-1
C
	JDELT=RCL
C LOOP WE'LL CALL IS OVER ENTIRE ROWS, BUT ONLY DO ONE AT A TIME HERE
	JD1A=IRA
	JD1B=1
	ID1A=IRS
	ID2A=1
	I1IN=0
	I2IN=1
	JIN1=0
	JIN2=1
	ASSIGN 8840 TO KPYBAK
C CALL INTERNAL COPY-RANGE PROCEDURE INSIDE CA/CR LOGIC
	GOTO 8364
8840	CONTINUE
8842	CONTINUE
C
C NOW CLEAN UP THE REST OF FORMULAS IF THERE ARE ANY TO DO...
C MUST RELOCATE OTHER FORMULAE IF CMDLIN(2) IS R
	KX=PROW-1
	KY=RCL
C RELOCATE UPPER LEFT PART OF SHEET
C NOTE II1,II2,JJ1,JJ2,JRTR,JRTC ARE UNCHANGED FROM PRIOR CALL SO
C MAY BE USED... RELVBL ONLY CARES ABOUT RELATIVE MOTION ANYHOW...
3600	CONTINUE
	IF(CMDLIN(2).NE.'R'.OR.KX.LE.0.OR.KY.LE.0)GOTO 9990
	DO 3601 KK=1,KX
	DO 3601 KK2=1,KY
	CALL FVLDGT(KK,KK2,FVLD(1,1))
	IF(FVLD(1,1).NE.1)GOTO 3601
C ONLY RELOCATE FORMULAS, NOT TEXT OR NUMBERS (OR EMPTIES...)
	IRX=(KK2-1)*RRW+KK
	CALL WRKFIL(IRX,FORM,0)
C	READ(7'IRX)FORM
	CALL RELVBL(FORM,FORM2,II1,II2,JJ1,JJ2,JRTR,JRTC)
	CALL WRKFIL(IRX,FORM2,1)
C	WRITE(7'IRX)FORM2
3601	CONTINUE
	GOTO 9990
8843	CONTINUE
C ROW INSERT/DELETE
C AGAIN FIND HOW MANY ROWS TO MOVE.
	KD=RCL-PCOL-IABS(ICNT)+1
	IF(KD.LE.0)GOTO 9990
	DO 8839 KC=1,KD
C ICA = DESTINATION AND ICS IS SOURCE
	ICA=RCL-KC+1
	ICS=RCL-KC+1-ICNT
	IF(ICNT.GT.0)GOTO 8838
	ICA=PCOL-1+KC
	ICS=PCOL+KC-1-ICNT
8838	CONTINUE
C NOW CALL COPY LOOP AGAIN.
	JDELT=RRW
	JD1A=1
	JD1B=ICA
C DEST
	ID1A=1
	ID2A=ICS
C SOURCE
	I1IN=1
	I2IN=0
	JIN1=1
	JIN2=0
	ASSIGN 8836 TO KPYBAK
C CALL INTERNAL RANGE COPY PROCEDURE TO COPY A ROW
	GOTO 8364
8836	CONTINUE
8839	CONTINUE
	KX=RRW
	KY=PCOL-1
	GOTO 3600
8845	CONTINUE
C OA AND OR COMMANDS. SET DISPLAY SHEET MAPPING TO ORIGIN AS FOUND BY
C  VARIABLE, STARTING AT 1,1 OR (DROW,DCOL) FOR OA AND OR RESPECTIVELY.
	IF(CMDLIN(1).NE.'O')GOTO 650
C PROCESS COMMAND...
	LRO=1
	LCO=1
	IF(CMDLIN(2).EQ.'R')LRO=MAX0(1,DROW)
	IF(CMDLIN(2).EQ.'R')LCO=MAX0(1,DCOL)
	LRO=MIN0(LRO,DRW-1)
	LCO=MIN0(LCO,DCL-1)
C NOW HAVE CORRECT ORIGIN IN DISPLAY SHEET TO USE SET UP.
C GRAB VARIABLE ID.
	LA=INDEX(CMDLIN,32)
	IF(LA.GT.20)LA=3
	LE=40
	CALL VARSCN(CMDLIN,LA,LE,LSTCX,ID1,ID2,IVLD)
	IF(IVLD.EQ.0)GOTO 651
C NOW HAVE VARIABLE NAME AND LOCATION... CAN DO IT FINALLY.
C NOTE WE'RE GUARANTEED WE START OFF IN BOUNDS BUT MUST CHECK
C ALONG THE WAY TO BE SURE WE STAY THAT WAY.
	DO 652 IRO=LRO,DRWV
	DO 653 ICO=LCO,DCLV
C HERE CAN SET UP NRDSP AND NCDSP SUITABLY
	NRDSP(IRO,ICO)=MIN0(ID1+IRO-LRO,RRW)
	NCDSP(IRO,ICO)=MIN0(ID2+ICO-LCO,RCL)
653	CONTINUE
652	CONTINUE
	IF(DROW.LE.0.OR.DCOL.LE.0)GOTO 3924
	PROW=NRDSP(DROW,DCOL)
	PCOL=NCDSP(DROW,DCOL)
3924	CONTINUE
C FORCE REDRAW OF WHOLE SHEET.
	ICODE=2
651	GOTO 9990
650	CONTINUE
C F FILENAME/NNN
C READ IN TEXT FROM FILE NAMED AND SPREAD ACROSS DISPLAY SCREEN. SET
C DISPLAYED SCREEN INTO FVLD(NN)=-1 TO SHOW TEXT ONLY.
	IF(CMDLIN(1).NE.'F')GOTO 1740
	LA=INDEX(CMDLIN,32)
C PASS SPACE
	LB=INDEX(CMDLIN(LA+1),'/')
	LB=LB+LA
C LB= LOC OF / CHARACTER
	LB=MIN0(80,LB)
	IF(LB.LE.2)GOTO 1741
	CMDLIN(LB)=0
	CALL ASSIGN(4,CMDLIN(LA+1))
C THIS OUGHT TO OPEN THE FILE IF IT EXISTS..
C NOW IF THERE'S A NUMBER THERE, EXTRACT IT.
	LSKP=0
	IF(LB.GT.78.OR.LB.LE.5)GOTO 1743
	LAA=LB+1
	LAAA=LB+7
	CALL GN(LAA,LAAA,LSKP,CMDLIN)
1743	CONTINUE
C NOW SKIP THE LINES
	IF(LSKP.LE.0)GOTO 1744
	DO 1745 IV=1,LSKP
	READ(4,8201,END=1742,ERR=1742)FORM2
1745	CONTINUE
1744	CONTINUE
C NOW WE'RE READY TO READ IN THE STUFF.
	ICODE=2
	DO 1746 LA=1,DCLV
	DO 1751 IV=1,128
1751	FORM2(IV)=32
	READ(4,8201,END=1742,ERR=1742)FORM2
	IXC=0
	DO 1747 LB=1,DRWV
C DRWV = # ACROSS TOP...
C DCLV=LENGTH
	ID1=NRDSP(LB,LA)
	ID2=NCDSP(LB,LA)
C GET PHYSICAL SHEET COORDINATES AS ID1,ID2
C MUST THEN COPY CWIDS(LB) CHARS ONTO FILE...
	CALL FVLDST(ID1,ID2,-1)
C	FVLD(ID1,ID2)=-1
	IRX=(ID2-1)*RRW+ID1
	CALL WRKFIL(IRX,FORM,0)
C	READ(7'IRX)FORM
	FORM(119)=-1
	DO 1749 IVV=1,110
1749	FORM(IVV)=0
	DO 1748 IVV=1,CWIDS(LB)
	IXC=IXC+1
1748	FORM(IVV)=FORM2(IXC)
	CALL WRKFIL(IRX,FORM,1)
C	WRITE(7'IRX)FORM
1747	CONTINUE
1746	CONTINUE
1742	CLOSE(UNIT=4)
1741	GOTO 9990
1740	CONTINUE
	IF(CMDLIN(1).NE.'E')GOTO 8000
C ENTER COMMAND
C EN expression. expression may be numbers/text.
	LA=INDEX(CMDLIN,32)
	LA=LA+1
C SKIP SPACE AFTER "EN"
	IF(LA.GT.4)LA=4
	IF (LA.GE.100)GOTO 7901
	LE=132-LA
	LE=MIN0(110,LE)
	IRX=(PCOL-1)*RRW+PROW
C FIND WHERE IN FILE TO STORE.
	CALL WRKFIL(IRX,FORM,0)
C	READ(7'IRX)FORM
	IF(CMDLIN(2).EQ.'D')
     1   CALL SED(CMDLIN(LA),FORM,FORM2,ARGSTR,ZAC,110)
C IF COMMAND IS "ED <DELIM>STRING1<DELIM>STRING2<DELIM>" THEN
C  SUBSTITUTE STRING2 FOR STRING1 IN FORMULA, RETURN IT TO THE
C  COMMAND LINE, AND REENTER IT.
C  NOTE THAT THE STRINGS MAY CONTAIN &n FORMS WHERE 1-4 MEAN
C  ENTERED ARGUMENTS 1-4, 5 TREATS XAC AS A NUMBER, AND 6
C  TREATS ZAC AS A SINGLE CHARACTER (ZAC IS VARIABLE Z).
	DO 5133 II=1,110
5133	FORM(II)=0
	NALF=0
	NSG=-1
	NXNUM=3
	KSG=0
	N=1
2097	CONTINUE
	IF(N.GT.LE)GOTO 7902
C	DO 7902 N=1,LE
C LOOK FOR ALPHAS. IF WE FIND ANY, FLAG NOT NUMERIC
C NOTE @ INCLUDED SINCE COULD HAVE A *@3 COMMAND TO CALL 3.CMD
C AND REFER TO OTHER CELLS.
C THIS IS A RESTRICTION: COMMANDS TO CMND NEED TO HAVE ALPHAS
C SOMEWHERE OR THIS WILL BE FOOLED.
	IF(CMDLIN(LA).GE.'@'.AND.CMDLIN(LA).LE.'Z')NXNUM=1
	IF(CMDLIN(LA).EQ.'+'.OR.CMDLIN(LA).EQ.'-')NSG=1
	IF(CMDLIN(LA).EQ.'['.OR.CMDLIN(LA).EQ.'.')NSG=1
	IF(CMDLIN(LA).EQ.'(')NSG=1
	IF(CMDLIN(LA).EQ.'"')KSG=1
C ON SEEING THE _@V1,V2 CONSTRUCT, REPLACE WITH THE VARIABLE
C ADDRESSED BY V1,V2 (COL,ROW) BY NAME.
C ON SEEING THE _#V1 CONSTRUCT, UNPACK UP TO 8 CHARS OUT OF
C REAL*8 VARIABLE (PACKED BY MULTIPLYING BY 128 EARLIER).
C  IN EACH CASE, ADJUSTN AND LE TO CONTINUE APPROPRIATELY.
	IF(CMDLIN(LA).EQ.'_'.AND.CMDLIN(LA+1).EQ.'@')CALL
     1  SVBL(CMDLIN,LA,N,LE,FORM)
	IF(CMDLIN(LA).EQ.'_'.AND.CMDLIN(LA+1).EQ.'#')CALL
     1  SSTR(CMDLIN,LA,N,LE,FORM)
	FORM(N)=CMDLIN(LA)
	IF(CMDLIN(LA).GT.32)NALF=NALF+1
	LA=LA+1
C FAKE OUT DO LOOP SINCE SVBL OR SSTR MAY MUNG INDICES INSIDE IT
	N=N+1
	GOTO 2097
7902	CONTINUE
	IF(KSG.NE.0)NSG=-1
	FORM(110)=0
	IF(FORM(119).NE.0)GOTO 7903
C LEAVE DISPLAY INDICATOR ALONE IF SET BUT SET VBL OTHERWISE.
	FORM(119)=NSG*NXNUM
C SET NEG FOR DISPLAY OF FORMULA, NOT NUMBER. ALLOWS TEXT ENTRY.
C ASSUME FORMULA IF WE SEE + OR -
7903	CONTINUE
C FORCE FORM TO FOLLOW EDITS EVEN IF FORMAT/TYPE PRESET.
	IVVVV=FORM(119)
	IF(IVVVV.NE.0)FORM(119)=ISGN(IVVVV)*NXNUM
	IF(NALF.GT.0)CALL FVLDST(PROW,PCOL,FORM(119))
C	IF(NALF.GT.0)WRITE(7'IRX)FORM
	IF(NALF.GT.0)CALL WRKFIL(IRX,FORM,1)
	ASSIGN 7904 TO NBK
	GOTO 7905
C LOOK UP PROW, PCOL, LEAVE DISPLAY COORDS IN LR,LC
7905	CONTINUE
	DO 7906 LA1=1,DRW
	LR=LA1
	DO 7906 LA2=1,DCL
	LC=LA2
	IF(NRDSP(LA1,LA2).EQ.PROW.AND.NCDSP(LA1,LA2).EQ.PCOL)GOTO7907
7906	CONTINUE
C IF WE FALL OUT OF THE LOOP, WE DIDN'T FIND THE LOC; FLAG BY PUTTING 0'S.
	LR=0
	LC=0
	GOTO 7908
7907	CONTINUE
C ARRIVE HERE ON SUCCESS. LR, LC ALL SET UP.
7908	CONTINUE
	GOTO NBK
7904	CONTINUE
	IF(LR.EQ.0.OR.LC.EQ.0)GOTO 7901
	THISRW=LR
	THISCL=LC
C	ASCII 1,2,3,4 ARE VALUES 49,50,51,52 IN DECIMAL.
	IF(JMVFG.EQ.51)THISRW=MAX0(1,(THISRW-1))
	IF(JMVFG.EQ.52)THISRW=MIN0((THISRW+1),DRWV)
	IF(JMVFG.EQ.49)THISCL=MAX0(1,(THISCL-1))
	IF(JMVFG.EQ.50)THISCL=MIN0((THISCL+1),DCLV)
	DROW=THISRW
	DCOL=THISCL
	PROW=NRDSP(DROW,DCOL)
	PCOL=NCDSP(DROW,DCOL)
C FORCE REDO OF BOTH LAST AND NEW COLUMN BY DISPLAYER.
	DVS(LR,LC)=.0000000057
	DVS(DROW,DCOL)=.000000062
7901	GOTO 9990
8000	IF(CMDLIN(1).NE.'M')GOTO 8001
C MOVE COMMAND
C M1,M2,M3,M4 MOTION DIRECTION IS U,D,L,R
	JMVFG=CMDLIN(2)
C STORE CHARACTER AS MOVE FLAG
	ICODE=1
	GOTO 9990
8001	IF(CMDLIN(1).NE.'D')GOTO 8002
C DISPLAY COMMANDS
C
C DISPLAY SORT
C DSRA 1
C DS = CONSTANT KEYWORD
C R/C=ROW/COL (DISPLAY COORD #S)
C A/D=ASCENDING/DESCENDING ORDER
C NUMBER= DISPLAY COORD ROW/COL # TO SORT ON.
C SORTS NUMERIC FIELDS ONLY.
	IF(CMDLIN(2).NE.'S')GOTO 1752
	ICODE=2
C MUST REDRAW. WE DO WHOLESALE RELOCATIONS OF THINGS HERE.
C FIRST GET ARGUMENTS
	LAA=6
	LBB=15
	CALL GN(LAA,LBB,NBR,CMDLIN)
C THIS EXTRACTS THE NUMBER OF ROW/COL TO USE.
C DEFAULT IS PHYS, COL, ASCENDING
	IF(NBR.LE.0.OR.NBR.GT.MAX0(DRW,DCL))GOTO 9990
	SSIGN=1.
	IF(CMDLIN(4).EQ.'D')SSIGN=-1.
C SSIGN USED TO CONTROL ASCENDING/DESCENDING SORT (MULTIPLY BY IT)
C GET LENGTH TO GO THRU IN SORT
	IF(CMDLIN(3).EQ.'C')IDELTA=DCLV-1
	IF(CMDLIN(3).EQ.'R')IDELTA=DRWV-1
	I1IN=0
	I2IN=1
C GET PHYSICAL COORDINATES OF ROW/COL WE'RE SORTING ON.
	IF(CMDLIN(3).NE.'R')ID1=NRDSP(NBR,1)
	IF(CMDLIN(3).NE.'R')ID2=NCDSP(NBR,1)
	IF(CMDLIN(3).NE.'R')GOTO 1753
	ID1=NRDSP(1,NBR)
	ID2=NCDSP(1,NBR)
	I1IN=1
	I2IN=0
C HACK TO HANDLE ROW/COL ALIKE
1753	CONTINUE
	IFLIP=0
C IFLIP = BUBBLESORT FLAG WE CHANGED SOMETHING
C (USE SIMPLE MINDED SMALL SORT. TOO MUCH OVHD FOR BETTER ONE...NO ROOM)
	ID1A=ID1
	ID2A=ID2
C IGNORE CASE OF IDELTA=0... SHOULDN'T BE ANY WAY FOR THAT TO HAPPEN
	DO 1754 IV=1,IDELTA
C SORT HERE. IFLIP=1 IF WE INVERT ANYTHING.
C JUST COMPARE XVBLS...
C NOTE WE ASSUME A "NORMAL" TYPE DISPLAY, JUST RESET PHYSICAL STUFF.
	CALL XVBLGT(ID1A,ID2A,XAC)
	CALL XVBLGT(ID1A+I1IN,ID2A+I2IN,XVBLS(1,1))
	IF(XAC*SSIGN.LE.XVBLS(1,1)*SSIGN)GOTO 1755
C	IF((XVBLS(ID1A,ID2A)*SSIGN).LE.(SSIGN*XVBLS(ID1A+I1IN,
C     1 ID2A+I2IN)))GOTO 1755
C FLIP ASSIGNMENTS
C FLIP XVBLS NUMBERS TOO TO MAINTAIN SORT. WE RECOMPUTE ANYWAY..
C	XAC=XVBLS(ID1A+I1IN,ID2A+I2IN)
C	XVBLS(ID1A+I1IN,ID2A+I2IN)=XVBLS(ID1A,ID2A)
C	XVBLS(ID1A,ID2A)=XAC
	CALL XVBLST(ID1A+I1IN,ID2A+I2IN,XAC)
	CALL XVBLST(ID1A,ID2A,XVBLS(1,1))
	IFLIP=1
C SWAP ASSIGNMENTS OF DISPLAY STUFF IF IN RANGE
C OPERATES LIKE A SORTED OA COMMAND
C CURRENT PHYSICAL ROW IS ID2A (1...RCL LIMITS)
C AND PHYS COL IS ID1A.
	LDELTA=DRW-1
C FOR REASSIGNMENT, ROLE OF I1IN,I2IN CAN BE REVERSED...
	ID1B=1
C NOTE DISPLAY ID2 IS 1 LESS THAN PHYSICAL ONE. (AC'S)
	ID2B=ID2A-1
	IF(ID2B.LE.0)GOTO 1754
	IF(CMDLIN(3).NE.'R')GOTO 1756
C ROW...
	LDELTA=DCL-1
C ID1 SAME AS DISPLAY COORDS
	ID1B=ID1A
	ID2B=1
1756	CONTINUE
	DO 1757 IVV=1,LDELTA
C FLIP THE ROW/COL 1 ENTRY AT A TIME. JUST CHANGES ASSIGNMENTS.
	JD1=NRDSP(ID1B,ID2B)
	JD2=NCDSP(ID1B,ID2B)
	NRDSP(ID1B,ID2B)=NRDSP(ID1B+I1IN,ID2B+I2IN)
	NCDSP(ID1B,ID2B)=NCDSP(ID1B+I1IN,ID2B+I2IN)
	NRDSP(ID1B+I1IN,ID2B+I2IN)=JD1
	NCDSP(ID1B+I1IN,ID2B+I2IN)=JD2
	ID1B=ID1B+I2IN
	ID2B=ID2B+I1IN
1757	CONTINUE
C WE CAN ALWAYS FLIP SINCE WE STAY ON DISPLAY SHEET.
1755	CONTINUE
	ID1A=ID1A+I1IN
	ID2A=ID2A+I2IN
1754	CONTINUE
C DONE 1 PASS. IF ANYTHING CHANGED, TRY AGAIN.
	IF(IFLIP.NE.0)GOTO 1753
C DONE SORT AT END
	GOTO 9990
1752	CONTINUE
C
	IF(CMDLIN(2).NE.'L')GOTO 8101
C DL = DISPLAY LOCATE V1:V2 N:M
	ASSIGN 8103 TO IBACK
	GOTO 8104
C STRIP VARIABLE NAMES OFF CMD LINE STARTING AT POSITION 3
8104	LA=3
	LE=98
	L1=0
	CALL VARSCN(CMDLIN(1),LA,LE,LSTC,ID1A,ID2A,IVLD)
	L2=0
C L1,L2 = FLAGS VARIABLE 1,2 FOUND VALIDLY
	LA=LSTC+1
	LE=100-LA
	IF(LE.LE.0.OR.IVLD.LE.0)GOTO 8102
	L1=1
	IF(CMDLIN(LSTC).NE.':')GOTO 8102
C MUST SEE : BETWEEN NAMES. NO SPACES PERMITTED.
	CALL VARSCN(CMDLIN,LA,LE,LSTC,ID1B,ID2B,IVLD)
	IF(IVLD.LE.0)GOTO 8102
	L2=1
8102	CONTINUE
C NOTE THAT LSTC RETURNS AS CHARACTER AFTER VARIABLE LAST GRABBED IN INPUT LINE.
	GOTO IBACK
C NOW PICK UP RN:M OR CN:M (R=ROW,C=COL)
8103	CONTINUE
	IF(L1.LT.1)GOTO 8101
C INVALID UNLESS AT LEAST 1 VBL NAME SEEN.
	LA=LSTC+2
	RCF=0
	IF(CMDLIN(LSTC+1).EQ.'R')RCF=2
	IF(CMDLIN(LSTC+1).EQ.'C')RCF=1
	IF(RCF.EQ.0)GOTO 8101
	KM1=1
	CALL GN(KM1,LE,NUM1,CMDLIN(LA))
	IF(NUM1.EQ.0)GOTO 8101
	LE=INDEX(CMDLIN(LA),':')
	NUM2=0
	IF(LE.GT.100)GOTO 8101
	LA=LA+LE
	KM1=1
	KM8=8
	CALL GN(KM1,KM8,NUM2,CMDLIN(LA))
C NOW NUM1,NUM2 ARE DESIRED ROW/COL RANGE. NOW SET UP DISPLAY.
	IF(NUM2.EQ.0.OR.NUM2.GT.DCL)GOTO 8101
	IF(NUM1.GT.DRW)GOTO 8101
C ILLEGAL ROW/COL IS A NO-GO.
C R N:M MEANS STARTING AT COL N ROW M GOING L TO R.
C C N:M MEANS DOWN STARTING THERE. DISPLAY COORDS ASSUMED.
	IF(ID1A.NE.ID1B.AND.ID2A.NE.ID2B)GOTO 8101
C ONLY HANDLE ROWS OR COLS, NOT DIAGONALS.
C MUST BE A PHYS MTX ROW OR COL.
	LRINC=0
	LCINC=0
	IF(RCF.EQ.1)LRINC=1
	IF(RCF.EQ.2)LCINC=1
	ASSIGN 8108 TO JBACK
	GOTO 8109
C COPY DATA
8109	CONTINUE
	ICODE=2
	IDELT=1
	IF(L2.NE.0)IDELT=MAX0(IABS(ID1A-ID1B),IABS(ID2A-ID2B))+1
	I1IN=0
	I2IN=1
	IF(ID1A.EQ.ID1B)GOTO 8106
	I1IN=1
	I2IN=0
8106	CONTINUE
	ID1=ID1A
	ID2=ID2A
	GOTO JBACK
8108	CONTINUE
	ICODE=1
	IR=NUM1
	IC=NUM2
	DO 8105 NM=1,IDELT
C CLAMP TO MAX DISPLAY ARRAY
	IF(IR.GT.DRW.OR.IC.GT.DCL)GOTO 8105
	NRDSP(IR,IC)=ID1
	NCDSP(IR,IC)=ID2
	DVS(IR,IC)=-1.E24
C	THISRW=IR
C	THISCL=IC
	JRX=(ID2-1)*RRW+ID1
	CALL WRKFIL(JRX,FORM2,0)
C	READ(7'JRX)FORM2
C	DO 7104 N7=1,9
C7104	DFMTS(N7,IR,IC)=FORM2(N7+119)
C	DFMTS(10,IR,IC)=0
	IR=IR+LCINC
	IC=IC+LRINC
C NOTE REVERSAL FOR DISPLAY.
	ID1=ID1+I1IN
	ID2=ID2+I2IN
8105	CONTINUE
8101	CONTINUE
	IF(CMDLIN(2).NE.'F')GOTO 8111
C DF STUFF - SET FORMAT.
	ASSIGN 8112 TO IBACK
	GOTO 8104
8112	CONTINUE
C NOW HAVE VARIABLE ID'S SET UP
	IF(L1.LE.0)GOTO 8120
C MUST HAVE 1 OR MORE...
	ASSIGN 8113 TO JBACK
	GOTO 8109
C IDELT NOW SET UP. SET FORMATS UP NOW.
C FORMATS ARE IN [] BRACKETS. FIND THESE AND USE.
8113	CONTINUE
	ICODE=1
	LA=INDEX(CMDLIN,'[')+1
	LB=INDEX(CMDLIN,']')-1
	LDELT=LB-LA+1
	LDELT=MIN0(LDELT,8)
	DO 8114 LN=1,IDELT
C IDELT IS OVER VRBL LIST GIVEN. MAY BE 1 ONLY.
	IRRX=(ID2-1)*RRW+ID1
	CALL WRKFIL(IRRX,FORM,0)
C	READ(7'IRRX)FORM
	DO 7989 KKKK=1,8
7989	FORM(119+KKKK)=0
	DO 8115 LNA=1,LDELT
	FORM(LNA+119)=CMDLIN(LA-1+LNA)
	FORM(LNA+120)=0
8115	CONTINUE
	FORM(128)=0
	CALL FVLDGT(ID1,ID2,FVWRK)
	IVVVV=FVWRK
C	IVVVV=FVLD(ID1,ID2)
C	FVLD(ID1,ID2)=MAX0(1,IABS(IVVVV))
	IVVVV=MAX0(1,IABS(IVVVV))
	IF(CMDLIN(LA).EQ.'A'.OR.CMDLIN(LA).EQ.'L')IVVVV=
     1  MIN0(-1,-IABS(IVVVV))
	CALL FVLDST(ID1,ID2,IVVVV)
	IF(CMDLIN(LA).EQ.'I')CALL TYPSET(ID1,ID2,4)
	IF(CMDLIN(LA).EQ.'F'.OR.CMDLIN(LA).EQ.'E')
     1   CALL TYPSET(ID1,ID2,2)
	FORM(119)=IVVVV
C
C TO BE SURE WE DON'T FOUL UP THE FILE, TRY AN ENCODE ON THIS FORMAT
C PRIOR TO THE WRITE. THAT WAY IF WE BOMB, THE FILE WE HAVE DIRECT ACCESS
C DATA ON IS NOT CLOBBERED.
	IF(IVVVV.LE.0)GOTO 7990
	DO 7988 KKK=1,9
	KKKK=FORM(119+KKK)
7988	DFE(KKK+1)=MAX0(32,KKKK)
	DFE(1)='('
	DFE(12)=')'
	CALL TYPGET(N1,N2,TYPE(1,1))
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IF(TYPE(1,1).EQ.2.AND.FVLD(1,1).GT.0)
     1  ENCODE(100,DFE,FORM2)DVS(THISRW,THISCL)
	IF(TYPE(1,1).NE.2.AND.FVLD(1,1).GT.0)
     1  ENCODE(100,DFE,FORM2)LDVS(1,THISRW,THISCL)
7990	CONTINUE
	CALL WRKFIL(IRRX,FORM,1)
C	WRITE(7'IRRX)FORM
	DO 8116 NX1=1,DRW
	DO 8116 NX2=1,DCL
C LOCATE DISPLAY CELL IF ANY
	IF(NRDSP(NX1,NX2).EQ.ID1.AND.NCDSP(NX1,NX2).EQ.ID2)GOTO 8117
8116	CONTINUE
	GOTO 8118
8117	CONTINUE
	DVS(NX1,NX2)=-1.23E-12
8118	CONTINUE
	ID1=ID1+I1IN
	ID2=ID2+I2IN
8114	CONTINUE
8111	CONTINUE
	IF(CMDLIN(2).NE.'T')GOTO 8120
C DT DISPLAY TYPE
	ASSIGN 8121 TO IBACK
	GOTO 8104
C GET VBL NAMES
8121	ASSIGN 8122 TO JBACK
	GOTO 8109
8122	LA=LSTC+1
	IF(L1.LE.0)GOTO 8120
	KTYP=2
	IF(CMDLIN(LA).EQ.'I')KTYP=4
	ICODE=1
	DO 8123 LNA=1,IDELT
	CALL TYPSET(ID1,ID2,KTYP)
C	TYPE(ID1,ID2)=KTYP
	DO 8126 NX1=1,DRWV
	DO 8126 NX2=1,DCLV
	IF(NRDSP(NX1,NX2).EQ.ID1.AND.NCDSP(NX1,NX2).EQ.ID2)GOTO 8127
C FIND DISPLAY LOC IF ANY AND SET IT UP FOR REDRAW
8126	CONTINUE
	GOTO 8128
8127	CONTINUE
	DVS(NX1,NX2)=-1.211E-16
8128	CONTINUE
	ID1=ID1+I1IN
	ID2=ID2+I2IN
8123	CONTINUE
8120	CONTINUE
	IF(CMDLIN(2).NE.'W')GOTO 8130
C DW SETS COL WIDTH
	ASSIGN 8131 TO KBACK
	GOTO 8132
C GET 2 NUMBERS STARTING AT CMDLIN(4)
8132	CONTINUE
	KM1=1
	KM6=6
	CALL GN(KM1,KM6,NCL,CMDLIN(4))
	LA=INDEX(CMDLIN(4),',')
C COMMA MUST BE SEPARATOR
	LCWID=7
	IF(LA.GT.100)GOTO 8138
	KM1=1
	CALL GN(KM1,KM6,LCWID,CMDLIN(LA+4))
8138	GOTO KBACK
8131	CONTINUE
	ICODE=2
	NCL=MAX0(1,NCL)
	NCL=MIN0(NCL,DRW)
	LCWID=MAX0(1,LCWID)
	LCWID=MIN0(LCWID,110)
C COL WIDTH IS 3 TO 110 CHARS.
	IF(NCL.GT.0)CWIDS(NCL)=LCWID
8133	CONTINUE
8130	CONTINUE
	IF(CMDLIN(2).NE.'B')GOTO 8140
C DB = BOUNDS ON ROW,COL
	ASSIGN 8141 TO KBACK
	GOTO 8132
C PARASITE OTHER CODE TO GET DIGITS
8141	MC=NCL
	MR=LCWID
	MC=MIN0(MC,DRW)
	MR=MIN0(MR,DCL)
C CLAMP RANGE TO LEGAL
	IF(MC.GT.0)DRWV=MC
	IF(MR.GT.0)DCLV=MR
	ICODE=2
C REDRAW SCREEN WHEN BOUNDS CHANGE.
8140	CONTINUE
	GOTO 9990
8002	IF(CMDLIN(1).NE.'V')GOTO 8003
C VIEW REDRAW COMMAND
	PZAP=0
	FORMFG=0
	IF(CMDLIN(2).EQ.'F')FORMFG=1
	IF(CMDLIN(2).EQ.'M')PZAP=1
	ICODE=2
	GOTO 9990


8003	IF(CMDLIN(1).NE.'C')GOTO 8004
C COPY NUMBERS COMMAND
C COPY (NUMBERS,FORMAT,DISPLAY,ALL)
C CV=COPY VALUE, CD=COPY DISPLAY FMT, CF=COPY FORMULA, CA=COPY ALL
C Ca V1:V2 V3:V4 COPIES FIRST RANGE TO SECOND.
C
C COLLECT ARGS
	ASSIGN 8301 TO IBACK
	GOTO 8104
8301	CONTINUE
C NOW L1,L2 SAY IF VBLS(ID1A,ID2A) AND (ID1B,ID2B) EXIST
C COLLECT JD2A,JD2B. USE SIMILAR INTERNAL PROCEDURE CODE.
	IF(L1.LE.0)GOTO 8399
	ASSIGN 8302 TO MBACK
	GOTO 8303
8303	CONTINUE
C COLLECT 2 VARS STARTING AT LSTC+3
C SKIPS LSTC DELIMITER.
	LJ1=0
	LJ2=0
	LA=LSTC+1
	LE=110-LA
	IF(LE.LE.0)GOTO 8304
	CALL VARSCN(CMDLIN,LA,LE,LSTC,JD1A,JD1B,IVLD)
	LA=LSTC+1
	LE=110-LA
	IF(LE.LE.0.OR.IVLD.LE.0)GOTO 8304
	LJ1=1
	IF(CMDLIN(LSTC).NE.':')GOTO 8304
	CALL VARSCN(CMDLIN,LA,LE,LSTC,JD2A,JD2B,IVLD)
	IF(IVLD.LE.0)GOTO 8304
	LJ2=1
8304	GOTO MBACK
8302	CONTINUE
	IF(LJ1.LE.0)GOTO 8399
	IDELT=1
	IF(L2.NE.0.AND.(ID1A.NE.ID1B.AND.ID2A.NE.ID2B))GOTO 8305
	IF(L2.NE.0)IDELT=MAX0(IABS(ID1A-ID1B),IABS(ID2A-ID2B))+1
8305	CONTINUE
	JDELT=1
	IF(LJ2.EQ.0)GOTO 8306
	IF(JD1A.NE.JD2A.AND.JD1B.NE.JD2B)GOTO 8306
	JDELT=MAX0(IABS(JD1A-JD2A),IABS(JD1B-JD2B))+1
8306	IF(L2.NE.0)JDELT=MIN0(IDELT,JDELT)
C CHANGE FOR REPLICATE :  JDELT CAN BE JUST JDELT IF L2=0
	ASSIGN 8307 TO JBACK
C 8109 IS WHERE WE SET UP I1IN AND I2IN ASSUMING THAT THE VARIABLES
C ARE SET PROPERLY. HANDLED AS AN INTERNAL PROCEDURE.
	GOTO 8109
8307	CONTINUE
	JIN1=1
	JIN2=0
	IF(JD1B.EQ.JD2B)GOTO 8308
	JIN1=0
	JIN2=1
8308	CONTINUE
C CHANGE FOR REPLICATE: IF L2 IS 0 (NO 2ND SRC VARIABLE), NO BUMPS
C PAST THE SINGLE VARIABLE SPECIFIED.
	IF(L2.EQ.0)I1IN=0
	IF(L2.EQ.0)I2IN=0
	ICODE=1
C FORCE RECALC IF ONLY 1 SOURCE VARIABLE.
	IF(L2.EQ.0)ICODE=3
	JRTR=PROW
	JRTC=PCOL
C JRTR AND JRTC = RELOCATION THRESHOLDS
C CELLS ABOVE OR LEFT OF JRTR,JRTC WILL NOT BE RELOCATED IN A CR
C OPERATION. THIS WILL GENERALLY BE THE PHYSICAL COLUMN OR ROW
C OF THE CURRENT POSITION. CELLS LOWER OR EQUAL, OR TO THE RIGHT
C OF THE CURRENT LOCATION OR EQUAL, WILL BE RELOCATED. (VARIABLE
C NAMES GET EDITED)
	ASSIGN 8365 TO KPYBAK
	GOTO 8364
C 8364 BEGINS COPY PROCEDURE SECTION
C GOES FOR JDELT CELLS WITH I1IN AND I2IN BEING SOURCE INCREMENTS FOR
C RRW DIMENSION, RCL DIMENSION, AND JIN1,2 BEING INCREMENTS FOR
C DESTINATION RRW,RCL DIMENSIONS RESPECTIVELY. USES CMDLIN(2) TO
C FLAG WHETHER TO HANDLE ALL, JUST FORMAT, RELOCATE, ETC.
C  ALSO ID1A,ID2A ARE START SOURCE LOCATION
C  JD1A,JD1B = DEST START LOCATION.
C
C COPIES 1 ROW OR COLUMN AT A TIME.
8364	CONTINUE
C	ICODE=1
C SET DISPLAY UPDATE ON COPIED CELLS
CCD	DO 3620 JV=1,BRRCL
CCD3620	IBITMP(JV)=0
	DO 8309 JV=1,JDELT
	DO 8380 NX1=1,DRWV
	DO 8380 NX2=1,DCLV
C LOCATE DISPLAY CELL IF ANY
	IF(NRDSP(NX1,NX2).EQ.ID1.AND.NCDSP(NX1,NX2).EQ.ID2)GOTO 8387
8380	CONTINUE
	GOTO 8388
8387	CONTINUE
	DVS(NX1,NX2)=1.245E-14
8388	CONTINUE
	JRXX=(JD1B-1)*RRW+JD1A
	IRXX=(ID2A-1)*RRW+ID1A
	CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
	KKKKK=FVLD(1,1)
	CALL FVLDGT(JD1A,JD1B,FVLD(1,1))
	IF(KKKKK.EQ.0.AND.FVLD(1,1).EQ.0)GOTO 8314
C	IF(FVLD(ID1A,ID2A).EQ.0.AND.FVLD(JD1A,JD1B).EQ.0)GOTO 8314
C	READ(7'IRXX)FORM
C	READ(7'JRXX)FORM2
	CALL WRKFIL(IRXX,FORM,0)
	CALL WRKFIL(JRXX,FORM2,0)
	IF(KKKKK.EQ.-2)CALL FVLDST(ID1A,ID2A,-3)
	IF(KKKKK.EQ.2)CALL FVLDST(ID1A,ID2A,3)
	IF(FORM (119).EQ. 2)FORM (119)=3
	IF(FORM (119).EQ.-2)FORM (119)=-3
	IF(FORM2(119).EQ. 2)FORM2(119)=3
	IF(FORM2(119).EQ.-2)FORM2(119)=-3
	IF(CMDLIN(2).NE.'R'.AND.CMDLIN(2).NE.'A')GOTO 8310
	IF(CMDLIN(2).NE.'R')GOTO 8366
C RELOCATE, THEN WRITE NEW CELL
	II1=ID1A
	II2=ID2A
	JJ1=JD1A
	JJ2=JD1B
	CALL RELVBL(FORM,FORM2,II1,II2,JJ1,JJ2,JRTR,JRTC)
C THE ABOVE WILL RELOCATE FORM INTO FORM2 WHICH WE NOW EMIT.
	CALL WRKFIL(JRXX,FORM2,1)
C	WRITE(7'JRXX)FORM2
	GOTO 8367
8366	CONTINUE
	CALL WRKFIL(JRXX,FORM,1)
C	WRITE(7'JRXX)FORM
8367	CONTINUE
	CALL TYPGET(ID1A,ID2A,TYPE(1,1))
	CALL TYPSET(JD1A,JD1B,TYPE(1,1))
C	TYPE(JD1A,JD1B)=TYPE(ID1A,ID2A)
	CALL XVBLGT(ID1A,ID2A,XVBLS(1,1))
	CALL XVBLST(JD1A,JD1B,XVBLS(1,1))
C	XVBLS(JD1A,JD1B)=XVBLS(ID1A,ID2A)
	CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
	CALL FVLDST(JD1A,JD1B,FVLD(1,1))
C	FVLD(JD1A,JD1B)=FVLD(ID1A,ID2A)
	ID1A=ID1A+I1IN
	ID2A=ID2A+I2IN
	JD1A=JD1A+JIN1
	JD1B=JD1B+JIN2
	GOTO 8309
8310	CONTINUE
	IF(CMDLIN(2).NE.'V')GOTO 8312
	CALL TYPGET(ID1A,ID2A,TYPE(1,1))
	CALL TYPSET(JD1A,JD1B,TYPE(1,1))
C	TYPE(JD1A,JD1B)=TYPE(ID1A,ID2A)
	CALL XVBLGT(ID1A,ID2A,XVBLS(1,1))
	CALL XVBLST(JD1A,JD1B,XVBLS(1,1))
C	XVBLS(JD1A,JD1B)=XVBLS(ID1A,ID2A)
8312	IF(CMDLIN(2).NE.'D')GOTO 8313
	CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
	CALL FVLDST(JD1A,JD1B,FVLD(1,1))
C	FVLD(JD1A,JD1B)=FVLD(ID1A,ID2A)
	DO 8315 LXQ=1,10
8315	FORM2(118+LXQ)=FORM(118+LXQ)
	CALL WRKFIL(JRXX,FORM2,1)
C	WRITE(7'JRXX)FORM2
8313	IF(CMDLIN(2).NE.'F')GOTO 8314
	DO 8316 LXQ=1,110
8316	FORM2(LXQ)=FORM(LXQ)
	CALL WRKFIL(JRXX,FORM2,1)
C	WRITE(7'JRXX)FORM2
8314	CONTINUE
	ID1A=ID1A+I1IN
	ID2A=ID2A+I2IN
	JD1A=JD1A+JIN1
	JD1B=JD1B+JIN2
8309	CONTINUE
C RETURN POINT FROM COPY LOOP IN NORMAL COPY
	GOTO KPYBAK
8365	CONTINUE
8399	GOTO 9990
8004	IF(CMDLIN(1).LT.'1'.OR.CMDLIN(1).GT.'4')GOTO 8005
C 1,2,3,4 POSITIONING COMMANDS
	ICODE=1
	IF(CMDLIN(1).EQ.'3')THISRW=MAX0(1,(THISRW-1))
	IF(CMDLIN(1).EQ.'4')THISRW=MIN0((THISRW+1),DRWV)
	IF(CMDLIN(1).EQ.'1')THISCL=MAX0(1,(THISCL-1))
	IF(CMDLIN(1).EQ.'2')THISCL=MIN0((THISCL+1),DCLV)
	PROW=NRDSP(THISRW,THISCL)
	PCOL=NCDSP(THISRW,THISCL)
	DROW=THISRW
	DCOL=THISCL
	GOTO 9990
8005	CONTINUE
8007	IF(CMDLIN(1).NE.'R')GOTO 8008
C RECOMPUTE SHEET.
C RM COMMAND SETS MANUAL FLAG.
	RCFGX=0
	RCONE=0
C RCONE SET TO FORCE RECALC OF ALL.
C	IF(CMDLIN(2).NE.'M')RCONE=1
	IF(CMDLIN(2).NE.'M'.AND.CMDLIN(3).NE.'F')RCONE=1
	IF(CMDLIN(2).EQ.'M')RCFGX=1
	ICODE=3
	GOTO 9990
8008	IF(CMDLIN(1).NE.'K')GOTO 8009
C DROP INTO CALC BARE.
	IF(IPSET.NE.0)GOTO 9990
C CAN'T CALL CALC RECURSIVELY
	OSWIT=0
	ILNFG=0
C	ICODE=-1
C CLOSE UNIT 1 JUST IN CASE...
	CLOSE(UNIT=1)
	CALL UVT100(ED,2)
	KLVL=1
	ILNCT=0
C SAVE PROW,PCOL ACROSS CALC SINCE IT MAY NOW USE *P AND *W TO
C MODIFY THEM.
C	IPRSSS=PROW
C	IPCSSS=PCOL
C	CALL CALC
C	PROW=IPRSSS
C	PCOL=IPCSSS
CC CLOSE CONSOLE LUN USED BY CALC.
C	CLOSE(UNIT=1)
CC CLOSE ANY OTHER LUNS CALC MAY HAVE USED...
C	CLOSE(UNIT=2)
C	CLOSE(UNIT=3)
	ICODE=420
	GOTO 9990
8009	IF(CMDLIN(1).NE.'L')GOTO 8010
C LOCATE CURSOR ORIGIN
C FORMAT IS L VARIABLE
C ONLY 1 VARIABLE NAME TO BE ENTERED.
	LA=2
	LE=30
	CALL VARSCN(CMDLIN,LA,LE,LSTC,ID1A,ID2A,IVLD)
	L1=IVLD
C	ASSIGN 8900 TO IBACK
C	GOTO 8104
8900	IF(L1.LT.1)GOTO 9990
	PROW=ID1A
	PCOL=ID2A
C LOOK UP DISPLAY COORDS IF ANY
	ASSIGN 8901 TO NBK
	GOTO 7905
8901	CONTINUE
	DROW=LR
	DCOL=LC
	THISRW=LR
	THISCL=LC
	ICODE=1
	GOTO 9990
8010	IF(CMDLIN(1).NE.'Z')GOTO 8011
C ZERO COMMAND
C ZA OR ZE V1:V2
	IF(CMDLIN(2).NE.'A')GOTO 8950
C ZA = ZERO ALL. BE SURE HE MEANS IT.
	CALL UVT100(CUP,LDSPR,1)
	WRITE(6,8951)
8951	FORMAT(/,'Really Zero All of sheet [Y/N]? ')
	READ(IOLVL,8952,END=510,ERR=510)(FORM2(KKI),KKI=1,4)
8952	FORMAT(4A1)
	IF(FORM2(1).NE.'Y')GOTO 9990
	CALL UVT100(ED,2)
	ICODE=-4
	GOTO 9990
8950	IF(CMDLIN(2).NE.'E')GOTO 9990
	ASSIGN 8953 TO IBACK
	GOTO 8104
C GET NAMES
8953	IF(L1.LE.0)GOTO 9990
	ASSIGN 8954 TO JBACK
	GOTO 8109
8954	CONTINUE
	DO 8955 NI=1,128
8955	FORM2(NI)=0
	FORM2(118)=15
	DO 8823 NI=1,9
8823	FORM2(119+NI)=DEFVB(1+NI)
	DO 8956 NI=1,IDELT
	IRX=(ID2-1)*RRW+ID1
	CALL WRKFIL(IRX,FORM2,1)
C	WRITE(7'IRX)FORM2
	CALL FVLDST(ID1,ID2,0)
	CALL XVBLST(ID1,ID2,0.0D0)
C	FVLD(ID1,ID2)=0
C	XVBLS(ID1,ID2)=0.
	IPRS=PROW
	IPCS=PCOL
	PROW=ID1
	PCOL=ID2
	ASSIGN 8957 TO NBK
C FIND DISPLAY LOC IF ANY
	GOTO 7905
8957	PROW=IPRS
	PCOL=IPCS
	IF(LR.EQ.0.OR.LC.EQ.0)GOTO 8958
	DVS(LR,LC)=1.E20
8958	CONTINUE
	ID1=ID1+I1IN
	ID2=ID2+I2IN
8956	CONTINUE
	GOTO 9990
8011	IF(CMDLIN(1).NE.'X')GOTO 8012
C EXIT TO OS
C SINCE THERE'S NO WORKFILE HERE, MAKE SURE HE MEANS IT...
	IF(IPSET.NE.0)GOTO 9990
	ICODE=2
	CALL UVT100(CUP,LDSPR,1)
	WRITE(6,3718)
3718	FORMAT(' Exit now may lose data unless sheet has been saved')
	CALL UVT100(CUP,LCMDR,1)
	WRITE(6,3717)
3717	FORMAT(' Confirm Exit Request [Y/N]:')
	READ(IOLVL,8952,END=510,ERR=510)(FORM2(KKI),KKI=1,4)
	IF(FORM2(1).NE.'Y'.AND.FORM2(1).NE.'y')GOTO 9990
	IF(CMDLIN(2).NE.'D')GOTO 3603
C THE XD COMMAND WILL EXIT AND DELETE THE SCRATCH FILE.
C	CALL WRKFIL(1,FORM,3)
C	CLOSE(UNIT=7,DISP='DELETE')
	CALL EXIT
3603	CONTINUE
C	CALL WRKFIL(1,FORM,3)
C	CALL CLOSE(7)
	CALL EXIT
8012	IF(CMDLIN(1).NE.'S')GOTO 8013
C SAVE SHEET TO DISK (NEW SET OF DATA)
C NOW JUST PERMITS RESTART...
	ICODE=-2
	ISTAT=-2
	CALL UVT100(ED,2)
	GOTO 9990

8013	IF(CMDLIN(1).NE.'P')GOTO 8014
C PUT NUMBERS OUT TO FILE
C USES RELATIVE FORMS TO CURRENT POS.
C PD = PUT OURT DISPLAY SHEET. PP = PUT OUT PHYSICAL SHEET.
C ONLY WRITES PHYSICALLY PRESENT DATA.
C P/D RRR,CCC,FORMULA,VALID,FORMAT
C N IN 3RD CHR (PPN/PDN) SAVES NUMBERS, ELSE FORMULAS.
	ICODE=1
	CLOSE(UNIT=4,ERR=7954)
7954	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
C ASK FOR FILE NAME
	WRITE(6,7952)
7952	FORMAT('Enter filename>')
	READ(IOLVL,7953,END=510,ERR=510)ILN,FORM2
7953	FORMAT(Q,128A1)
C FORMAT Q RETURNS NUMBER CHARACTERS READ. CAN USE KLUDGE TO
C FIND THIS BY LOOKING FOR LAST NONSPACE BUT THIS IS EASIER.
	ILN=MIN0(ILN,127)
	FORM2(ILN+1)=0
	CALL ASSIGN(4,FORM2)
	WRITE(4,6950)NMSH
6950	FORMAT(80A1)
C ADD ABILITY TO SPECIFY MAX DISPL. TO SAVE
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,7977)
7977	FORMAT('Enter max. displ down to save or 0>')
	READ(IOLVL,7978,END=510,ERR=510)LDXM
7978	FORMAT(I7)
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,7980)
7980	FORMAT('Enter max. displ right to save or 0>')
	READ(IOLVL,7978,END=510,ERR=510)MDXM
	IF(MDXM.LE.0)MDXM=12000
	IF(LDXM.LE.0)LDXM=12000
C 12000 IS "AN ARBITRARILY LARGE NUMBER TO ASSURE THAT ALL VALID
C RANGES ARE SAVED". IT MUST BE SMALL ENOUGH TO ASSURE WE DON'T OVERFLOW AN
C INTEGER THOUGH.
	IF(CMDLIN(2).NE.'P')GOTO 7950
	DO 7951 IRO=PROW,RRW
	DO 7951 ICO=PCOL,RCL
C GO DOWN AND RIGHT ONLY. ALLOW MIXING THIS WAY.
	IRX=(ICO-1)*RRW+IRO
	IDRO=IRO-PROW+1
	IDCL=ICO-PCOL+1
	IF(IDRO.GT.LDXM.OR.IDCL.GT.MDXM)GOTO 7951
C FORM DISPLACEMENT LOCATORS
	CALL FVLDGT(IRO,ICO,FVLD(1,1))
	IF(FVLD(1,1).EQ.0)GOTO 7951
	CALL WRKFIL(IRX,FORM2,0)
C	READ(7'IRX)FORM2
	IF(FORM2(119).EQ.2)FORM2(119)=3
	IF(FORM2(119).EQ.-2)FORM2(119)=-3
	IF(CMDLIN(3).NE.'N')GOTO 5402
C EMIT NUMBERS, NOT FORMATS **** CHECK 4 OR 2, ASSUME 4=INTEGER
	CALL XVBLGT(IRO,ICO,XVBLS(1,1))
	CALL TYPGET(IRO,ICO,TYPE(1,1))
	IF(ABS(TYPE(1,1)).EQ.4)WRITE(4,5403)IDRO,IDCL,JVBLS(1,1,1)
5403	FORMAT('P',I5,',',I5,',',I15)
	IF(ABS(TYPE(1,1)).NE.4)WRITE(4,5404)IDRO,IDCL,XVBLS(1,1)
5404	FORMAT('P',I5,',',I5,',',D35.19)
	GOTO 5405
5402	CONTINUE
	WRITE(4,7955)IDRO,IDCL,(FORM2(IV),IV=1,110)
5405	CONTINUE
C DUMP TO SERIAL FILE IN OUR OWN FORMAT, BUT ALL IN ASCII.
7955	FORMAT('P',I5,',',I5,',',128A1)
C NOTE LONG RECORDS.
	DO 358 IV=120,128
358	IF(FORM2(IV).LT.' ')FORM2(IV)=32
	WRITE(4,7956)FORM2(119),(FORM2(IV),IV=120,128),TYPE(1,1)
7956	FORMAT(I3,',',9A1,',',I5)
7951	CONTINUE
	CLOSE(UNIT=4)
	GOTO 9990
7950	IF(CMDLIN(2).NE.'D')GOTO 9990
	DO 7957 IRO=DROW,DRW
	DO 7957 ICO=DCOL,DCL
	IDRO=IRO-DROW+1
	IDCL=ICO-DCOL+1
	IF(IDRO.GT.LDXM.OR.IDCL.GT.MDXM)GOTO 7957
	NR=NRDSP(IRO,ICO)
	NC=NCDSP(IRO,ICO)
	IRX=(NC-1)*RRW+NR
	CALL FVLDGT(NR,NC,FVLD(1,1))
	IF(FVLD(1,1).EQ.0)GOTO 7957
	CALL WRKFIL(IRX,FORM2,0)
C	READ(7'IRX)FORM2
	IF(FORM2(119).EQ.2)FORM2(119)=3
	IF(FORM2(119).EQ.-2)FORM2(119)=-3
	IF(CMDLIN(3).NE.'N')GOTO 5412
C EMIT NUMBERS, NOT FORMATS **** CHECK 4 OR 2, ASSUME 4=INTEGER
	CALL TYPGET(NR,NC,TYPE(1,1))
	CALL XVBLGT(NR,NC,XVBLS(1,1))
	IF(ABS(TYPE(1,1)).EQ.4)WRITE(4,5413)IDRO,IDCL,JVBLS(1,1,1)
5413	FORMAT('P',I5,',',I5,',',I15)
	IF(ABS(TYPE(1,1)).NE.4)WRITE(4,5414)IDRO,IDCL,XVBLS(1,1)
5414	FORMAT('P',I5,',',I5,',',D35.19)
	GOTO 5415
5412	CONTINUE
	WRITE(4,7958)IDRO,IDCL,(FORM2(IV),IV=1,110)
5415	CONTINUE
7958	FORMAT('D',I5,',',I5,',',128A1)
	DO 359 IV=120,128
359	IF(FORM2(IV).LT.' ')FORM2(IV)=32
	WRITE(4,7956)FORM2(119),(FORM2(IV),IV=120,128),TYPE(1,1)
7957	CONTINUE
	CLOSE(UNIT=4)
	GOTO 9990
8014	CONTINUE
8015	IF(CMDLIN(1).NE.'G')GOTO 8016
C GET INPUT NUMBERS OFF SEQUENTIAL FILE. USE CURRENT ORIGIN
	ICODE=2
	CLOSE(UNIT=4,ERR=7960)
7960	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,7952)
	READ(IOLVL,7953,END=510,ERR=510)ILN,FORM2
	ILN=MIN0(127,ILN)
	FORM2(ILN+1)=0
	CALL ASSIGN(4,FORM2)
	READ(4,6950)NMSH
C ADD ABILITY TO SPECIFY MAX DISPL. TO SAVE
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,6977)
6977	FORMAT('Enter max. displ down to restore or 0>')
	READ(IOLVL,7978,END=510,ERR=510)LDXM
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,7982)
7982	FORMAT('Enter max. displ right to restore or 0>')
	READ(IOLVL,7978,END=510,ERR=510)MDXM
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,7983)
7983	FORMAT('Enter min. displ. down>')
	READ(IOLVL,7978,END=510,ERR=510)LLDXM
	CALL UVT100(CUP,LCMDR,1)
	CALL UVT100(EL,2)
	WRITE(6,7984)
7984	FORMAT('Enter min. displ. right>')
	READ(IOLVL,7978,END=510,ERR=510)MMDXM
	IF(MDXM.LE.0)MDXM=12000
	LLDXM=MAX0(1,LLDXM)
	MMDXM=MAX0(1,MMDXM)
	IF(LDXM.LE.0)LDXM=12000
C 12000 IS, AS ABOVE, JUST A "BIG" NUMBER.
7961	CONTINUE
	READ(4,7962,END=7964,ERR=7964)LET1,IRRW,ICCL,(FORM2(IV),
     1  IV=1,110)
7962	FORMAT(A1,I5,X,I5,X,128A1)
	DO 4497 IV=1,110
	IVV=111-IV
	IF(FORM2(IVV).GT.32)GOTO 4496
	FORM2(IVV)=0
4497	CONTINUE
4496	CONTINUE
C ABOVE LOOP ENSURES THAT EXTRA PARTS OF BUFFER NOT IN SAVE FILE ARE
C ZEROED ON READIN.
	READ(4,7956,END=7964,ERR=7964)FORM2(119),(FORM2(IV),IV=120,128),
     1  KKTYP
	IF(FORM2(119).EQ.2)FORM2(119)=3
	IF(FORM2(119).EQ.-2)FORM2(119)=-3
	IF(IRRW.LE.0.OR.ICCL.LE.0)GOTO 9990
	IF(IRRW.GT.LDXM.OR.ICCL.GT.MDXM)GOTO 7961
	IF(IRRW.LT.LLDXM.OR.ICCL.LT.MMDXM) GOTO 7961
C PRODUCE NEW ADDRESSES IN PHYSICAL SHEET USING SAVED FILE'S ONES
C AND CURSOR LOCATION (SINCE WE SAVE/RESTORE RELATIVE TO CURSOR).
C THIS PROVIDES A SHEET PARTIAL SAVE / MERGE CAPABILITY.
	NR=IRRW+PROW-LLDXM
	NC=ICCL+PCOL-MMDXM
	IF(LET1.NE.68)GOTO 7963
	LRR=IRRW+DROW-LLDXM
	LCC=ICCL+DCOL-MMDXM
	LRR=MAX0(1,LRR)
	LCC=MAX0(1,LCC)
	IF(LRR.GT.DRWV.OR.LCC.GT.DCLV)GOTO 7961
	NR=NRDSP(LRR,LCC)
	NC=NCDSP(LRR,LCC)
7963	IRX=(NC-1)*RRW+NR
	IF(NR.EQ.0.OR.NC.EQ.0)GOTO 7961
	FORM2(118)=15
	CALL FVLDST(NR,NC,FORM2(119))
C	FVLD(NR,NC)=FORM2(119)
	CALL TYPSET(NR,NC,KKTYP)
C	TYPE(NR,NC)=KKTYP
	CALL WRKFIL(IRX,FORM2,1)
C	WRITE(7'IRX)FORM2
	GOTO 7961
7964	CONTINUE
	ISTAT=2
	GOTO 9990
8016	IF(CMDLIN(1).NE.'W')GOTO 8017
C WRITE (PRINT) SCREEN OUT TO FILE (MAY BE PRINTER)
C	CALL DSPSHT(10)
C	ICODE=1
	ICODE=400
C CODE 10 IS PRINT SECRET CODE TO DSPSHT.
	GOTO 9990
8017	CONTINUE
	IF(CMDLIN(1).NE.'H')GOTO 5019
	IF(IPSET.NE.0)GOTO 9990
	IVVV=0
	IVVVV=CMDLIN(2)
9308	CONTINUE
	IF(IVVVV.GE.48.AND.IVVVV.LE.57)IVVV=IVVVV-48
C SELECT HELP LEVEL 0-9 IF SPECIFIED.
	ICODE=30+IVVV
C	CALL HELP(IVVV)
C	IVVV=0
C	WRITE(6,5020)
C5020	FORMAT(/'Type return to continue, Hn for other Help pages:')
C	READ(IOLVL,8952,END=510,ERR=510)(FORM2(K),K=1,4)
C	IVVVV=FORM2(2)
C	IF(FORM2(1).EQ.'H')GOTO 9308
C	ICODE=2
	GOTO 9990
5019	CONTINUE
	WRITE(6,8018)
8018	FORMAT('Invalid Command.')
	GOTO 200
C ERROR ON READIN ADDRESS. REWIND TERMINAL IF USER
C TYPES CTRL Z (EOF), ELSE LEAVE INDIRECT FILES.
510	IF(IOLVL.EQ.5)REWIND 5
	CLOSE(UNIT=3)
	IOLVL=5
	GOTO 498
9990	CONTINUE

C HERE CLEAN UP AND RETURN
C FIRST DISPLAY LAST CURRENT COL IN NORMAL VIDEO
	IF(IXLSTR.LE.0.OR.IXLSTC.LE.0)GOTO 2000
	N1=NRDSP(IXLSTR,IXLSTC)
	N2=NCDSP(IXLSTR,IXLSTC)
	IRRX=(N2-1)*RRW+N1
C REWRITE LAST LOCATION WITH NO REVERSE VIDEO.
C	IF(FVLD(N1,N2).EQ.0)GOTO 2000
	IF(IXLSTC.GT.DCLV.OR.IXLSTR.GT.DRWV)GOTO 2000
C ONLY REDRAW NUMBERS. DIRECT DISPLAY OR NOTHING GETS IGNORED.
	IF(ICODE.LT.0.OR.ICODE.EQ.2)GOTO 2000
C NO SENSE REDRAWING IF WE'RE ABOUT TO ERASE DISPLAY ANYWAY.
	IF(ICODE.GT.30)GOTO 2000
	J=8
C ADD 6 COLS FOR LABELS
C DROW,DCOL IS CURRENT DISPLAY LOC.
	DO 3301 M1=1,IXLSTR
C FIND DISPLAY COLUMN TO USE
3301	J=J+CWIDS(M1)
	J=J-CWIDS(IXLSTR)
C USE THISCL+1 TO LET 1ST ROW BE LABELS.
	ICCC=IXLSTC+2
C JVTINC = 1 IF VT100, 0 IF VT52
C JVTINC NEEDED SINCE UVT100 FOR VT100 DOES BACKSPACE AT THE SGR ENTRY
C AND THUS WE NEED TO CORRECT FOR IT. THIS WAS FIXED IN THE UVT52
C VERSION AND ITS DESCENDANTS.
	IC1POS=N1
	IC2POS=N2
	IF(PZAP.NE.0)GOTO 2000
	CALL UVT100(CUP,ICCC,J+JVTINC) !SELECT ROW "IXLSTC", COL "J"
	CALL UVT100(SGR,0)
C DESELECT REVERSE VIDEO
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IF(FVLD(1,1).EQ.0)WRITE(6,5537)
5537	FORMAT('   ')
	IF(FVLD(1,1).EQ.0)GOTO 2000
CC	IF(FVLD(N1,N2).LT.0)READ(7'IRRX)FORM
	CALL WRKFIL(IRRX,FORM,0)
C	READ(7'IRRX)FORM
	DO 5546 KKKK=1,100
5546	CMDLIN(KKKK)=32
	IF(FVLD(1,1).LT.0.OR.FORMFG.NE.0)
     1  ENCODE(100,8201,CMDLIN)(FORM(II),II=1,100)
	IF(FORMFG.NE.0)GOTO 4324
	DO 6302 KKK=1,9
	KKKK=FORM(KKK+119)
C	KKKK=DFMTS(KKK,IXLSTR,IXLSTC)
6302	DFE(KKK+1)=MAX0(32,KKKK)
	DFE(11)=32
C 32 = ASCII SPACE
	DFE(1)='('
	DFE(12)=')'
	CALL TYPGET(N1,N2,TYPE(1,1))
	IF(TYPE(1,1).EQ.2.AND.FVLD(1,1).GT.0)
     1  ENCODE(100,DFE,CMDLIN)DVS(IXLSTR,IXLSTC)
	IF(TYPE(1,1).NE.2.AND.FVLD(1,1).GT.0)
     1  ENCODE(100,DFE,CMDLIN)LDVS(1,IXLSTR,IXLSTC)
C REDRAW THIS COL. WITHOUT REVERSE VIDEO HERE.
4324	WRITE(6,9000)(CMDLIN(II),II=1,CWIDS(IXLSTR))
C NOTE THIS REDRAWS PREVIOUS COL. IN NORMAL VIDEO.
C NO CARRIAGE CTL
C	CALL UVT100(SGR,0)
C SELECT REVERSE VIDEO OFF
2000	CONTINUE
C NOW COMPLETE ANY CLEANUP.
C SET CMDLIN TO 0 AT START TO INHIBIT ANY MISINTERPRETATION.
C WE USE CMDLIN AS A BUFFER IN REDRAWIND DSPLY SO DON'T LET IT GET
C CLOBBERED.
	DO 945 K=1,132
945	CMDLIN(K)=0
	RETURN
	END
	SUBROUTINE RELVBL(LNIN,LNOUT,INRW,INCL,JOUTR,JOUTC,JRTR,JRTC)
C RELOCATE VARIABLES BELOW/RIGHT OF JRTR,JRTC INTO LNOUT FROM LNIN
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1,ED=11,EL=12
	LOGICAL*1 NAME(4),NUMBER(6)
	LOGICAL*1 LNIN,LNOUT
	DIMENSION LNIN(128),LNOUT(128)
	LI=1
	LO=1
C LI = INPUT LOCATION
C LO=OUTPUT LOCATION
100	CONTINUE
C	IF(LNIN(LI).LT.'A'.OR.LNIN(LI).GT.'Z')GOTO 200
	LCC=LNIN(LI)
	IF(LCC.LT.65.OR.LCC.GT.89)GOTO 200
C WE MUST ENSURE VARSCN ALWAYS SEES AN ALPHA AT START.
	L1=LI
	LE=110
	LSTC=LE
	CALL VARSCN(LNIN,L1,LE,LSTC,ID1,ID2,IVLD)
	IF(ID2.EQ.1.AND.ID1.LE.27)IVLD=0
	IF(IVLD.EQ.0)GOTO 200
C FOUND VARIABLE. NOW GENERATE ASCII ANDSTUFF INTO OUTPUT.
C FIRST DON'T RELOCATE P## AND D## FORMS.
	IF(LNIN(LI+1).EQ.'#')GOTO 250
C RELOCATE NORMAL VARIABLE HERE.
C
C THE NEW VARIABLE IS TO BE DIFFERENT ONLY IF (ID1,ID2) HAS
C ID1.GT.JRTR AND ID2.GT.JRTC
	IF(ID1.LT.JRTR.OR.ID2.LT.JRTC)GOTO 210
C OK, KNOW NOW THAT WE HAVE TO RELOCATE ALL.
C THEREFORE ADD THE DIFFERENCE BETWEEN DEST AND SRC TO BOTH
C AND CLAMP TO VALID DIMENSIONS.
	ID1=ID1+(JOUTR-INRW)
	ID2=ID2+(JOUTC-INCL)
	ID1=MAX0(ID1,1)
	ID2=MAX0(ID2,1)
	ID1=MIN0(RRW,ID1)
	ID2=MIN0(RCL,ID2)
210	CONTINUE
	CALL IN2AS(ID1,NAME)
C NAME GETS 4 CHARACTERS TO USE FOR COL. LABEL
	L2=ID2-1
	ENCODE(6,1000,NUMBER)L2
1000	FORMAT(I6)
C NOW NAME AND NUMBER ARRAYS HAVE LETTERS, DIGITS, OR SPACES.
C THROW OUT SPACES AND COPY THE REST.
	LI=LSTC
	DO 202 N=1,4
	IF(NAME(N).LE.32)GOTO 202
	LNOUT(LO)=NAME(N)
	LO=LO+1
	IF(LO.GT.110)GOTO 300
202	CONTINUE
	DO 203 N=1,6
	IF(NUMBER(N).LE.32)GOTO 203
C IF 32 ISN'T SPACE, LOSE
	LNOUT(LO)=NUMBER(N)
	LO=LO+1
	IF(LO.GT.110)GOTO 300
203	CONTINUE
	GOTO 300
250	CONTINUE
C JUST COPY DISPLAY FORMS.
	L1=LSTC-1
	DO 251 N=LI,L1
	LNOUT(LO)=LNIN(N)
	LO=LO+1
	IF(LO.GT.110)GOTO 300
251	CONTINUE
	LI=LSTC
C THIS SKIPS OVER THE VARIABLE FOUND, SO WE GO ON.
	GOTO 300
200	LNOUT(LO)=LNIN(LI)
	LO=LO+1
	LI=LI+1
300	IF(LO.LT.109.AND.LI.LT.109)GOTO 100
C THIS LOOPS EITHER COPYING LINE OR FINDING VARIABLES TILL DONE.
	DO 400 N=LO,110
400	LNOUT(N)=0
	DO 1 N=111,128
1	LNOUT(N)=LNIN(N)
C DEFAULT ALL OF FORM LINES EXCEPT FORMULA IDENTICAL TO THE INPUT.
	RETURN
	END
C
C STRING EDIT ROUTINE.
	SUBROUTINE SED(LCMD,LIN,LWRK,ARGSTR,XAC,LENGTH)
	INCLUDE 'VKLUGPRM.FTN'
	LOGICAL*1 LIN(1),LWRK(1),ARGSTR(52,4)
	LOGICAL*1 LCMD(1),LSU(10)
	INTEGER*4 III
	REAL*8 XAC
C
C OPERATION:
C EDIT LIN TO LWRK, WITH LENGTH VARIABLE HOLDING INPUT
C LENGTH IN CHARACTERS. LCMD HOLDS COMMAND LINE, WHICH
C ULTIMATELY GETS EDITED STRING COPIED BACK INTO IT.
C
C EDITS:
C  CHARACTER AT IDELIM IS DELIMITER. REPLACE STRING IN 1ST
C INTERVAL BETWEEN DELIMITERS WITH SECOND.
C  HOWEVER:
C  &1 TO &4 GET CONTENTS (UP TO NULL) OF ARGSTR(X,1) TO (X,4)
C
C  &5 RETURNS XAC VALUE CONVERTED TO DECIMAL INTEGER AND
C  PRINTED.
C  &6 RETURNS XAC VALUE CONVERTED TO ASCII CODE (1 BYTE) AND
C  INSERTED.
C XAC ENTERS WITH CONTENTS OF ACCUMULATOR Z (TO AVOID TOO MUCH
C DIFFICULTY IN USING IT OWING TO THE UBIQUITY OF USE OF %).
C	WE ENTER JUST POINTING AT THE COMMAND LINE AFTER THE ENTER
C AND ITS SPACE. ASSUME 1ST CHARACTER IS OUR DELIMITER.
	IDELIM=LCMD(1)
	ID2=INDEX(LCMD(2),IDELIM)
	IF(ID2.GE.LENGTH)GOTO 100
C NOW HAVE 1ST STRING, OF NONZERO LENGTH
C FIND SECOND STRING NOW. EITHER MAY BE OF 0 LENGTH BUT
C BOTH MUST BE DEFINED BY A DELIMITER.
	ID3=INDEX(LCMD(2+ID2),IDELIM)
	IF(ID3.GE.LENGTH)GOTO 100
C WELL, WE GOT IT SOMEHOW. NOW TRY AND EDIT THE JUNK IN.
C (NOTE WE WANT TO FILL ALL OF LENGTH)
	INLIN=1
	INWRK=1
	LSA=ID2-1
	LSB=ID3-1
	LSSB=2+ID2
	DO 1 N=1,LENGTH
	IF(LIN(INLIN).EQ.0)GOTO 1
	CALL SSCMP(LIN(INLIN),LCMD(2),LSA,ICOD)
	IF(ICOD.EQ.0)GOTO 2
C HERE HAVE TO SUBSTITUTE
C PASS STRING TO SUBSTITUTE ON INPUT LINE FIRST.
	INLIN=INLIN+LSA
C	DO 6 M=1,LSB
	M=1
106	CONTINUE
	IF(LCMD(LSSB+M-1).EQ.'&')GOTO 7
8	CONTINUE
C JUST COPY ONE CHARACTER OF THE SUBSTITUTE STRING IN HERE.
	LWRK(INWRK)=LCMD(LSSB+M-1)
	IF(INWRK.LT.LENGTH)INWRK=INWRK+1
	GOTO 6
7	CONTINUE
C HANDLE & FORMS
	IF(LCMD(LSSB+M).LT.'1'.OR.LCMD(LSSB+M).GT.'6')GOTO 8
C REQUIRE ALL FORMS TO BE &1 THRU &6 TO BE DEALT WITH HERE.
	M=M+1
	IF(LCMD(LSSB+M-1).GT.'4')GOTO 10
C HERE JUST HANDLE ARGSTR SUBSTITUTIONS.
	II=LCMD(LSSB+M-1)
	II=II-48
C II IS NOW THE INDEX.
	DO 11 MM=1,52
	LWRK(INWRK)=ARGSTR(MM,II)
	IF(INWRK.LT.LENGTH)INWRK=INWRK+1
	IF(ARGSTR(MM,II).EQ.0)GOTO 12
11	CONTINUE
12	CONTINUE
	M=M+1
C PASS THE NUMBER OF THE &NUMBER FORM
	GOTO 6
10	CONTINUE
C HANDLE ZAC FORMS
	M=M+1
C PASS THE DIGIT
	IF(LCMD(LSSB+M-2).EQ.'5')GOTO 14
C FILL IN ZAC AS AN INTEGER
	II=32
	IF(XAC.GE.1.AND.XAC.LT.256.)II=XAC
C ONLY HANDLE CONVERSION IF LEGAL
	LWRK(INWRK)=II
	IF(INWRK.LT.LENGTH)INWRK=INWRK+1
	GOTO 6
14	CONTINUE
C HANDLE NUMERIC CONVERSION HERE
	LSU(1)=0
	III=0
	IF(ABS(XAC).LT.9999999.)III=XAC
	ENCODE(10,15,LSU,ERR=22)III
15	FORMAT(I9)
22	DO 16 MK=1,10
	IF(LSU(MK).EQ.0)GOTO 6
	IF(LSU(MK).EQ.' ')GOTO 16
	LWRK(INWRK)=LSU(MK)
	IF(INWRK.LT.LENGTH)INWRK=INWRK+1
16	CONTINUE
6	CONTINUE
	M=M+1
	IF(M.LE.LSB)GOTO 106
	GOTO 1
2	CONTINUE
C HERE JUST ANOTHER CHARACTER TO MOVE, DO THE MOVE.
	LWRK(INWRK)=LIN(INLIN)
	IF(INLIN.LT.LENGTH)INLIN=INLIN+1
	IF(INWRK.LT.LENGTH)INWRK=INWRK+1
1	CONTINUE	
C COPY BACK OUT TO CMDLIN AFTER FIXUP
	IF(INWRK.GE.LENGTH)GOTO 3
	DO 4 N=INWRK,LENGTH
4	LWRK(N)=0
3	CONTINUE
C REPLACE COMMAND LINE WITH EDITED STRING FOR ENTRY NOW.
	DO 5 N=1,LENGTH
5	LCMD(N)=LWRK(N)
100	CONTINUE
	RETURN
	END
C STRING COMPARE 2 ARRAYS UNTIL EITHER ENDSTRING IS SEEN
C ON ONE OR MISMATCH IS SEEN.
	SUBROUTINE SSCMP(LINA,LINB,LENM,ICODE)
	DIMENSION LINA(1),LINB(1)
	LOGICAL*1 LINA,LINB
	ICODE=1
	DO 1 N=1,LENM
	IF(LINA(N).EQ.0.OR.LINB(N).EQ.0)GOTO 2
	IF(LINA(N).NE.LINB(N))ICODE=0
	IF(ICODE.NE.1)GOTO 2
1	CONTINUE
2	CONTINUE
	RETURN
	END
	SUBROUTINE SVBL(CMDLIN,LA,N,LE,FORM)
	INCLUDE 'VKLUGPRM.FTN'
	INTEGER*2 VLEN(9),TYPE(RRWP,RCLP)
	LOGICAL*1 AVBLS(100,27)
	REAL*8 XVBLS(RRWP,RCLP)
	COMMON/V/TYPE,AVBLS,XVBLS,VLEN
	LOGICAL*1 CMDLIN(132),FORM(128),NBF(8)
	INTEGER*2 LA,N,LE
	NI=N
	N=N+2
C LOOK FOR V1,V2 VARIABLES; THEN GET NAME TO FILL IN.
	LAA=N
	LEE=LE
	CALL VARSCN(CMDLIN,LAA,LEE,LSTC,I1,I2,IVLD)
	IF(IVLD.LE.0)GOTO 990
	LAA=LSTC+1
C ACCEPT ANY DELIMITER
	LEE=LE
	CALL VARSCN(CMDLIN,LAA,LEE,LSTC,J1,J2,IVLD)
	IF(IVLD.LE.0)GOTO 990
C	XX=XVBLS(I1,I2)
	CALL XVBLGT(I1,I2,XX)
C XX IS COL #
C	XY=XVBLS(J1,J2)-1.0
	CALL XVBLGT(J1,J2,XY)
	IF(XX.LE..99.OR.XX.GT.DFLOAT(RRW))GOTO 990
	IF(XY.LE..99.OR.XY.GT.DFLOAT(RCL))GOTO 990
	IC=XX
	CALL IN2AS(IC,NBF)
	IR=XY
	ENCODE(3,300,NBF(5))IR
300	FORMAT(I3.3)
	NL=NI
C FILL IN DECODED VARIABLE NAME, ZOTTING OUT EXTRA SPACES.
	DO 400 NN=1,7
	FORM(NL)=NBF(NN)
	IF(FORM(NL).GT.64)NL=NL+1
400	CONTINUE
C NOW ADJUST CMDLIN AND SET RETURN UP FOR ORIGINAL LENGTH FIXUP
C NOTE NI IS WHERE N WAS ON START (INDEX OF _)
C AND LSTC IS NEXT CHAR AFTER 2ND VARIABLE ON CMDLIN
C AND NL IS NEXT CHAR IN FORM. ASSUME THAT FORM IS NOW SHORTER
C AND MOVE CMDLIN DOWN.
	N=NL
	LE=LE-LSTC+NL
	DO 401 M=N,LE
	CMDLIN(M)=CMDLIN(M+LSTC-NL)
401	CONTINUE
C HOPE ALL'S WELL NOW...
	RETURN
990	CONTINUE
	FORM(N)=CMDLIN(N)
	RETURN
	END
	SUBROUTINE SSTR(CMDLIN,LA,N,LE,FORM)
	LOGICAL*1 CMDLIN(132),FORM(128),NBF(8)
	INTEGER*2 LA,N,LE
	INCLUDE 'VKLUGPRM.FTN'
	INTEGER*2 VLEN(9),TYPE(RRWP,RCLP)
	LOGICAL*1 AVBLS(100,27)
	REAL*8 XVBLS(RRWP,RCLP),XX,VP,TMP
	COMMON/V/TYPE,AVBLS,XVBLS,VLEN
	NI=N
	N=N+2
C LOOK FOR V1,V2 VARIABLES; THEN GET NAME TO FILL IN.
	LAA=N
	LEE=LE
	CALL VARSCN(CMDLIN,LAA,LEE,LSTC,I1,I2,IVLD)
	IF(IVLD.LE.0)GOTO 990
C	XX=XVBLS(I1,I2)
	CALL XVBLGT(I1,I2,XX)
	VP=128.D0**7
	DO 1 NN=1,8
	TMP=AINT(XX/VP)
	NBF(NN)=TMP
	VP=VP/128.D0
	XX=XX-(128.D0*TMP)
1	CONTINUE
C NOW NBF HAS 8 BYTES OF DATA CORRESPONDING TO DE-HASHED
C STRING. COPY TO FORM.
	NL=NI
	DO 2 NN=1,8
	FORM(NL)=NBF(NN)
	IF(NN.GE.1)NL=NL+1
2	CONTINUE
C NOW ADJUST CMDLIN AND SET RETURN UP FOR ORIGINAL LENGTH FIXUP
C NOTE NI IS WHERE N WAS ON START (INDEX OF _)
C AND LSTC IS NEXT CHAR AFTER VARIABLE ON CMDLIN
C AND NL IS NEXT CHAR IN FORM. ASSUME THAT FORM IS NOW SHORTER
C AND MOVE CMDLIN DOWN.
	N=NL
	LE=LE-LSTC+NL
	DO 401 M=N,LE
	CMDLIN(M)=CMDLIN(M+LSTC-NL)
401	CONTINUE
C HOPE ALL'S WELL NOW...
	RETURN
990	FORM(N)=CMDLIN(N)
	RETURN
	END
