c -h- varscn.for	Fri Aug 22 13:37:17 1986	
C $DO66
	SUBROUTINE VARSCN(LINE,IBGN,LEND,LSTCHR,ID1,ID2,IVALID)
C COPYRIGHT (C) 1983, 1984 GLENN AND MARY EVERHART
C ALL RIGHTS RESERVED
C
C VARSCN - SCAN COMMAND LINE FOR VARIABLE NAMES.
C
C	SCANS FOR VARIABLE NAMES OF FORM AAANNN WHERE AAA = LETTERS
C BETWEEN A AND Z UP TO NON-ALPHA, CORRESPONDING TO ROW, FOLLOWED BY
C NUMBERS IN THE 0-9 RANGE MAKING A DECIMAL COLUMN NUMBER.
C
C THE LETTERS ARE FORMED BY
C A-Z ALONE GIVE ROW 1-26, COL 1. % IS ROW 27,COL1
C A1-Z1 GIVE ROW 1-26, COL 2
C AA1-ZZ1 ARE ROW 27-52, COL 2
	IMPLICIT InTeGer*4 (A-Z)
C PARAMETER 18060=60*301 ! SIZE
C NOTE COL 1 IS DUMMY. DISPLAY THE SHEET SIDEWAYS SO WE GET USUAL VISUAL
C ROWS, COLS., AND ACCUMULATORS A-Z,% JUST APPEAR AS A FICTITIOUS ROW 0
C ON DISPLAY, INSTEAD OF REAL COLUMN 1 HERE.
	DIMENSION LINE(LEND)
	CHARACTER*1 LINE
	InTeGer*4 TYPE(1,1),VLEN(9)
	REAL*8 XVBLS(1,1)
	CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
	REAL*8 XAVB
	REAL*4 XAV2(2)
	CHARACTER*1 XAV1(8)
	EXTERNAL INDX
	EQUIVALENCE(XAVB,XAV2(1)),(XAVB,XAV1(1))
	EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC	InTeGer*4 DLFG
CCC	COMMON/DLFG/DLFG
C DLFG=1 IF D## FORMS ARE SEEN
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
C NRDSP AND NCDSP ARE REAL ROW, COL OF DISPLAY ROW, COL CELLS. NOTE THAT
C NOT ALL DISPLAY CELLS ARE ALWAYS ACTUALLY SHOWN; ONLY THOSE THAT FIT
C ARE SHOWN; THE REST "EXIST" BUT DON'T APPEAR UNLESS ROWS ARE SMALL
C ENOUGH.
C
C THIS PROGRAM ALSO HANDLES CELL SPECS OF FORM
C P#+nnn#+nnn (or P#-nnn#-mmm) FOR Physical cells relative to our current
C physical cell on the sheet (clamped at boundaries), or of form
C D#+nnn#+mmm etc for Display cells relative to our current display
C location as held in the DROW,DCOL cells in commons.
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	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.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6
CCC	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6
CCC	InTeGer*4 PROW,PCOL
C ! PHYSICAL ROW, COL BEING HANDLED.
CCC	InTeGer*4 DROW,DCOL,DCLV,DRWV
	InTeGer*4 RSM,CSM,AFG,ASM,VCF,CH
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	LOGICAL*4 L1,L2
C	LOGICAL*2 L63,L192,L127
	InTeGer*4 I1,I2
	InTeGer*4 I63,I192,I127
	EQUIVALENCE(I1,L1),(I2,L2)
C	EQUIVALENCE (I63,L63),(I192,L192),(L127,I127)
	DATA I63/63/,I192/192/,I127/127/
C DRWV,DCLV = # OF MAX ROWS, COLS ACTUALLY ON SCREEN NOW. DROW,DCOL
C ARE ACTUAL "CURSOR" LOCATION.
C
C ZERO OUR VARIABLES
	LPFG=0
C ! FLAG WE GOT A LOGICAL/PHYSICAL # FORM AND TYPE
	AFG=0
C ! FLAG WE SAW AN ALPHA
	ASM=0
C ! SUM OF ALPHAS HASHCODED (ACCUMULATOR)
	NSM=0
C ! ACCUMULATOR FOR NUMERICS
	NFG=0
C ! FLAG WE SAW A NUMERIC
	RSM=0
C ! AC FOR ROWS IN # FORMS
	CSM=0
C ! AC FOR COLS IN # FORMS
	ISPC=0
C ! COUNTER FOR NONSPACES SEEN (USED TO STOP ON TRAILING SPACES)
	idol1=0
	idol2=0
	IF(LINE(IBGN).NE.'%')GOTO 2000
	ID1=27
	ID2=1
	IVALID=1
	LSTCHR=IBGN+1
C SPECIAL CASE FOR % = AC #27
	RETURN
2000	CONTINUE
	DO 1 N=IBGN,LEND
	VCF=0
	LSTCHR=N
	CH=ICHAR(LINE(N))
	IF (CH.EQ.255)GOTO 5000
C 5000 DECODES ENCODED FORMS AND RETURNS THEM...
C
C IGNORE SPACES AND TABS IF LEADING
	IF(CH.GT.32)ISPC=ISPC+1
	IF(CH.GT.0.AND.CH.LE.32.AND.ISPC.EQ.0)GOTO 1
C SPECIAL CASE TRAILING DOLLAR SIGNS... SKIP AND FLAG
	IF(CH.NE.36)GOTO 3443
C 36 IS ASCII FOR $ SIGN
C SAW A DOLLAR SIGN
	IF(AFG.EQ.1.AND.NFG.EQ.0)IDOL1=1
	IF(AFG.EQ.1.AND.NFG.EQ.1)IDOL2=1
C LEAVES WITH IDOL1 FLAGGED AS 1 IF LETTER PART WAS FOLLOWED BY
C DOLLAR SIGN, AND IDOL2 FLAGGED IF NUMBER PART WAS FOLLOWED
C BY DOLLAR. IGNORES ALL OTHER DOLLAR SIGNS.
	GOTO 1
3443	CONTINUE
C GET CHARACTER VALUE IN.
C MUST BE UPPERCASE.
	IF(.NOT.(CH.GE.65.AND.CH.LT.91)) GOTO 100
C CH IS AN ALPHA, RANGE A-Z
	VCF=1
C ! VALID CHAR SEEN
	AFG=1
C !SAW THE ALPHA
	IF(ASM.LT.18060)ASM=(CH-64)+26*ASM
	IF(NFG.NE.0)GOTO 103
C FILTER OUT TOO-LARGE VALUES...
	IF(ASM.GT.18000)GOTO 103
C 60 * 26 IS LIM ABOVE
	IF(CH.EQ.80)LPFG=1
C ! FLAG WE GOT PHYS. FORM MAYBE
	IF(CH.EQ.68)LPFG=2
C ! FLAG WE GOT DISPLAY FORM MAYBE
100	CONTINUE
C EXPECT # FORMS TO HAVE # JUST AFTER 1ST ALPHA.
C 35 IS ASCII VALUE OF '#' CHAR.
	IF(CH.EQ.35)GOTO 1000
C NEXT TEST NUMERICS
	IF(.NOT.(CH.GE.48.AND.CH.LE.57))GOTO 101
C CH IS A NUMERIC, RANGE 0-9
	VCF=1
C ! VALID CHAR SEEN
	NFG=1
C ! FLAG WE SAW NUMERIC
	IF(AFG.NE.0)GOTO 102
	GOTO 103
102	CONTINUE
	IF(NSM.LT.18060)NSM=(CH-48)+10*NSM
C FILTER OUT TOO-LARGE VALUES EARLY
C 301 * 10 IS LIMIT...
	IF(NSM.GT.18000)GOTO 103
C ! CONVERT CHARS TO BINARY AS SEEN
101	CONTINUE
	IF(VCF.EQ.0)GOTO 2
C !END ON ANY INVALID CHARACTER
1	CONTINUE
2	CONTINUE
	IF(AFG.EQ.0)GOTO 103
	GOTO 950
103	CONTINUE
C INVALID ... NUMERIC AND NO PRIOR ALPHA. FLAG BAD NAME AND EXIT.
	IVALID=0
	RETURN
950	ID1=ASM
	ID2=1+NSM
C ! NOTE ID2=1 IF NO NUMERICS SEEN, MORE OTHERWISE.
	GOTO 1201
1000	CONTINUE
C HERE HANDLE CURRENT-REFERENCED FORMS USING # AS SPECIAL CHARACTER MEANING
C THE CURRENT POSITION. THESE TYPES OF REFERENCES MAY BE MOVED AROUND THE
C SHEET WHICH ACCOUNTS FOR THEIR USEFULNESS. SINCE THERE IS A DISPLAY
C AND PHYSICAL SHEET WHICH ARE MAPPED BY A MAPPING, ALLOW EITHER
C TO BE REFERENCED. THUS, COMPLEX CALCULATIONS MAY BE DONE BUT LARGELY
C HIDDEN. THE ACCUMULATORS MAY BE USED AS SCRATCH STORAGE FOR THIS
C SORT OF THING.
C SAW THE # SIGN, SO SEE IF THE + OR - N CAN BE DECODED.
C IF NO P OR D WAS SEEN HOWEVER WE HAVE AN INVALID NAME, SO FLAG IT.
	IF(LPFG.EQ.0)GOTO 103
C PASS THE # SIGN PRIOR TO GETTING THE NUMERIC.
	LSTCHR=LSTCHR+1
	if(line(lstchr).ne.'%')goto 3900
c allow p#%ab form to mean use ac a and b to get offsets from "here"
	CSM=0
	RSM=0
C DEFAULT TO "THIS" CELL
	LSTCHR=LSTCHR+1
C PASS THE % SIGN
	RSM=ICHAR(LINE(LSTCHR))
	CSM=ICHAR(LINE(LSTCHR+1))
	LSTCHR=LSTCHR+2
C FIX UP ASCII OFFSETS, AND MEANWHILE REQUIRE UPPERCASE
C AND THAT THERE BE 2 AC'S NAMES AFTER THE %.
C THIS SHOULD BE HANDY FOR COMMAND FILES.
	RSM=RSM-64
	CSM=CSM-64
C NOW RSM, CSM ARE SUBSCRIPTS. PULL OUT VALUES FROM XVBLS
	IF(RSM.LE.0.OR.RSM.GT.27)GOTO 103
	IF(CSM.LE.0.OR.CSM.GT.27)GOTO 103
	DO 3902 IV=1,8
3902	XAV1(IV)=AVBLS(IV,RSM)
	RSM=XAVB
	DO 3903 IV=1,8
3903	XAV1(IV)=AVBLS(IV,CSM)
	CSM=XAVB
C LOADS THE 2 AC'S TO THE OFFSETS AND GOES ON...JUST NEEDS THE
C 2 LETTERS AFTER P#% OR D#%.
	goto 3901
3900	continue
	CALL GN(LSTCHR,LEND,NUM,LINE)
C GN GETS THE +- NN NUMBER AND RETURNS VALUE IN NUM.
C LSTCHR RETURNS AS NEXT CHAR NOT USED.
	RSM=NUM
C 35 IS ASCII FOR '#'
C allow any delimiter between numbers, though we must have # at start
C  to delimit valid relative coordinates.
C	IF(ICHAR(LINE(LSTCHR)).NE.35) GOTO 103
C IF NO SECOND # SEEN, THE FORM IS INVALID SO SAY SO AND EXIT.
	LSTCHR=MIN0(LSTCHR+1,LEND)
CC BUMP PAST THE # IF WE SAW IT.
C now get the second numeric string and bump LSTCHR past it.
	NUM=0
	CALL GN(LSTCHR,LEND,NUM,LINE)
	CSM=NUM
C NOW HAVE THE NUMBERS ENCODED. NOTE THAT ## IS VALID.
3901	CONTINUE
	IF(LPFG.EQ.2) GOTO 1200
C IF HERE, LPFG=1 AND WE ARE ON PHYSICAL SHEET.
	ID2=CSM+PCOL
	ID1=RSM+PROW
1201	CONTINUE
C TO ALLOW REFLECTED VALUES TO WORK, LET ALL NORMAL VALUES BY...
C	IF(ID1.GT.60.OR.ID1.LE.0)GOTO 103
C	IF(ID2.GT.301.OR.ID2.LE.0)GOTO 103
	IVALID=1
C ALL IS WELL
	RETURN
1200	CONTINUE
C DISPLAY COLUMN RELATIVE.
	DLFG=1
C FLAG WE SAW A D## FORM FOR RECALC
	DRRW=DROW+RSM
	DRRW=MAX0(1,DRRW)
	DRRW=MIN0(20,DRRW)
	DCCL=DCOL+CSM
C ENSURE DISPLAY COORDS IN LEGAL BOUNDS
	DCCL=MAX0(1,DCCL)
	DCCL=MIN0(75,DCCL)
C CLAMP TO WITHIN LEGAL DIMENSIONS.
	ID1=NRDSP(DRRW,DCCL)
	ID2=NCDSP(DRRW,DCCL)
	GOTO 1201
5000	CONTINUE
	IF(ASM.NE.0.OR.NSM.NE.0)GOTO 103
C HANDLE 255,CODE1,CODE2 FORMS
C FIRST BYTE IS ALWAYS 255
C 2ND BYTE IS: HI 2 BITS ARE HI 2 BITS OF ID2. LO 6 BITS ARE ID1
C 3RD BYTE IS: LO 8 BITS OF ID2
	I1=ICHAR(LINE(LSTCHR+1))
	I2=IMASK(I1,I192)
C	L2=L1.AND.L192
C	L1=L1.AND.L63
	I1=IMASK(I1,I63)
	ID1=I1
	I1=ICHAR(LINE(LSTCHR+2))
C	L1=L1.AND.L127
	I1=IMASK(I1,I127)
C MUST HAVE 128 BIT ON IN LOW BYTE TO AVOID NULLS IN IT.
	ID2=I2*2+I1
	LSTCHR=LSTCHR+3
	GOTO 1201
	END
c -h- vvary.for	Fri Aug 22 13:37:17 1986	
C $DO66
C VARY CONTROL ROUTINE
C NOTE: THIS ROUTINE RELIES UPON HAVING ITS DATA AREAS REMAIN INTACT
C ACROSS CALLS. IT MUST NOT BE IN AN OVERLAY SEGMENT OR THAT WILL FAIL
C AND IT WILL NOT WORK. SPECIFICALLY IT EXPECTS THE AC ARRAY TO BE
C SET CORRECTLY.
	SUBROUTINE VVARY(LINE,RETCD,K)
	CHARACTER*1 LINE(80)
	INTEGER RETCD
	CHARACTER*1 AVBLS(20,27),WRK(128),VBLS(8,1,1)
	InTeGer*4 TYPE(1,1),VLEN(9)
	REAL*8 XAC,XVBLS(1,1)
	EQUIVALENCE(XAC,AVBLS(1,27))
	INTEGER*4 JVBLS(2,1,1)
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
C	InTeGer*4 IPS1,IPS2,MODFLG
	InTeGer*4 IC1POS,IC2POS,MODFLG
CCC	COMMON/ICPOS/IC1POS,IC2POS,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
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).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IC1POS,IC2POS,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	INTEGER KALKIT
CCC	COMMON/VARYIT/KALKIT
	EXTERNAL SIGN
	INTEGER LPUT,LGET
	REAL*8 SIGN
	CHARACTER*1 LAC(8)
	REAL*8 XVAC,VW
	EQUIVALENCE(LAC(1),XVAC)
	REAL *8 AC(26)
	REAL*8 DERIV(8)
	REAL*8 DEL(8)
	REAL*8 OLDVV,OLDX,OLDA
	INTEGER ACV(8)
	INTEGER CAC
	INTEGER CCNT(8)
C UNCOMMENT THIS COMMON DECLARATION AND MOVE DATA STMTS INTO BLOCK
C IN ORDER TO OVERLAY THIS...
	COMMON/VRYDAT/AC,DERIV,DEL,CAC,CCNT,OLDVV,OLDX,OLDA,ACV
C
C ACV POINTS TO AC'S VARYING
C CAC = CURRENT INDEX INTO ACV TO FIND AC BEING VARIED
C AC IS LAST SET OF ACCUMULATORS SEEN
C IF ACV ENTRY IS 0, MEANS NO AC TO VARY THERE.
	INTEGER LW,LX,LI
C ! LOGICAL W,X,I AC'S
	INTEGER LA
C ! LOGICAL A AC
C
C	DATA DERIV/8*1./,DEL/8*0./
C	DATA CAC/1/,CCNT/8*0/
C	DATA ACV/8*0/
C	DATA OLDVV/1./
C
C PARSE ARGUMENTS FIRST
C FIRST 2 ARGS ARE X AND A AC'S (OR GENERAL CELLS)
C DEFAULT NO REDOING THIS...
	KALKIT=0
	IBGN=K+5
	LEND=IBGN+20
	CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LX,ID2A,IVALID)
	IF (IVALID.EQ.0)GOTO 9900
	IF(LINE(LSTCHR).NE.',')GOTO 9900
	IBGN=LSTCHR+1
	LEND=IBGN+20
	CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LA,ID2B,IVALID)
	IF (IVALID.EQ.0)GOTO 9900
	IF(LINE(LSTCHR).NE.',')GOTO 9900
	IBGN=LSTCHR+1
	LEND=IBGN+20
	CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LW,ID3B,IVALID)
	IF (IVALID.EQ.0)GOTO 9900
	IF(LINE(LSTCHR).NE.',')GOTO 9900
	IF(ID3B.NE.1)GOTO 9900
	IBGN=LSTCHR+1
	LEND=IBGN+20
	CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LI,ID3B,IVALID)
	IF (IVALID.EQ.0)GOTO 9900
	IF(LINE(LSTCHR).NE.',')GOTO 9900
	IF(ID3B.NE.1)GOTO 9900
C	IBGN=LSTCHR+1
C	LEND=IBGN+20
C LOOP OVER VALUES TO VARY NOW
	DO 99 N=1,8
99	ACV(N)=0.
	DO 100 N=1,8
C ALLOW UP TO 8 DIMENSIONS VARIATION
	IBGN=LSTCHR+1
	LEND=IBGN+20
	CALL VARSCN(LINE,IBGN,LEND,LSTCHR,ACV(N),ID3B,IVALID)
	IF (IVALID.EQ.0)GOTO 9900
	IF(LINE(LSTCHR).NE.';')GOTO 110
	IF(ID3B.NE.1)GOTO 9900
	IBGN=LSTCHR+1
	LEND=IBGN+20
100	CONTINUE
110	CONTINUE
C NOW HAVE ALL AC POINTERS SET UP.
C IF I IS NOW 0 OR NEGATIVE (ITER COUNT), REINITIALIZE.
	ASSIGN 111 TO LGET
	LLL=LI
	GOTO 500
111	CONTINUE
	IF(XVAC.GT.0.)GOTO 112
C INITIALIZE COUNTS
	LLL=LW
C GET VALUE OF W FRACTION
	ASSIGN 114 TO LGET
	GOTO 500
114	CONTINUE
	VW=XVAC
	OLDVV=1.
	DO 113 N=1,8
	CCNT(N)=0
	DERIV(N)=1.
	DEL(N)=VW
113	CONTINUE
	CAC=1
C COPY CURRENT AC'S INTO SAVED ONES NOW.
	DO 117 N=1,26
	LLL=N
	ASSIGN 118 TO LGET
	GOTO 500
118	AC(N)=XVAC
117	CONTINUE
C AFTER THE INIT, JUST RETURN SINCE WE DON'T WANT TO TRY ANY ITERATIONS
C WHEN ITER COUNT EXPIRES.
	KALKIT=0
	RETURN
C HERE WHEN ITER COUNT IS POSITIVE.
112	CONTINUE
	XVAC=XVAC-1.
C UPDATE ITERATION COUNT NOW...
	KALKIT=XVAC
	ASSIGN 120 TO LPUT
	GOTO 600
120	CONTINUE
C
C NOW PROCEED WITH VARIATIONS...
	IF(CAC.LT.1.OR.CAC.GT.8)CAC=1
	IF(CCNT(CAC).GE.1)GOTO 200
C CCNT WAS 0 SO WE DIDN'T GET OUR PARTIAL YET. VARY THE
C AC WE'RE LOOKING AT (CAC = CURRENT AC) AND USE NEW VALUE OF
C (X-A) FOR A NUMERICAL DERIVATIVE RESULT AFTER A RECALC OF SCREEN...
	CCNT(CAC)=1
C JUST STARTED THIS AC SO VARY BY THE APPROPRIATE DELTA AND
C EXIT, ALLOWING PARTIAL TO BE COMPUTED NEXT TIME.
	LLL=LW
	ASSIGN 400 TO LGET
	GOTO 500
400	CONTINUE
C GET W ACC. VALUE
	VW=XVAC
	IF(VW.EQ.0.)VW=.5
C GET CURRENT AC, FIND HOW TO UPDATE IT.
	LLL=ACV(CAC)
	IF(LLL.LE.0)GOTO 9900
	ASSIGN 121 TO LGET
	GOTO 500
121	CONTINUE
C NOW XVAC HAS CURRENT AC FOR THE ONE WE'RE VARYING
C ADD DEL TO IT AND GET NEW ONE...
C SAVE OLD X AC VALUE FOR NEXT ITERATION.
C NOTE LLL IS STILL SET AT CURRENTLY VARYING AC
C SAVE CURRENT (UNVARIED) VALUE TOO FOR NEXT TIME AROUND.
	OLDVV=XVAC
	IF(OLDVV.EQ.0.)OLDVV=1.
	IF(DEL(CAC).EQ.0.)DEL(CAC)=VW
	XVAC=XVAC*(1.+DEL(CAC))
C NOW ALL SET... JUST SAVE CURRENT AC'S AND CURRENT X,A
C SO WE CAN GET DIFFERENCE NEXT TIME AROUND.
C	AC(ACV(CAC))=XVAC
C STORE XVAC INTO REAL ACCUMULATORS TOO, SO IT'LL WORK
C WHEN ALL AC'S ARE RELOADED BELOW.
	ASSIGN 412 TO LPUT
	GOTO 600
412	CONTINUE
C AT 1000, RELOAD AC ARRAY FROM REAL AC'S... BUT GET OUR MODIFIED
C ONE WE JUST STORED TOO.
	GOTO 1000
200	CONTINUE
C COUNT HERE IS 1 SO WE ALREADY HAVE INFO NOW FOR OUR PARITAL
C DERIVATIVE. COMPUTE IT AND VARY THE SELECTED AC USING IT
C THEN STORE IT AND RESET CCNT(CAC) TO 0
	CCNT(CAC)=0
C MUST GET NEW X AND A VALUES NOW.
	CALL XVBLGT(LX,ID2A,XVAC)
C	XVAC=XVBLS(LX,ID2A)
	IF(ID2A.NE.1)GOTO 201
	LLL=LX
	ASSIGN 201 TO LGET
C EXTRACT CURRENT X FROM AVBLS
	GOTO 500
201	CONTINUE
	XCURR=XVAC
	CALL XVBLGT(LA,ID2B,XVAC)
C	XVAC=XVBLS(1,1)
	IF(ID2B.NE.1)GOTO 202
	LLL=LA
	ASSIGN 202 TO LGET
	GOTO 500
202	CONTINUE
	ACURR=XVAC
C NOW WE HAVE ENOUGH TO COMPUTE PARTIAL DERIVATIVE WE NEED.
	IF(ACV(CAC).LE.0)GOTO 9900
	IF(OLDVV.EQ.0.)OLDVV=AC(ACV(CAC))
	IF(OLDVV.EQ.0.)OLDVV=1.
	DERIV(CAC)=((XCURR-ACURR)-(OLDX-OLDA))/(DEL(CAC)*OLDVV)
C NEGATIVE FEEDBACK: IF GOING POSITIVE, MAKE IT NEGATIVE...
C THIS IS NOT AN ANALYTICAL PROCEDURE ... JUST STEPS IN RIGHT DIRECTION
C BY APPROPRIATE AMOUNT AND CONTINUES...
C CLAMP VARIATION TO INITIAL PERCENTAGE IN W ACCUMULATOR
	LLL=LW
C OBTAIN VALUE OF W VARIATION NOW...IN CASE USER SETS IT UP TO VARY
	ASSIGN 203 TO LGET
	GOTO 500
203	CONTINUE
	VW=XVAC
C
C TO ATTEMPT TO GET TO THE ZERO OF (X-A), WE REALLY NEED TO
C DIVIDE BY THE DERIVATIVE. HOWEVER, IN CASES WHERE THE FUNCTION
C IS NEAR ITS LOCAL MINIMUM AND SLOWLY VARYING, WE REALLY DON'T WANT
C TO STEP FAR AWAY (IT MAY NEVER REACH THE ZERO). THEREFORE, TEST
C TO SEE IF THE DERIVATIVE IS LARGE AND ALLOW DIVISION WHERE IT IS
C OVER A SOMEWHAT ARBITRARY THRESHOLD (USED 1.0 BELOW), BUT
C MULTIPLY BY DERIVATIVE OTHERWISE, SO THAT AS THE FUNCTION APPROACHES
C ZERO SLOPE, THE STEPS GET FINER TO GET INTO THE LOCAL MINIMUM (IF ANY).
C
C FORCE NONZERO VARIATION JUST SO WE DON'T GET STUCK.
	IF(DERIV(CAC).EQ.0.)DERIV(CAC)=.01
	IF(DABS(DERIV(CAC)).GT.1.)GOTO 405
	DEL(CAC)=-(OLDX-OLDA)*VW*DERIV(CAC)
	GOTO 406
405	CONTINUE
	DEL(CAC)=-(OLDX-OLDA)*VW/DERIV(CAC)
406	CONTINUE
C VERY IMPORTANT TO CLAMP SIZE OF STEPS HERE SO WE DON'T WILDLY DIVERGE
C IN EARLY GOING. SMALL STEPS TAKE LONGER BUT GET TO MINIMA; LARGER ONES
C WHERE WE DON'T KNOW FUNCTION SHAPE CAN BE DISASTERS.
	IF(DABS(DEL(CAC)).GT.VW)DEL(CAC)=VW*SIGN(DEL(CAC))
C NOW RESTORE AC'S TO OLD ONES AND VARY CURRENT ONE BY
C THE NEW DELTA.
	IF(ACV(CAC).LE.0)GOTO 9900
C NEXT LINE MAKES ADJUSTMENT NEEDED TO OUR VARYING AC.
	AC(ACV(CAC))=OLDVV*(1.+DEL(CAC))
C NOW COPY SAVED OLD AC'S ONTO NEW ONES SO WE START WITH AC'S ALL AS THEY
C WERE IN FIRST STEP SO WE VARY FROM INITIAL X, NOT FROM FIRST VARIED X
C LOCATION...
	DO 204 N=1,26
	XVAC=AC(N)
	LLL=N
	ASSIGN 205 TO LPUT
	GOTO 600
205	CONTINUE
204	CONTINUE
C MOVE ON TO THE NEXT CAC VALUE
	CAC=CAC+1
	IF(ACV(CAC).LE.0.OR.CAC.GT.8)CAC=1
1000	CONTINUE
C SAVE OLD AC'S NOW FOR NEXT TIME
	DO 1100 N=1,26
	LLL=N
	ASSIGN 1101 TO LGET
	GOTO 500
1101	AC(N)=XVAC
1100	CONTINUE
C REMEMBER OLD X AND A VALUES SINCE WE LOOK FOR X=A AS
C A SEARCH CONDITION. WE MUST ASSUME THAT SOME SORT OF
C VARIATION OF ACCUMULATORS GIVEN WILL ALLOW US TO SATISFY
C THE EQUATION (X-A)=0.
	OLDX=AC(LX)
	IF(ID2A.NE.1)CALL XVBLGT(LX,ID2A,OLDX)
C	IF(ID2A.NE.1)OLDX=XVBLS(LX,ID2A)
	OLDA=AC(LA)
	IF(ID2B.NE.1)CALL XVBLGT(LA,ID2B,OLDA)
C	IF(ID2B.NE.1)OLDA=XVBLS(LA,ID2B)
	RETURN
9900	CONTINUE
	RETCD=3
	RETURN
C PROC TO LOAD XVAC WITH VBLS(LLL)
500	CONTINUE
	DO 501 KKKKN=1,8
501	LAC(KKKKN)=AVBLS(KKKKN,LLL)
	GOTO LGET,(111,114,118,400,121,201,202,203,1101)
C PROC TO STORE XVAC INTO VBLS(LLL)
600	CONTINUE
	DO 601 KKKKN=1,8
601	AVBLS(KKKKN,LLL)=LAC(KKKKN)
	GOTO LPUT,(120,412,205)
	END
c -h- xqtcmd.for	Fri Aug 22 13:45:23 1986	
C $DO66
	SUBROUTINE XQTCMD(ICODE)
C COPYRIGHT (C) 1983,1984 GLENN AND MARY EVERHART
c All Rights Reserved
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.
	CHARACTER*1 FORM,FVLD,CMDLIN(132),CL127(127)
C ALLOCATE EXTRA SLOP SPACE AFTER CMDLIN
	CHARACTER*1 CLWW(136)
	EQUIVALENCE(CLWW(1),CMDLIN(1))
	CHARACTER*127 CMDLNA
	EQUIVALENCE(CMDLIN(1),CL127(1),CMDLNA(1:1))
C	EQUIVALENCE(CMDLNA,CMDLIN(1))
	CHARACTER*127 WRKCHR,FORMCH,fwt
C	equivalence(fwt(1:1),formch(1:1))
	CHARACTER*1 LET1,LET2,FORM2(128),NMSH(80)
	CHARACTER*1 WRKCHA(132),WRK127(127)
	EQUIVALENCE(WRKCHA(1),WRKCHR(1:1),WRK127(1),FORM2(1))
C	EQUIVALENCE(FORM2(1),WRK127(1))
C ***<<<< RDD COMMON START >>>***
	InTeGer*4 RRWACT,RCLACT
C	COMMON/RCLACT/RRWACT,RCLACT
	InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
C	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
C     1  IDOL7,IDOL8
	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
C	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
	InTeGer*4 KLVL
C	COMMON/KLVL/KLVL
	InTeGer*4 IOLVL,IGOLD
C	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.
	COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
     2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
C ***<<< RDD COMMON END >>>***
CCC	InTeGer*4 RRWACT,RCLACT
CCC	COMMON/RCLACT/RRWACT,RCLACT
	INTEGER*4 VNLT
	EXTERNAL INDX
c	EQUIVALENCE(FORM2(1),WRKCHR)
	COMMON/NMSH/NMSH
	REAL*8 XVBLS(1,1)
	INTEGER KPYBAK
CCC	Integer*4 FH
CCC	Common/CONSFH/FH
C ***<<< KLSTO COMMON START >>>***
	InTeGer*4 DLFG
C	COMMON/DLFG/DLFG
	InTeGer*4 KDRW,KDCL
C	COMMON/DOT/KDRW,KDCL
	InTeGer*4 DTRENA
C	COMMON/DTRCMN/DTRENA
	REAL*8 EP,PV,FV
	DIMENSION EP(20)
	INTEGER*4 KIRR
C	COMMON/ERNPER/EP,PV,FV,KIRR
	InTeGer*4 LASTOP
C	COMMON/ERROR/LASTOP
	CHARACTER*1 FMTDAT(9,76)
C	COMMON/FMTBFR/FMTDAT
	CHARACTER*1 EDNAM(16)
C	COMMON/EDNAM/EDNAM
	InTeGer*4 MFID(2),MFMOD(2)
C	COMMON/FRM/MFID,MFMOD
	InTeGer*4 JMVFG,JMVOLD
C	COMMON/FUBAR/JMVFG,JMVOLD
	COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
     1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
C ***<<< KLSTO COMMON END >>>***
CCC	InTeGer*4 JMVFG,JMVOLD
	INTEGER*4 JVBLS(2,1,1)
CCC	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.
C PUT JMVFG INTO A PSECT BY ITSELF SO IT WILL SURVIVE OVERLAYS.
CCC	COMMON/FUBAR/JMVFG,JMVOLD
	DIMENSION FORM(128),FVLD(1,1)
	CHARACTER*1 DFE,FVWRK,FVWRK2,FRM127(127)
	EQUIVALENCE(FORM(1),FORMCH(1:1),FRM127(1))
C	EQUIVALENCE(FORM(1),FRM127(1)),(FRM127(1),FORMCH)
	DIMENSION DFE(14)
	CHARACTER*14 CDFE
	EQUIVALENCE(CDFE(1:1),DFE(1))
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.
CCC	InTeGer*4 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6,
CCC     1  IDOL7,IDOL8

CCC	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6,
CCC     1  IDOL7,IDOL8
CCC	InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
CCC	InTeGer*4 LLCMD,LLDSP
CCC	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	DIMENSION NRDSP(20,75),NCDSP(20,75)
	COMMON/D2R/NRDSP,NCDSP
	InTeGer*4 ILNFG,ILNCT,RCF
C ***<<< NULETC COMMON START >>>***
	InTeGer*4 ICREF,IRREF
C	COMMON/MIRROR/ICREF,IRREF
	InTeGer*4 MODPUB,LIMODE
C	COMMON/MODPUB/MODPUB,LIMODE
	InTeGer*4 KLKC,KLKR
	REAL*8 AACP,AACQ
C	COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
	InTeGer*4 NCEL,NXINI
C	COMMON/NCEL/NCEL,NXINI
	CHARACTER*1 NAMARY(20,301)
C	COMMON/NMNMNM/NAMARY
	InTeGer*4 NULAST,LFVD
C	COMMON/NULXXX/NULAST,LFVD
	COMMON/NULETC/ICREF,IRREF,MODPUB,LIMODE,
     1  KLKC,KLKR,AACP,AACQ,NCEL,NXINI,NAMARY,NULAST,LFVD
C ***<<< NULETC COMMON END >>>***
CCC	COMMON/NCEL/NCEL,NXINI
	CHARACTER*1 ILINE(106)
	COMMON/ILN/ILNFG,ILNCT,ILINE
C ***<<< XVXTCD COMMON START >>>***
	CHARACTER*1 OARRY(100)
	InTeGer*4 OSWIT,OCNTR
C	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
C	InTeGer*4 IPS1,IPS2,MODFLG
	InTeGer*4 IC1POS,IC2POS,MODFLG
CCC	COMMON/ICPOS/IC1POS,IC2POS,MODFLG
C	COMMON/ICPOS/IPS1,IPS2,MODFLG
   	InTeGer*4 XTCFG,IPSET,XTNCNT
   	CHARACTER*1 XTNCMD(80)
C   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
C	COMMON/VARYIT/KALKIT
	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
	InTeGer*4 RCMODE,IRCE1,IRCE2
C	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
C     1  IRCE2
C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
C RCFGX ON.
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).
	INTEGER*4 FH
C FILE HANDLE FOR CONSOLE I/O (RAW)
C	COMMON/CONSFH/FH
	CHARACTER*1 ARGSTR(52,4)
C	COMMON/ARGSTR/ARGSTR
	COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IC1POS,IC2POS,MODFLG,
     1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
     2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
     3  IRCE2,FH,ARGSTR
C ***<<< XVXTCD COMMON END >>>***
CCC	InTeGer*4 IC1POS,IC2POS,MODFLG
CCC	COMMON/ICPOS/IC1POS,IC2POS,MODFLG
CCC	CHARACTER*1 OARRY(100)
CCC	InTeGer*4 OSWIT,OCNTR
CCC	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTeGer*4 TYPE(1,1),VLEN(9)
	CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
	CHARACTER*1 FVLDTP
	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))
CCC	InTeGer*4 NULAST,LFVD
CCC	COMMON/NULXXX/NULAST,LFVD
CCC	CHARACTER*1 ARGSTR(52,4)
CCC	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
CCC	COMMON/KLVL/KLVL
	CHARACTER*1 DEFVB(12)
CCC	InTeGer*4 MODPUB,LIMODE
CCC	COMMON/MODPUB/MODPUB,LIMODE
	COMMON/DEFVBX/DEFVB
CCC	InTeGer*4 FORMFG,RCFGX,PZAP,RCONE,RCMODE,
CCC     1  IRCE1,IRCE2
CCC	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,
CCC     1  IRCE1,IRCE2
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*4 CWIDS(20)
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 20 NOT 75.
	REAL*8 DVS(20,75)
	INTEGER*4 LDVS(2,20,75)
	EQUIVALENCE(LDVS(1,1,1),DVS(1,1))
	COMMON /FVLDC/FVLD
C	CHARACTER*1 DFMTS(10,20,75)
C 10 CHARACTERS PER ENTRY.
	COMMON/DSPCMN/DVS,CWIDS
C THISRW,THISCL = CURRENT DISPLAYED LOCS.
	InTeGer*4 THISRW,THISCL
C	CHARACTER*1 IBITMP(2258)
C	COMMON/INITD/IBITMP
C FOLLOWING COMMON IS TO CONTROL "EXTERNAL" CALL OF XQTCMD
C TO ALLOW USE FROM INSIDE CELLS.
CCC	CHARACTER*1 XTNCMD(80)
CCC	InTeGer*4 XTCFG,XTNCNT,IPSET
CCC	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
	CHARACTER*1 blanks
	dimension blanks(30)
	data blanks/30*' '/
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 AR/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. 17 = 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 FNAMEARGS,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.
C	IRRX=(PCOL-1)*60+PROW
	CALL REFLEC(PCOL,PROW,IRRX)
	CALL WRKFIL(IRRX,FORM2,0)
	CALL CE2A(FORM2,FORM)
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(ICHAR(FVLD(N1,N2)).EQ.0)GOTO 200
C ONLY REDRAW NUMBERS. DIRECT DISPLAY OR NOTHING GETS IGNORED.
	J=8
C	IRRX=(N2-1)*60+N1
	CALL REFLEC(N2,N1,IRRX)
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 0 = 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(1,ICCC,J)
C SELECT ROW "THISCL", COL "J"
	CALL UVT100(13,7,0)
	CALL FVLDGT(N1,N2,FVLD(1,1))
C	IF(FVLD(1,1).EQ.0)WRITE(6,5538)
C5538	FORMAT('>-<')
	ivv=min0(30,cwids(DROW))
c reset blanks to be sure we write something even for vt52
ccc	blanks(1)='>'
	IF(ICHAR(FVLD(1,1)).EQ.0)CALL SWRT(BLANKS,IVV)
ccc	blanks(1)=32
cccccc no VT52's in PCs...
C5538	FORMAT(1H+,30(a1,'\'))
3607	CONTINUE
C WE CAN BE SURE THE COLUMN IS 3 WIDE OR MORE...
	CALL FVLDGT(N1,N2,FVLDTP)
	IF(ICHAR(FVLDTP).EQ.0)GOTO 200
C	IRRX=(N2-1)*60+N1
C SELECT REVERSE VIDEO
	DO 5540 KKKK=1,100
5540	CMDLIN(KKKK)=char(32)
	CALL WRKFIL(IRRX,FORM2,0)
	CALL CE2A(FORM2,FORM)
d	write(*,1094)n1,n2,(form(kkkk),kkkk=1,40)
d1094   format(' Decoded x cell',2i10,'=',40a1)
C	READ(7'IRRX)FORM
C	IF(JCHAR(FORM(120)).LE.0)GOTO 200
	IF(JCHAR(FVLDTP).LT.0.OR.FORMFG.NE.0)
     1  WRITE(CMDLNA(1:127),8201)(FORM(II),II=1,100)
8201	FORMAT(128A1)
	IF(FORMFG.NE.0)GOTO 4320
	DO 6301 KKK=1,9
	KKKK=ICHAR(FORM(KKK+119))
C	KKKK=DFMTS(KKK,THISRW,THISCL)
6301	DFE(KKK+1)=CHAR(MAX0(32,KKKK))
	DFE(11)=CHAR(32)
C 32 = ASCII SPACE
	DFE(1)='('
	DFE(12)=' '
	DFE(13)=' '
	DFE(14)=')'
d	write(*,1093)dfe
d1093	format(' DFE (xqtcmd) format=',14a1,';')
	CALL TYPGET(N1,N2,TYPE(1,1))
	IF(TYPE(1,1).EQ.2.AND.JCHAR(FVLDTP).GT.0)
     1  WRITE(CMDLNA(1:127),DFE,ERR=4320)DVS(THISRW,THISCL)
	IF(TYPE(1,1).NE.2.AND.JCHAR(FVLDTP).GT.0)
     1   WRITE(CMDLNA(1:127),DFE,ERR=4320)LDVS(1,THISRW,THISCL)
C REDRAW THIS COL. WITH REVERSE VIDEO HERE.
4320	IF(PZAP.EQ.0)CALL SWRT(CMDLIN,CWIDS(THISRW))
C9800	FORMAT('+',128(A,'\'))
9000	FORMAT(128A1)
	IF(PZAP.EQ.0)CALL UVT100(13,0,0)
C NOTE THIS REDRAWS PREVIOUS COL. IN REVERSE VIDEO.
C NO CARRIAGE CTL
200	CONTINUE
	IF(PZAP.NE.0)GOTO 3608
	KKKK=JCHAR(FVLDTP)
C SKIP LAST LINE UPDATE IF NOT NEEDED FOR SPEEDIER CURSOR
C POSITIONING.
	IF(NULAST.EQ.NCEL.AND.LFVD.EQ.0.AND.KKKK.EQ.0)GOTO 222
	CALL UVT100(1,LLDSP,1)
	CALL UVT100(12,2,0)
	IF(JCHAR(FORM(1)).LE.0)GOTO 222
	DO 1711 IVVVV=1,109
    	IVV=110-IVVVV
	IF(JCHAR(FORM(IVV)).GT.32)GOTO 2711
1711	CONTINUE
2711	CONTINUE
d	write(*,4092)ncel,form(1),form(2),form(3)
d4092	format(' Xqtcmd ncel prt=',i9,' form 1-3=',3a1)
	write(fwt(1:127),9092)ncel,(form(ii),ii=1,IVV)
9092	FORMAT(1X,I5,' Used. Curr=',109A1)
	IVV=IVV+18
	call swrt(fwt(1:127),IVV)
C3608	CONTINUE
222	CALL UVT100(1,LLCMD,1)
	NULAST=NCEL
	LFVD=KKKK
	CALL UVT100(12,2,0)
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(13,0,0)
C WRITE OUT LABEL WITH APPROPRIATE SIZE TO HOLD ROW NUMBER
C LET PROMPT END WITH > OR : DEPENDING ON OPERATING MODE.
	FVLDTP='>'
	IF(MODPUB.EQ.1)FVLDTP=':'
d	write(*,4091)prow,pcol,fvldtp
d4091	format(' prow, pcol, mode char=',2i10,4a1)
	IF(PCOL.GE.10000)GOTO 6401
	ii=pcol-1
	write(fwt(1:127),9001,err=3608)
     1   (form(i),i=1,4),ii,FVLDTP
C	FORM(9)=FVLDTP
	III=9
	GOTO 6402
6401	CONTINUE
	ii=pcol-1
	write(fwt(1:127),9401,err=3608)
     1   (form(i),i=1,4),ii,FVLDTP
C	FORM(10)=FVLDTP
	III=10
6402	CONTINUE
	CALL SWRT(fwt(1:127),III)
9401	FORMAT(4A1,I5,1A1)
9001	FORMAT(4A1,I4,1A1)
3608	CONTINUE
	IF(XTCFG.NE.0)GOTO 3870
	Rewind 11
	IF(IOLVL.NE.11.or.FH.eq.0)READ(IOLVL,9002,END=510,ERR=510)CMDLIN
C FOR READING THE CONSOLE, WE NEED A QIO$ TO CAPTURE ESCAPE SEQUENCES.
	IF(IOLVL.EQ.11.and.FH.ne.0)CALL GETTTL(CMDLIN)
	CALL GTMUNG(CMDLIN)
C ALLOW CMD LANGUAGE TO LOOK MORE "STANDARD" VIA MUNGE OF INPUTS
C TO DO THE "EV" OR "ET" OR "EN" FOR USER AND TREAT / AS CMD
C PREFIX...
	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)=Char(0)
	CMDLIN(XTNCNT+2)=Char(0)
3871	CONTINUE
9002	FORMAT(64A1,64A1,32A1)
	CMDLIN(132)=Char(0)
	CMDLIN(131)=Char(0)
	CMDLIN(130)=Char(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(ICHAR(CMDLIN(K)).GT.32)GOTO 9049
	CMDLIN(K)=Char(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(1,LLCMD,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(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 WASSIG(10,CMDLIN(4))
	GOTO 9990
4291	CONTINUE
C
C
C ALLOW COMMENTS IF LINE BEGINS WITH * (JUST LIKE CALC)
	IF(CMDLIN(1).NE.'*')GOTO 6002
	ICODE=1
C NO RECALC JUST FOR COMMENTS...
	GOTO 9990
6002	CONTINUE
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=5
	CALL UVT100(1,LLCMD,1)
	CALL UVT100(12,2,0)
	CALL VWRT(CMDLIN(2),49)
C	WRITE(0,9800)(CMDLIN(IV),IV=2,50)
	READ(11,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(ICHAR(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 CONTROL SCROLLING. PERMIT THE COMMAND "SC" TO TURN SCROLLING ON
C AND "NS" TO TURN IT BACK OFF.
	IVV=-1
	IF(CMDLIN(1).EQ.'S'.AND.CMDLIN(2).EQ.'C')IVV=1
	IF(CMDLIN(1).EQ.'N'.AND.CMDLIN(2).EQ.'S')IVV=0
	IF(IVV.GE.0)IDOL7=IVV
	IF(IVV.GE.0)ICODE=5
	IF(IVV.GE.0)GOTO 9990
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=5
	IF(XAC.GT.0..AND.IOLVL.NE.11)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 RASSIG(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.'O'.OR.CMDLIN(2).NE.'V')GOTO 6887
C OV + TURNS ON OVERRIDE
C OV - TURNS OFF OVERRIDE
C ALLOWS ONE TO OVERRIDE $ SIGN FORMS' ABSOLUTE NATURE
	IF(CMDLIN(3).EQ.'+'.OR.CMDLIN(4).EQ.'+')IDOL3=1
	IF(CMDLIN(3).EQ.'-'.OR.CMDLIN(4).EQ.'-')IDOL3=0
	GOTO 9990
6887	CONTINUE
	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=60-PROW-IABS(ICNT)+1
C LET THIS WORK ONLY ON PRIME SHEET. TOO HARD TO FIGURE IT OUT ON REFLECTED
C ONES AND IT'LL FOUL LOTS OF USERS UP.
	IF(KD.LE.0)GOTO 9990
C CAN'T MOVE 0 COLUMNS. DOESN'T MAKE SENSE.
	DO 8842 KR=1,KD
	IRA=60-KR+1
C IRA IS DESTINATION COLUMN IN EACH LOOP.
	IF(ICNT.LT.0)IRA=PROW-1+KR
C IRS IS SOURCE COLUMN
	IRS=60-KR+1-ICNT
	IF(ICNT.LT.0)IRS=PROW+KR-ICNT-1
C
C IF DELETING COLUMNS AND DESTINATION IS PAST CURRENT
C ACTIVE MAX, SKIP THE MOVE SINCE WE'RE NOT ACCOMPLISHING ANYTHING.
	IF(ICNT.LT.0.AND.IRA.GT.RRWACT)GOTO 8842
C IF ADDING COLUMNS AND SOURCE IS PAST CURRENT MAX ACTIVE THEN
C WE'RE DOING NOTHING, SO SKIP THE WORK
	IF(ICNT.GT.0.AND.IRS.GT.RRWACT)GOTO 8842
	JDELT=RCLACT
C	JDELT=301
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
C RELY ON RCLACT HAVING BEEN UPDATED TO REFLECT NEW
C ADDITIONS IF ANY
	KY=RCLACT
C	KY=301
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(ICHAR(FVLD(1,1)).NE.1)GOTO 3601
C ONLY RELOCATE FORMULAS, NOT TEXT OR NUMBERS (OR EMPTIES...)
C	IRX=(KK2-1)*60+KK
	CALL REFLEC(KK2,KK,IRX)
	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=301-PCOL-IABS(ICNT)+1
	IF(KD.LE.0)GOTO 9990
	DO 8839 KC=1,KD
C ICA = DESTINATION AND ICS IS SOURCE
	ICA=301-KC+1
	ICS=301-KC+1-ICNT
	IF(ICNT.GT.0)GOTO 8838
	ICA=PCOL-1+KC
	ICS=PCOL+KC-1-ICNT
8838	CONTINUE
C IF INSERTING ROWS AND SRC ROW IS BEYOND ACTIVE AREA, SKIP
	IF(ICNT.GT.0.AND.ICS.GT.RCLACT)GOTO 8839
C IF DELETING ROWS AND DST ROW IS BEYOND ACTIVE AREA, SKIP
	IF(ICNT.LT.0.AND.ICA.GT.RCLACT)GOTO 8839
C NOW CALL COPY LOOP AGAIN.
	JDELT=RRWACT
C	JDELT=60
	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=RRWACT
C	KX=60
	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,19)
	LCO=MIN0(LCO,74)
C	LRO=MIN0(LRO,(20-1))
C	LCO=MIN0(LCO,(75-1))
C NOW HAVE CORRECT ORIGIN IN DISPLAY SHEET TO USE SET UP.
C GRAB VARIABLE ID.
	LA=INDX(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.
	IQQ=0
	KKKK=0
	IF(CMDLIN(3).NE.'D')GOTO 6712
c allow ORA or ORD commands to leave window displacements
c alone. Fix up so this is default mode for scrolling (making
c program behavior easier to understand.)
7112	CONTINUE
	KKKK=1
6712	CONTINUE
	KKKKK=NRDSP(LRO,LCO)
	KKKKKK=NCDSP(LRO,LCO)
5711	CONTINUE
C TO ALLOW REFLECTIONS MUST ALLOW ALL SORTS OF ORIGINS.
	DO 652 IRO=LRO,DRWV
	DO 653 ICO=LCO,DCLV
C HERE CAN SET UP NRDSP AND NCDSP SUITABLY
	IVV=IRO-LRO
	IVVV=ICO-LCO
	IF(KKKK.EQ.0)GOTO 1653
	IVV=NRDSP(IRO,ICO)-KKKKK
	IVVV=NCDSP(IRO,ICO)-KKKKKK
1653	CONTINUE
	NRDSP(IRO,ICO)=ID1+IVV
	NCDSP(IRO,ICO)=ID2+IVVV
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=6
	IF(RCMODE.LE.0)GOTO 9990
C SKIP RECALC IF IN OLD MODE...
	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=INDX(CMDLIN,32)
C PASS SPACE
	KKK=ICHAR('/')
	LB=INDX(CMDLIN(LA+1),KKK)
	LB=LB+LA
C LB= LOC OF / CHARACTER
	LB=MIN0(80,LB)
	IF(LB.LE.2)GOTO 1741
	IF((LB-LA).LE.1) GOTO 1741
	CMDLIN(LB)=0
	CALL RASSIG(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)=Char(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,char(255))
C	FVLD(ID1,ID2)=-1
C	IRX=(ID2-1)*60+ID1
	CALL REFLEC(ID2,ID1,IRX)

	CALL WRKFIL(IRX,FORM,0)
C	READ(7'IRX)FORM
	FORM(119)=Char(255)
	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)
1747	CONTINUE
1746	CONTINUE
1742	CLOSE(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=INDX(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)
C	IRX=(PCOL-1)*60+PROW
	CALL REFLEC(PCOL,PROW,IRX)
C FIND WHERE IN FILE TO STORE.
	CALL WRKFIL(IRX,FORM2,0)
	CALL CE2A(FORM2,FORM)
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
	IRCE1=PROW
	IRCE2=PCOL
C SAVE FOR RE, RI MODES
	IF(CMDLIN(2).EQ.'T'.OR.CMDLIN(2).EQ.'"')KSG=1
C "ET" FORMULA ENTERS TEXT ONLY
C "EV" FORMULA ENTERS NUMBER
	IF(CMDLIN(2).EQ.'V')NSG=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).EQ.'P'.AND.
     1  CMDLIN(LA+1).EQ.'#'.AND.
     2  CMDLIN(LA+2).EQ.'0'.AND.
     3  CMDLIN(LA+3).EQ.'#'.AND.
     4  CMDLIN(LA+4).EQ.'0') GOTO 3356
	IF(ICHAR(CMDLIN(LA)).GE.ICHAR('@').AND.ICHAR(CMDLIN(LA))
     1  .LE.ICHAR('Z'))NXNUM=1
3356	CONTINUE
	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(ICHAR(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(ICHAR(FORM(119)).NE.0)GOTO 7903
C LEAVE DISPLAY INDICATOR ALONE IF SET BUT SET VBL OTHERWISE.
	IVVVV=NSG*NXNUM
	FORM(119)=CHAR(IVVVV)
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=JCHAR(FORM(119))
	IF(IVVVV.NE.0)FORM(119)=CHAR(ISGN(IVVVV)*NXNUM)
	IF(NALF.LE.0)GOTO 6221
	CALL FVLDST(PROW,PCOL,FORM(119))
C ENCODE CELL NAMES PRIOR TO STORING
	CALL CA2E(FORM,FORM2)
	CALL WRKFIL(IRX,FORM2,1)
6221	CONTINUE
	ASSIGN 7904 TO NBK
	GOTO 7905
C LOOK UP PROW, PCOL, LEAVE DISPLAY COORDS IN LR,LC
7905	CONTINUE
	DO 7906 LA1=1,DRWV
	LR=LA1
	DO 7906 LA2=1,DCLV
	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,8901,8957)
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.
	LRO=1
	LCO=1
	ID1=NRDSP(1,1)
	ID2=NCDSP(1,1)
	IF(.NOT.(JMVFG.EQ.51.AND.THISRW.EQ.1))GOTO 7110
C MUST SCROLL LEFT
	IF(IDOL7.EQ.0)GOTO 7110
	IF(ID1.LE.1)GOTO 7110
	ID1=MAX0(1,ID1-DRWV+2)
	DROW=MAX0(1,DRWV-2)
	IQQ=1
	GOTO 7112
7110	CONTINUE
	IF(JMVFG.EQ.51)THISRW=MAX0(1,(THISRW-1))
	IF(.NOT.(JMVFG.EQ.52.AND.THISRW.EQ.DRWV))GOTO 7116
C MUST SCROLL RIGHT
	IF(IDOL7.EQ.0)GOTO 7116
	DROW=3
C	ID1=MIN0(60,ID1+DRWV-MIN0(DRWV,2))
	ID1=ID1+DRWV-MIN0(DRWV,2)
	IQQ=1
	GOTO 7112
C 7112 FAKES OUT OA CALL TO SCROLL OVER.
7116	CONTINUE
	IF(JMVFG.EQ.52)THISRW=MIN0((THISRW+1),DRWV)
	IF(.NOT.(JMVFG.EQ.49.AND.THISCL.EQ.1))GOTO 7117
C MUST SCROLL UP
	IF(IDOL7.EQ.0)GOTO 7117
	IF(ID2.LE.2)GOTO 7117
	DCOL=MAX0(1,DCLV-2)
	ID2=MAX0(2,ID2-DCLV+2)
	IQQ=1
	GOTO 7112
7117	CONTINUE
	IF(JMVFG.EQ.49)THISCL=MAX0(1,(THISCL-1))
	IF(.NOT.(JMVFG.EQ.50.AND.THISCL.EQ.DCLV))GOTO 7118
C MUST SCROLL DOWN
	IF(IDOL7.EQ.0)GOTO 7118
	DCOL=3
C	ID2=MIN0(301,ID2+DCLV-MIN0(DCLV,2))
	ID2=ID2+DCLV-MIN0(DCLV,2)
	IQQ=1
	GOTO 7112
7118	CONTINUE
	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)=DVS(LR,LC)+.0000000057
	DVS(DROW,DCOL)=DVS(DROW,DCOL)+.000000062
7901	GOTO 9990
8000	IF(CMDLIN(1).NE.'M')GOTO 8001
	ICODE=1
C MACROCELL COMMAND IF MH (HIDE) OR MS (SHOW)
	IF(CMDLIN(2).EQ.'S')IDOL4=1
	IF(CMDLIN(2).EQ.'H')IDOL4=0
	IF(CMDLIN(2).EQ.'S'.OR.CMDLIN(2).EQ.'H')GOTO 9990
C MOVE COMMAND
C M1,M2,M3,M4 MOTION DIRECTION IS U,D,L,R
	IVVV=ICHAR(CMDLIN(2))
C ALLOW M0 TO MEAN RESTORE PRIOR STATE OF AUTOMOVE AND
C SAVE CURRENT STATE AS NEW PRIOR ONE. M1 THRU M5 MEAN SET
C AUTOMOVE TO 1-5 (5=NO MOTION) AND SAVE OLD STATE AS LAST
C STATE.
	IF(CMDLIN(2).EQ.'0')IVVV=JMVOLD
	JMVOLD=JMVFG
	JMVFG=IVVV
C	JMVFG=ICHAR(CMDLIN(2))
C STORE CHARACTER AS MOVE FLAG
	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
C	IF(NBR.LE.0.OR.NBR.GT.MAX0(20,75))GOTO 9990
	IF(NBR.LE.0.OR.NBR.GT.75)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).EQ.'R')GOTO 6222
	ID1=NRDSP(NBR,1)
	ID2=NCDSP(NBR,1)
	GOTO 1753
6222	CONTINUE
	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 FLIP ASSIGNMENTS
C FLIP XVBLS NUMBERS TOO TO MAINTAIN SORT. WE RECOMPUTE ANYWAY..
	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.
C	LDELTA=DRW-1
	LDELTA=19
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...
C	LDELTA=DCL-1
	LDELTA=74
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,(8103,8112,8121,8301,8953)
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
	KKK=ICHAR(':')
	LE=INDX(CMDLIN(LA),KKK)
	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.75)GOTO 8101
	IF(NUM1.GT.20)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=6
	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,8113,8122,8307,8954)
8108	CONTINUE
	ICODE=1
	IR=NUM1
	IC=NUM2
C 1 DIM COPY OF DATA, FOR IDELT ELEMENTS.
	DO 8105 NM=1,IDELT
C CLAMP TO MAX DISPLAY ARRAY
	IF(IR.GT.20.OR.IC.GT.75)GOTO 8105
	NRDSP(IR,IC)=ID1
	NCDSP(IR,IC)=ID2
	DVS(IR,IC)=DVS(IR,IC)-1.E-14
C	THISRW=IR
C	THISCL=IC
C	JRX=(ID2-1)*60+ID1
	CALL REFLEC(ID2,ID1,JRX)
	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
	KKK=ICHAR('[')
	LA=INDX(CMDLIN,KKK)+1
	KKK=ICHAR(']')
	LB=INDX(CMDLIN,KKK)-1
	LDELT=LB-LA+1
	LDELT=MIN0(LDELT,9)
	DO 8114 LN=1,IDELT
C IDELT IS OVER VRBL LIST GIVEN. MAY BE 1 ONLY.
C	IRRX=(ID2-1)*60+ID1
	CALL REFLEC(ID2,ID1,IRRX)
	CALL WRKFIL(IRRX,FORM,0)
C	READ(7'IRRX)FORM
	IF(CMDLIN(LA).EQ.'*')GOTO 7115
	IF(CMDLIN(LA).EQ.'A'.OR.CMDLIN(LA).EQ.'L')GOTO 7115
C KEEP EXISTING FORMAT IF [*] IS USED.
	DO 7989 KKKK=1,9
7989	FORM(119+KKKK)=Char(0)
	DO 8115 LNA=1,LDELT
	FORM(LNA+119)=CMDLIN(LA-1+LNA)
	IF(LNA.LT.9)FORM(LNA+120)=0
8115	CONTINUE
7115	CONTINUE
C	FORM(128)=0
	CALL FVLDGT(ID1,ID2,FVWRK)
	IVVVV=JCHAR(FVWRK)
	IF(IVVVV.EQ.0)IVVVV=3
C SET UP DEFAULT AS NUMERIC.
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,CHAR(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)=CHAR(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=ICHAR(FORM(119+KKK))
7988	DFE(KKK+1)=CHAR(MAX0(32,KKKK))
	DFE(1)='('
	DFE(12)=' '
	DFE(13)=' '
	DFE(14)=')'
	CALL TYPGET(N1,N2,TYPE(1,1))
	CALL FVLDGT(N1,N2,FVLD(1,1))
d	write(*,1092)dfe
d1092	format(' DFE (tst.xqtcmd) format=',14a1,';')
	IF(JCHAR(FVLD(1,1)).LE.0)GOTO 7990
	IF(TYPE(1,1).NE.2)GOTO 6223
	WRITE(WRKCHR(1:127),DFE,ERR=4302)DVS(THISRW,THISCL)
d	write(*,1091)dvs(thisrw,thiscl)
d1091	format(' xqtcmd value dvs(here)=',d20.10)
	GOTO 7990
6223	CONTINUE
        WRITE(WRKCHR(1:127),DFE,ERR=4302)LDVS(1,THISRW,THISCL)
7990	CONTINUE
	CALL WRKFIL(IRRX,FORM,1)
	DO 8116 NX1=1,20
	DO 8116 NX2=1,75
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)=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)=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))
	KKK=ICHAR(',')
	LA=INDX(CMDLIN(4),KKK)
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,8141)
8131	CONTINUE
	ICODE=6
	NCL=MAX0(1,NCL)
	NCL=MIN0(NCL,20)
	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,20)
	MR=MIN0(MR,75)
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
	IF(CMDLIN(2).EQ.'C'.OR.CMDLIN(2).EQ.'B')CALL SWSET(0)
	IF(CMDLIN(2).EQ.'I')CALL SWSET(1)
	IF(CMDLIN(2).EQ.'C'.OR.CMDLIN(2).EQ.'B')MODFLG=0
	IF(CMDLIN(2).EQ.'I')MODFLG=1
C VI MEANS VIEW IBM MODE, USING BIOS CALLS FOR DIRECT SCREEN OUTPUT.
	IF(CMDLIN(2).EQ.'C')CALL UVT100(20,0,0)
	IF(CMDLIN(2).EQ.'B')CALL UVT100(21,0,0)
C VC SETS VIEW COLOR MODE
C VB SETS VIEW B+W MODE
C REQUIRES UVTGEN MODULE...
	IF(CMDLIN(2).EQ.'H')GOTO 8320
8324	CONTINUE
	PZAP=0
	FORMFG=0
	IF(CMDLIN(2).EQ.'F')FORMFG=1
	IF(CMDLIN(2).EQ.'M')PZAP=1
	ICODE=6
	GOTO 9990
8320	CONTINUE
	IF(CMDLIN(3).NE.'+'.AND.CMDLIN(3).NE.'-')GOTO 8324
C VH+ OR VH-, FLIP VIEW HACK TO SHOW PROGRESS
C DYMANICALLY
	IDOL8=1
	IF(CMDLIN(3).EQ.'-')IDOL8=0
C IDOL8 = 1 MEANS DO THE DISPLAY, 0 MEANS DON'T.
	ICODE=3
	GOTO 9990
8003	IF(CMDLIN(1).NE.'C'.AND.CMDLIN(1).NE.'I')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 IR RANGES DOES INPLACE RELOCATION...
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)
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
C FOR PCC-PC DO RECALC ALWAYS TO ALLOW DISPLAY TO LOOK OK
	ICODE=3
C	ICODE=1
C FORCE RECALC IF ONLY 1 SOURCE VARIABLE.
C	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)=DVS(NX1,NX2)+1.245E-14
8388	CONTINUE
C	JRXX=(JD1B-1)*60+JD1A
C	IRXX=(ID2A-1)*60+ID1A
	CALL REFLEC(JD1B,JD1A,JRXX)
	CALL REFLEC(ID2A,ID1A,IRXX)
	CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
	KKKKK=JCHAR(FVLD(1,1))
	CALL FVLDGT(JD1A,JD1B,FVLD(1,1))
	IF(KKKKK.EQ.0.AND.ICHAR(FVLD(1,1)).EQ.0)GOTO 8314
C	IF(FVLD(ID1A,ID2A).EQ.0.AND.FVLD(JD1A,JD1B).EQ.0)GOTO 8314
	CALL WRKFIL(IRXX,FORM,0)
	CALL WRKFIL(JRXX,FORM2,0)
	IF(KKKKK.EQ.-2)CALL FVLDST(ID1A,ID2A,CHAR(253))
	IF(KKKKK.EQ.2)CALL FVLDST(ID1A,ID2A,CHAR(3))
	IF(jchar(FORM (119)).EQ. 2)FORM (119)=Char(3)
	IF(jchar(FORM (119)).EQ.-2)FORM (119)=Char(253)
	IF(jchar(FORM2(119)).EQ. 2)FORM2(119)=Char(3)
	IF(jchar(FORM2(119)).EQ.-2)FORM2(119)=Char(253)
	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.
C ALLOW IR COMMAND TO DO INPLACE RELOCATION.
	IF(CMDLIN(1).NE.'I')GOTO 6224
	CALL WRKFIL(IRXX,FORM2,1)
	GOTO 9222
6224	CONTINUE
	CALL WRKFIL(JRXX,FORM2,1)
	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)
9222	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)
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,(8840,8836,8365)
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
C USE LLT AND LGT LEXICAL ORDERING TESTS, NOT ARITHMETIC ONES...
	ICODE=5
C	IF(CMDLIN(1).EQ.'3')THISRW=MAX0(1,(THISRW-1))
C	IF(CMDLIN(1).EQ.'4')THISRW=MIN0((THISRW+1),DRWV)
C	IF(CMDLIN(1).EQ.'1')THISCL=MAX0(1,(THISCL-1))
C	IF(CMDLIN(1).EQ.'2')THISCL=MIN0((THISCL+1),DCLV)
C COULD ADD SCROLLING HERE IF DESIRED.
C	ASCII 1,2,3,4 ARE VALUES 49,50,51,52 IN DECIMAL.
	MVFG=ICHAR(CMDLIN(1))
	LRO=1
	LCO=1
	ID1=NRDSP(1,1)
	ID2=NCDSP(1,1)
	IF(.NOT.(MVFG.EQ.51.AND.THISRW.EQ.1))GOTO 2110
C MUST SCROLL LEFT
	IF(IDOL7.EQ.0)GOTO 2110
	IF(ID1.LE.1)GOTO 2110
	ID1=MAX0(1,ID1-DRWV+2)
	DROW=MAX0(1,DRWV-2)
	IQQ=1
	GOTO 7112
2110	IF(MVFG.EQ.51)THISRW=MAX0(1,(THISRW-1))
	IF(.NOT.(MVFG.EQ.52.AND.THISRW.EQ.DRWV))GOTO 2116
C MUST SCROLL RIGHT
	IF(IDOL7.EQ.0)GOTO 2116
	DROW=3
C	ID1=MIN0(60,ID1+DRWV-MIN0(DRWV,2))
	ID1=ID1+DRWV-MIN0(DRWV,2)
	IQQ=1
	GOTO 7112
C 7112 FAKES OUT OA CALL TO SCROLL OVER.
2116	IF(MVFG.EQ.52)THISRW=MIN0((THISRW+1),DRWV)
	IF(.NOT.(MVFG.EQ.49.AND.THISCL.EQ.1))GOTO 2117
C MUST SCROLL UP
	IF(IDOL7.EQ.0)GOTO 2117
	IF(ID2.LE.2)GOTO 2117
	DCOL=MAX0(1,DCLV-2)
	ID2=MAX0(2,ID2-DCLV+2)
	IQQ=1
	GOTO 7112
2117	IF(MVFG.EQ.49)THISCL=MAX0(1,(THISCL-1))
	IF(.NOT.(MVFG.EQ.50.AND.THISCL.EQ.DCLV))GOTO 2118
C MUST SCROLL DOWN
	IF(IDOL7.EQ.0)GOTO 2118
	DCOL=3
C	ID2=MIN0(301,ID2+DCLV-MIN0(DCLV,2))
	ID2=ID2+DCLV-MIN0(DCLV,2)
	IQQ=1
	GOTO 7112
2118	IF(MVFG.EQ.50)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
	IF(CMDLIN(2).NE.'B')GOTO 7333
C RB VAR SETS RELOCATE BOUNDARY TO VAR COORDS
	IF(CMDLIN(3).EQ.'*')GOTO 7332
C NORMAL RB COMMAND
C RB VAR USES VAR NAME TO RESET BDY
	LO=3
	KKKK=20
	CALL VARSCN(CMDLIN,LO,KKKK,IV,ID1,ID2,IVALID)
	IF(IVALID.LE.0)GOTO 9990
C IGNORE ERRORS
	IDOL5=ID1
	IDOL6=ID2
	GOTO 9990
7332	IDOL5=20000
	IDOL6=20000
C RB* RESETS RELOCATE BDY TO END OF SHEET
	GOTO 9990
7333	CONTINUE
C RECOMPUTE SHEET.
C RM COMMAND SETS MANUAL FLAG.
	RCFGX=0

	RCONE=0
	IF(CMDLIN(2).NE.'S')GOTO 5114
	RRWACT=60
	RCLACT=301
5114	CONTINUE
C RCFGX NONZERO INHIBITS RECALCULATION.
C RCONE SET 1 TO FORCE RECALC OF ALL.
C CHANGE FROM OTHER SYNTAX: RF FORCES RECALC, R DOES NOT.
	IF(CMDLIN(2).EQ.'F'.OR.CMDLIN(2).EQ.'R')RCONE=1
C NOTE RXF (X=ANY CHAR BUT F) ACTS LIKE OLD VERSION RXF.
C BARE R COMMAND HOWEVER JUST REDOES CALC. F NOW MEANS "FORCE"
C AND SEEMS A BIT MORE MNEMONIC THIS WAY. ALLOW RR COMMAND
C TO WORK AS WELL AS RF.
	IF(CMDLIN(2).NE.'R')RCMODE=0
	IF(CMDLIN(2).EQ.'E')RCMODE=1
	IF(CMDLIN(2).EQ.'I')RCMODE=2
C RE, RI MODE CONTROLS... ALSO RR ACTS LIKE RF BUT STAYS IN
C RE OR RI MODE... RECALC ENTRY OR INCREMENTAL...
	IF(CMDLIN(2).EQ.'M')RCFGX=1
	ICODE=3
C 3rd char I Inhibits recalc this time but sets modes...
	IF(CMDLIN(3).EQ.'I')ICODE=1
	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(1)
	CALL UVT100(11,2,0)
C ERASE DSPLY
	KLVL=1
	ILNCT=0
C ICODE SET TO 420 SPECIAL CODE TO TELL MAIN PGM TO CALL INTERACTIVE
C CALCULATOR FCN.
	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
3800	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
3801	ICODE=1
	GOTO 9990
8010	CONTINUE
	IF(CMDLIN(1).NE.'>')GOTO 3802
C >STRING SEARCHES FORMULAE FOR STRING
	LA=MIN0(IDOL5,RRWACT)
	LB=MIN0(IDOL6,RCLACT)
C NO ACTION UNLESS VALID SEARCH REGION (CURRENT TO RELOC BDY)
C EXISTS.
	IF(LA.LT.PROW.OR.LB.LT.PCOL)GOTO 3801
	DO 3803 ID1=PROW,LA
	DO 3803 ID2=PCOL,LB
	ID1A=ID1
	ID2A=ID2
	CALL FVLDGT(ID1,ID2,FVLD(1,1))
	IF(JCHAR(FVLD(1,1)).EQ.0)GOTO 3803
C HAVE VALID CELL HERE, SO GRAB ITS FORMULA AND COMPARE FOR THE ONE
C WE'RE LOOKING FOR. IF CMD LINE STARTS WITH >> ANCHOR THE SEARCH AT 1ST
C COL.
	LMX=50
	LMN=2
	IF(CMDLIN(2).NE.'>')GOTO 3805
	LMX=1
	LMN=3
3805	CONTINUE
C	IRX=(ID2-1)*60+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,FORM,0)
	CALL CE2A(FORM,FORM2)
	DO 3804 IV=1,LMX
	KKKK=109-IV
C COMPARE FORMULA TEXT. USE EXISTING SCMP ROUTINE.
	CALL SCMP(CMDLIN(LMN),FORM2(IV),KKKK,KKK)
	IF(KKK.EQ.1.AND.JCHAR(FORM2(IV)).GT.0)GOTO 3800
	IF(JCHAR(FORM2(IV)).LE.0)GOTO 3803
3804	CONTINUE
3803	CONTINUE
C IF WE FALL THROUGH, WE FAILED TO FIND FORMULA SO FORGET IT.
	GOTO 3801
3802	CONTINUE
	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(1,LLDSP,1)
c	WRITE(0,8951)
c8951	FORMAT('Really Zero All of sheet [Y/N]?\')
	call Vwrt('Really Zero ALL of sheet [Y/N]?',31)
	III=IOLVL
C	IF(III.EQ.5)III=0
	READ(III,8952,END=510,ERR=510)(FORM2(KKI),KKI=1,4)
8952	FORMAT(4A1)
	ICODE=6
	IF(FORM2(1).NE.'Y'.AND.FORM2(1).NE.'y')GOTO 9990
	CALL UVT100(11,2,0)
	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)=Char(15)
	DO 8823 NI=1,9
8823	FORM2(119+NI)=DEFVB(1+NI)
	DO 8956 NI=1,IDELT
C	IRX=(ID2-1)*60+ID1
	CALL REFLEC(ID2,ID1,IRX)
	CALL WRKFIL(IRX,FORM2,1)
	CALL FVLDST(ID1,ID2,CHAR(0))
	CALL XVBLST(ID1,ID2,0.0D0)
	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)=DVS(LR,LC)+1.E-11
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(1,LLDSP,1)
        call 
     1 swrt('Exit now may lose data unless sheet has been saved'
     2 ,50)
	CALL UVT100(1,LLCMD,1)
	call Vwrt('Confirm Exit Request [Y/N]:',27)
	III=IOLVL
C	IF(IOLVL.EQ.5)III=0
	READ(III,8952,END=510,ERR=510)(FORM2(KKI),KKI=1,4)
	IF(FORM2(1).NE.'Y'.AND.FORM2(1).NE.'y')GOTO 9990
C END CALL TO GET OUT OF HERE
	Close(unit=11)
	Close(unit=3)
	Call TTYDEI
        STOP
C	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(11,2,0)
	GOTO 9990
8013	IF(CMDLIN(1).NE.'P')GOTO 8014
	IRTN=0
	CALL PGET(CMDLIN,ICODE,IRTN)
	IF(IRTN.EQ.1)GOTO 510
	GOTO 9990
8014	CONTINUE
8015	IF(CMDLIN(1).NE.'G')GOTO 8016
C GET INPUT NUMBERS OFF SEQUENTIAL FILE. USE CURRENT ORIGIN
	ICODE=2
	IRTN=0
	CALL PGGET(CMDLIN,ICODE,IRTN)
	IF(IRTN.EQ.1)GOTO 510
C FLAG WE NEED AT LEAST ONE FULL CALC BEFORE GOING TO PARTIALS...
C (OK TOO IF IN OLD RCMODE=0 MODE)
	RCMODE=-IABS(RCMODE)
	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=ICHAR(CMDLIN(2))
	ivvx=ICHAR(cmdlin(3))
9308	CONTINUE
	IF(IVVVV.GE.48.AND.IVVVV.LE.57)IVVV=IVVVV-48
	if(ivvx.lt.48.or.ivvx.gt.57)goto 9381
c implement 2 digit help code.
	ivvvx=ivvx-48
	ivvv=(ivvv*10)+ivvvx
	ivvv=min0(ivvv,99)
9381	continue
C SELECT HELP LEVEL 0-9 IF SPECIFIED.
	ICODE=30+IVVV
	GOTO 9990
5019	CONTINUE
C *** ALLOW EVALUATION OF A CELL TO PERMIT INTERACTIVE COMMAND FILES TO
C *** BE CONTROLLED RATIONALLY. KEYWORD IS "TEST"
	IF(CMDLIN(1).NE.'T'.OR.CMDLIN(2).NE.'E')GOTO 4302
C TEST EXPRESSION IS SYNTAX.
C COPY CMDLIN INTO XTNCMD AND FLAG VIA ICODE=430
	XTNCNT=0
	ICODE=430
	DO 4307 N=1,80
4307	XTNCMD(N)=Char(0)
C FIRST ZERO OUT EXTERNAL CMD LINE, THEN FILL IN WHAT'S NEEDED.
	DO 4303 N=1,79
	XTNCMD(N)=CMDLIN(3+N)
C ALLOW "TE <ANY EXPRESSION>" WITH OPTIONAL SPACE. JUST RETURNS VALUE IN
C % VARIABLE.
	IF(ICHAR(XTNCMD(N)).LT.32)GOTO 4304
	XTNCNT=N
4303	CONTINUE
4304	CONTINUE
	XTNCMD(XTNCNT+1)=Char(0)
	GOTO 9990
4302	CONTINUE
C LET DOUBLE DOT (..) INDICATE TO GO BACK TO CONSOLE, CLOSING INPUT FILE
	IF (CMDLIN(1).EQ.'.'.AND.CMDLIN(2).EQ.'.')GOTO 510
C ELSE PRINT MESSAGE THAT WE DON'T UNDERSTAND THAT ONE & GO ON
C PRINT INVALID CMD MSG IF NOT JUST A SPACE OR C.R.
	IF(ICHAR(CMDLIN(1)).GT.32)CALL SWRT('Invalid Command.',16)
	GOTO 200
C ERROR ON READIN ADDRESS. REWIND TERMINAL IF USER
C TYPES CTRL Z (EOF), ELSE LEAVE INDIRECT FILES.
510	CONTINUE
C	IF(IOLVL.EQ.5)REWIND 5
	CLOSE(3)
c	CLOSE(11)
	Rewind 11
c	OPEN(11,FILE='CON:0/0/100/100/Analy Command')
	IOLVL=11
	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)
C	IRRX=(N2-1)*60+N1
	CALL REFLEC(N2,N1,IRRX)
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(1,ICCC,J)
C SELECT ROW "IXLSTC", COL "J"
	CALL UVT100(13,0,0)
C DESELECT REVERSE VIDEO
	CALL FVLDGT(N1,N2,FVLDTP)
	ivv=min0(30,cwids(IXLSTR))
	IF(ICHAR(FVLDTP).EQ.0)CALL SWRT(BLANKS,IVV)
	IF(ICHAR(FVLDTP).EQ.0)GOTO 2000
	CALL WRKFIL(IRRX,FORM2,0)
	CALL CE2A(FORM2,FORM)
C	READ(7'IRRX)FORM
	DO 5546 KKKK=1,100
	IV=ICHAR(FORM(KKKK))
	IV=MAX0(IV,32)
5546	FORM(KKKK)=Char(IV)
	IF(JCHAR(FVLDTP).LT.0.OR.FORMFG.NE.0)
     1  WRITE(CMDLNA(1:127),8201)(FORM(II),II=1,100)
C FILL IN TEXT FOR FORMULA IF FVLD < 0 HERE; BELOW, FILL IN VALUE TEXT IF FVLD
C > 0.
	IF(FORMFG.NE.0)GOTO 4324
C ALWAYS DO FORMULAS IF FORMFG SET (VF MODE).
	DO 6302 KKK=1,9
	KKKK=ICHAR(FORM(KKK+119))
C	KKKK=DFMTS(KKK,IXLSTR,IXLSTC)
6302	DFE(KKK+1)=CHAR(MAX0(32,KKKK))
	DFE(11)=char(32)
C 32 = ASCII SPACE
	DFE(1)='('
C REMEMBER: NO \ EDITING IN INTERNAL WRITES!
	DFE(12)=' '
	DFE(13)=' '
	DFE(14)=')'
	CALL TYPGET(N1,N2,TYPE(1,1))
	IF(JCHAR(FVLDTP).LE.0)GOTO 4324
	IF(TYPE(1,1).NE.2)GOTO 6226
        WRITE(CMDLNA(1:127),DFE,ERR=4324)DVS(IXLSTR,IXLSTC)
	GOTO 4324
6226	CONTINUE
	WRITE(CMDLNA(1:127),DFE,ERR=4324)LDVS(1,IXLSTR,IXLSTC)
C REDRAW THIS COL. WITHOUT REVERSE VIDEO HERE.
4324	CALL SWRT(CMDLIN,CWIDS(IXLSTR))
C NOTE THIS REDRAWS PREVIOUS COL. IN NORMAL VIDEO.
C NO CARRIAGE CTL
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)=Char(0)
	RETURN
	END

