home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d144 / analyticalc.lha / AnalytiCalc / AnalySources.Arc / AnalyF6.Ftn < prev    next >
Text File  |  1987-11-08  |  77KB  |  2,677 lines
  1. c -h- varscn.for    Fri Aug 22 13:37:17 1986    
  2. C $DO66
  3.     SUBROUTINE VARSCN(LINE,IBGN,LEND,LSTCHR,ID1,ID2,IVALID)
  4. C COPYRIGHT (C) 1983, 1984 GLENN AND MARY EVERHART
  5. C ALL RIGHTS RESERVED
  6. C
  7. C VARSCN - SCAN COMMAND LINE FOR VARIABLE NAMES.
  8. C
  9. C    SCANS FOR VARIABLE NAMES OF FORM AAANNN WHERE AAA = LETTERS
  10. C BETWEEN A AND Z UP TO NON-ALPHA, CORRESPONDING TO ROW, FOLLOWED BY
  11. C NUMBERS IN THE 0-9 RANGE MAKING A DECIMAL COLUMN NUMBER.
  12. C
  13. C THE LETTERS ARE FORMED BY
  14. C A-Z ALONE GIVE ROW 1-26, COL 1. % IS ROW 27,COL1
  15. C A1-Z1 GIVE ROW 1-26, COL 2
  16. C AA1-ZZ1 ARE ROW 27-52, COL 2
  17.     IMPLICIT InTeGer*4 (A-Z)
  18. C PARAMETER 18060=60*301 ! SIZE
  19. C NOTE COL 1 IS DUMMY. DISPLAY THE SHEET SIDEWAYS SO WE GET USUAL VISUAL
  20. C ROWS, COLS., AND ACCUMULATORS A-Z,% JUST APPEAR AS A FICTITIOUS ROW 0
  21. C ON DISPLAY, INSTEAD OF REAL COLUMN 1 HERE.
  22.     DIMENSION LINE(LEND)
  23.     CHARACTER*1 LINE
  24.     InTeGer*4 TYPE(1,1),VLEN(9)
  25.     REAL*8 XVBLS(1,1)
  26.     CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
  27.     REAL*8 XAVB
  28.     REAL*4 XAV2(2)
  29.     CHARACTER*1 XAV1(8)
  30.     EXTERNAL INDX
  31.     EQUIVALENCE(XAVB,XAV2(1)),(XAVB,XAV1(1))
  32.     EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1))
  33.     COMMON/V/TYPE,AVBLS,VBLS,VLEN
  34. C ***<<< KLSTO COMMON START >>>***
  35.     InTeGer*4 DLFG
  36. C    COMMON/DLFG/DLFG
  37.     InTeGer*4 KDRW,KDCL
  38. C    COMMON/DOT/KDRW,KDCL
  39.     InTeGer*4 DTRENA
  40. C    COMMON/DTRCMN/DTRENA
  41.     REAL*8 EP,PV,FV
  42.     DIMENSION EP(20)
  43.     INTEGER*4 KIRR
  44. C    COMMON/ERNPER/EP,PV,FV,KIRR
  45.     InTeGer*4 LASTOP
  46. C    COMMON/ERROR/LASTOP
  47.     CHARACTER*1 FMTDAT(9,76)
  48. C    COMMON/FMTBFR/FMTDAT
  49.     CHARACTER*1 EDNAM(16)
  50. C    COMMON/EDNAM/EDNAM
  51.     InTeGer*4 MFID(2),MFMOD(2)
  52. C    COMMON/FRM/MFID,MFMOD
  53.     InTeGer*4 JMVFG,JMVOLD
  54. C    COMMON/FUBAR/JMVFG,JMVOLD
  55.     COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
  56.      1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
  57. C ***<<< KLSTO COMMON END >>>***
  58. CCC    InTeGer*4 DLFG
  59. CCC    COMMON/DLFG/DLFG
  60. C DLFG=1 IF D## FORMS ARE SEEN
  61.     DIMENSION NRDSP(20,75),NCDSP(20,75)
  62.     COMMON/D2R/NRDSP,NCDSP
  63. C NRDSP AND NCDSP ARE REAL ROW, COL OF DISPLAY ROW, COL CELLS. NOTE THAT
  64. C NOT ALL DISPLAY CELLS ARE ALWAYS ACTUALLY SHOWN; ONLY THOSE THAT FIT
  65. C ARE SHOWN; THE REST "EXIST" BUT DON'T APPEAR UNLESS ROWS ARE SMALL
  66. C ENOUGH.
  67. C
  68. C THIS PROGRAM ALSO HANDLES CELL SPECS OF FORM
  69. C P#+nnn#+nnn (or P#-nnn#-mmm) FOR Physical cells relative to our current
  70. C physical cell on the sheet (clamped at boundaries), or of form
  71. C D#+nnn#+mmm etc for Display cells relative to our current display
  72. C location as held in the DROW,DCOL cells in commons.
  73. C ***<<<< RDD COMMON START >>>***
  74.     InTeGer*4 RRWACT,RCLACT
  75. C    COMMON/RCLACT/RRWACT,RCLACT
  76.     InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
  77.      1  IDOL7,IDOL8
  78. C    common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
  79. C     1  IDOL7,IDOL8
  80.     InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
  81. C    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
  82.     InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
  83. C    COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
  84. C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
  85. C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
  86.     InTeGer*4 KLVL
  87. C    COMMON/KLVL/KLVL
  88.     InTeGer*4 IOLVL,IGOLD
  89. C    COMMON/IOLVL/IOLVL
  90. C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
  91. C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
  92.     COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
  93.      1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
  94.      2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
  95. C ***<<< RDD COMMON END >>>***
  96. CCC    InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6
  97. CCC    common/dollr/idol1,idol2,idol3,idol4,idol5,idol6
  98. CCC    InTeGer*4 PROW,PCOL
  99. C ! PHYSICAL ROW, COL BEING HANDLED.
  100. CCC    InTeGer*4 DROW,DCOL,DCLV,DRWV
  101.     InTeGer*4 RSM,CSM,AFG,ASM,VCF,CH
  102. CCC    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
  103.     LOGICAL*4 L1,L2
  104. C    LOGICAL*2 L63,L192,L127
  105.     InTeGer*4 I1,I2
  106.     InTeGer*4 I63,I192,I127
  107.     EQUIVALENCE(I1,L1),(I2,L2)
  108. C    EQUIVALENCE (I63,L63),(I192,L192),(L127,I127)
  109.     DATA I63/63/,I192/192/,I127/127/
  110. C DRWV,DCLV = # OF MAX ROWS, COLS ACTUALLY ON SCREEN NOW. DROW,DCOL
  111. C ARE ACTUAL "CURSOR" LOCATION.
  112. C
  113. C ZERO OUR VARIABLES
  114.     LPFG=0
  115. C ! FLAG WE GOT A LOGICAL/PHYSICAL # FORM AND TYPE
  116.     AFG=0
  117. C ! FLAG WE SAW AN ALPHA
  118.     ASM=0
  119. C ! SUM OF ALPHAS HASHCODED (ACCUMULATOR)
  120.     NSM=0
  121. C ! ACCUMULATOR FOR NUMERICS
  122.     NFG=0
  123. C ! FLAG WE SAW A NUMERIC
  124.     RSM=0
  125. C ! AC FOR ROWS IN # FORMS
  126.     CSM=0
  127. C ! AC FOR COLS IN # FORMS
  128.     ISPC=0
  129. C ! COUNTER FOR NONSPACES SEEN (USED TO STOP ON TRAILING SPACES)
  130.     idol1=0
  131.     idol2=0
  132.     IF(LINE(IBGN).NE.'%')GOTO 2000
  133.     ID1=27
  134.     ID2=1
  135.     IVALID=1
  136.     LSTCHR=IBGN+1
  137. C SPECIAL CASE FOR % = AC #27
  138.     RETURN
  139. 2000    CONTINUE
  140.     DO 1 N=IBGN,LEND
  141.     VCF=0
  142.     LSTCHR=N
  143.     CH=ICHAR(LINE(N))
  144.     IF (CH.EQ.255)GOTO 5000
  145. C 5000 DECODES ENCODED FORMS AND RETURNS THEM...
  146. C
  147. C IGNORE SPACES AND TABS IF LEADING
  148.     IF(CH.GT.32)ISPC=ISPC+1
  149.     IF(CH.GT.0.AND.CH.LE.32.AND.ISPC.EQ.0)GOTO 1
  150. C SPECIAL CASE TRAILING DOLLAR SIGNS... SKIP AND FLAG
  151.     IF(CH.NE.36)GOTO 3443
  152. C 36 IS ASCII FOR $ SIGN
  153. C SAW A DOLLAR SIGN
  154.     IF(AFG.EQ.1.AND.NFG.EQ.0)IDOL1=1
  155.     IF(AFG.EQ.1.AND.NFG.EQ.1)IDOL2=1
  156. C LEAVES WITH IDOL1 FLAGGED AS 1 IF LETTER PART WAS FOLLOWED BY
  157. C DOLLAR SIGN, AND IDOL2 FLAGGED IF NUMBER PART WAS FOLLOWED
  158. C BY DOLLAR. IGNORES ALL OTHER DOLLAR SIGNS.
  159.     GOTO 1
  160. 3443    CONTINUE
  161. C GET CHARACTER VALUE IN.
  162. C MUST BE UPPERCASE.
  163.     IF(.NOT.(CH.GE.65.AND.CH.LT.91)) GOTO 100
  164. C CH IS AN ALPHA, RANGE A-Z
  165.     VCF=1
  166. C ! VALID CHAR SEEN
  167.     AFG=1
  168. C !SAW THE ALPHA
  169.     IF(ASM.LT.18060)ASM=(CH-64)+26*ASM
  170.     IF(NFG.NE.0)GOTO 103
  171. C FILTER OUT TOO-LARGE VALUES...
  172.     IF(ASM.GT.18000)GOTO 103
  173. C 60 * 26 IS LIM ABOVE
  174.     IF(CH.EQ.80)LPFG=1
  175. C ! FLAG WE GOT PHYS. FORM MAYBE
  176.     IF(CH.EQ.68)LPFG=2
  177. C ! FLAG WE GOT DISPLAY FORM MAYBE
  178. 100    CONTINUE
  179. C EXPECT # FORMS TO HAVE # JUST AFTER 1ST ALPHA.
  180. C 35 IS ASCII VALUE OF '#' CHAR.
  181.     IF(CH.EQ.35)GOTO 1000
  182. C NEXT TEST NUMERICS
  183.     IF(.NOT.(CH.GE.48.AND.CH.LE.57))GOTO 101
  184. C CH IS A NUMERIC, RANGE 0-9
  185.     VCF=1
  186. C ! VALID CHAR SEEN
  187.     NFG=1
  188. C ! FLAG WE SAW NUMERIC
  189.     IF(AFG.NE.0)GOTO 102
  190.     GOTO 103
  191. 102    CONTINUE
  192.     IF(NSM.LT.18060)NSM=(CH-48)+10*NSM
  193. C FILTER OUT TOO-LARGE VALUES EARLY
  194. C 301 * 10 IS LIMIT...
  195.     IF(NSM.GT.18000)GOTO 103
  196. C ! CONVERT CHARS TO BINARY AS SEEN
  197. 101    CONTINUE
  198.     IF(VCF.EQ.0)GOTO 2
  199. C !END ON ANY INVALID CHARACTER
  200. 1    CONTINUE
  201. 2    CONTINUE
  202.     IF(AFG.EQ.0)GOTO 103
  203.     GOTO 950
  204. 103    CONTINUE
  205. C INVALID ... NUMERIC AND NO PRIOR ALPHA. FLAG BAD NAME AND EXIT.
  206.     IVALID=0
  207.     RETURN
  208. 950    ID1=ASM
  209.     ID2=1+NSM
  210. C ! NOTE ID2=1 IF NO NUMERICS SEEN, MORE OTHERWISE.
  211.     GOTO 1201
  212. 1000    CONTINUE
  213. C HERE HANDLE CURRENT-REFERENCED FORMS USING # AS SPECIAL CHARACTER MEANING
  214. C THE CURRENT POSITION. THESE TYPES OF REFERENCES MAY BE MOVED AROUND THE
  215. C SHEET WHICH ACCOUNTS FOR THEIR USEFULNESS. SINCE THERE IS A DISPLAY
  216. C AND PHYSICAL SHEET WHICH ARE MAPPED BY A MAPPING, ALLOW EITHER
  217. C TO BE REFERENCED. THUS, COMPLEX CALCULATIONS MAY BE DONE BUT LARGELY
  218. C HIDDEN. THE ACCUMULATORS MAY BE USED AS SCRATCH STORAGE FOR THIS
  219. C SORT OF THING.
  220. C SAW THE # SIGN, SO SEE IF THE + OR - N CAN BE DECODED.
  221. C IF NO P OR D WAS SEEN HOWEVER WE HAVE AN INVALID NAME, SO FLAG IT.
  222.     IF(LPFG.EQ.0)GOTO 103
  223. C PASS THE # SIGN PRIOR TO GETTING THE NUMERIC.
  224.     LSTCHR=LSTCHR+1
  225.     if(line(lstchr).ne.'%')goto 3900
  226. c allow p#%ab form to mean use ac a and b to get offsets from "here"
  227.     CSM=0
  228.     RSM=0
  229. C DEFAULT TO "THIS" CELL
  230.     LSTCHR=LSTCHR+1
  231. C PASS THE % SIGN
  232.     RSM=ICHAR(LINE(LSTCHR))
  233.     CSM=ICHAR(LINE(LSTCHR+1))
  234.     LSTCHR=LSTCHR+2
  235. C FIX UP ASCII OFFSETS, AND MEANWHILE REQUIRE UPPERCASE
  236. C AND THAT THERE BE 2 AC'S NAMES AFTER THE %.
  237. C THIS SHOULD BE HANDY FOR COMMAND FILES.
  238.     RSM=RSM-64
  239.     CSM=CSM-64
  240. C NOW RSM, CSM ARE SUBSCRIPTS. PULL OUT VALUES FROM XVBLS
  241.     IF(RSM.LE.0.OR.RSM.GT.27)GOTO 103
  242.     IF(CSM.LE.0.OR.CSM.GT.27)GOTO 103
  243.     DO 3902 IV=1,8
  244. 3902    XAV1(IV)=AVBLS(IV,RSM)
  245.     RSM=XAVB
  246.     DO 3903 IV=1,8
  247. 3903    XAV1(IV)=AVBLS(IV,CSM)
  248.     CSM=XAVB
  249. C LOADS THE 2 AC'S TO THE OFFSETS AND GOES ON...JUST NEEDS THE
  250. C 2 LETTERS AFTER P#% OR D#%.
  251.     goto 3901
  252. 3900    continue
  253.     CALL GN(LSTCHR,LEND,NUM,LINE)
  254. C GN GETS THE +- NN NUMBER AND RETURNS VALUE IN NUM.
  255. C LSTCHR RETURNS AS NEXT CHAR NOT USED.
  256.     RSM=NUM
  257. C 35 IS ASCII FOR '#'
  258. C allow any delimiter between numbers, though we must have # at start
  259. C  to delimit valid relative coordinates.
  260. C    IF(ICHAR(LINE(LSTCHR)).NE.35) GOTO 103
  261. C IF NO SECOND # SEEN, THE FORM IS INVALID SO SAY SO AND EXIT.
  262.     LSTCHR=MIN0(LSTCHR+1,LEND)
  263. CC BUMP PAST THE # IF WE SAW IT.
  264. C now get the second numeric string and bump LSTCHR past it.
  265.     NUM=0
  266.     CALL GN(LSTCHR,LEND,NUM,LINE)
  267.     CSM=NUM
  268. C NOW HAVE THE NUMBERS ENCODED. NOTE THAT ## IS VALID.
  269. 3901    CONTINUE
  270.     IF(LPFG.EQ.2) GOTO 1200
  271. C IF HERE, LPFG=1 AND WE ARE ON PHYSICAL SHEET.
  272.     ID2=CSM+PCOL
  273.     ID1=RSM+PROW
  274. 1201    CONTINUE
  275. C TO ALLOW REFLECTED VALUES TO WORK, LET ALL NORMAL VALUES BY...
  276. C    IF(ID1.GT.60.OR.ID1.LE.0)GOTO 103
  277. C    IF(ID2.GT.301.OR.ID2.LE.0)GOTO 103
  278.     IVALID=1
  279. C ALL IS WELL
  280.     RETURN
  281. 1200    CONTINUE
  282. C DISPLAY COLUMN RELATIVE.
  283.     DLFG=1
  284. C FLAG WE SAW A D## FORM FOR RECALC
  285.     DRRW=DROW+RSM
  286.     DRRW=MAX0(1,DRRW)
  287.     DRRW=MIN0(20,DRRW)
  288.     DCCL=DCOL+CSM
  289. C ENSURE DISPLAY COORDS IN LEGAL BOUNDS
  290.     DCCL=MAX0(1,DCCL)
  291.     DCCL=MIN0(75,DCCL)
  292. C CLAMP TO WITHIN LEGAL DIMENSIONS.
  293.     ID1=NRDSP(DRRW,DCCL)
  294.     ID2=NCDSP(DRRW,DCCL)
  295.     GOTO 1201
  296. 5000    CONTINUE
  297.     IF(ASM.NE.0.OR.NSM.NE.0)GOTO 103
  298. C HANDLE 255,CODE1,CODE2 FORMS
  299. C FIRST BYTE IS ALWAYS 255
  300. C 2ND BYTE IS: HI 2 BITS ARE HI 2 BITS OF ID2. LO 6 BITS ARE ID1
  301. C 3RD BYTE IS: LO 8 BITS OF ID2
  302.     I1=ICHAR(LINE(LSTCHR+1))
  303.     I2=IMASK(I1,I192)
  304. C    L2=L1.AND.L192
  305. C    L1=L1.AND.L63
  306.     I1=IMASK(I1,I63)
  307.     ID1=I1
  308.     I1=ICHAR(LINE(LSTCHR+2))
  309. C    L1=L1.AND.L127
  310.     I1=IMASK(I1,I127)
  311. C MUST HAVE 128 BIT ON IN LOW BYTE TO AVOID NULLS IN IT.
  312.     ID2=I2*2+I1
  313.     LSTCHR=LSTCHR+3
  314.     GOTO 1201
  315.     END
  316. c -h- vvary.for    Fri Aug 22 13:37:17 1986    
  317. C $DO66
  318. C VARY CONTROL ROUTINE
  319. C NOTE: THIS ROUTINE RELIES UPON HAVING ITS DATA AREAS REMAIN INTACT
  320. C ACROSS CALLS. IT MUST NOT BE IN AN OVERLAY SEGMENT OR THAT WILL FAIL
  321. C AND IT WILL NOT WORK. SPECIFICALLY IT EXPECTS THE AC ARRAY TO BE
  322. C SET CORRECTLY.
  323.     SUBROUTINE VVARY(LINE,RETCD,K)
  324.     CHARACTER*1 LINE(80)
  325.     INTEGER RETCD
  326.     CHARACTER*1 AVBLS(20,27),WRK(128),VBLS(8,1,1)
  327.     InTeGer*4 TYPE(1,1),VLEN(9)
  328.     REAL*8 XAC,XVBLS(1,1)
  329.     EQUIVALENCE(XAC,AVBLS(1,27))
  330.     INTEGER*4 JVBLS(2,1,1)
  331.     EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
  332.     EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
  333.     COMMON/V/TYPE,AVBLS,VBLS,VLEN
  334. C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
  335. C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
  336. C (IMPLEMENT FOR VAX ONLY)
  337. C ***<<< XVXTCD COMMON START >>>***
  338.     CHARACTER*1 OARRY(100)
  339.     InTeGer*4 OSWIT,OCNTR
  340. C    COMMON/OAR/OSWIT,OCNTR,OARRY
  341. C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
  342. C    InTeGer*4 IPS1,IPS2,MODFLG
  343.     InTeGer*4 IC1POS,IC2POS,MODFLG
  344. CCC    COMMON/ICPOS/IC1POS,IC2POS,MODFLG
  345. C    COMMON/ICPOS/IPS1,IPS2,MODFLG
  346.        InTeGer*4 XTCFG,IPSET,XTNCNT
  347.        CHARACTER*1 XTNCMD(80)
  348. C       COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
  349. C VARY FLAG ITERATION COUNT
  350.     INTEGER KALKIT
  351. C    COMMON/VARYIT/KALKIT
  352.     InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
  353.     InTeGer*4 RCMODE,IRCE1,IRCE2
  354. C    COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  355. C     1  IRCE2
  356. C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
  357. C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
  358. C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
  359. C RCFGX ON.
  360. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
  361. C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
  362. C  AND VM INHIBITS. (SETS TO 1).
  363.     INTEGER*4 FH
  364. C FILE HANDLE FOR CONSOLE I/O (RAW)
  365. C    COMMON/CONSFH/FH
  366.     CHARACTER*1 ARGSTR(52,4)
  367. C    COMMON/ARGSTR/ARGSTR
  368.     COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IC1POS,IC2POS,MODFLG,
  369.      1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
  370.      2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  371.      3  IRCE2,FH,ARGSTR
  372. C ***<<< XVXTCD COMMON END >>>***
  373. CCC    INTEGER KALKIT
  374. CCC    COMMON/VARYIT/KALKIT
  375.     EXTERNAL SIGN
  376.     INTEGER LPUT,LGET
  377.     REAL*8 SIGN
  378.     CHARACTER*1 LAC(8)
  379.     REAL*8 XVAC,VW
  380.     EQUIVALENCE(LAC(1),XVAC)
  381.     REAL *8 AC(26)
  382.     REAL*8 DERIV(8)
  383.     REAL*8 DEL(8)
  384.     REAL*8 OLDVV,OLDX,OLDA
  385.     INTEGER ACV(8)
  386.     INTEGER CAC
  387.     INTEGER CCNT(8)
  388. C UNCOMMENT THIS COMMON DECLARATION AND MOVE DATA STMTS INTO BLOCK
  389. C IN ORDER TO OVERLAY THIS...
  390.     COMMON/VRYDAT/AC,DERIV,DEL,CAC,CCNT,OLDVV,OLDX,OLDA,ACV
  391. C
  392. C ACV POINTS TO AC'S VARYING
  393. C CAC = CURRENT INDEX INTO ACV TO FIND AC BEING VARIED
  394. C AC IS LAST SET OF ACCUMULATORS SEEN
  395. C IF ACV ENTRY IS 0, MEANS NO AC TO VARY THERE.
  396.     INTEGER LW,LX,LI
  397. C ! LOGICAL W,X,I AC'S
  398.     INTEGER LA
  399. C ! LOGICAL A AC
  400. C
  401. C    DATA DERIV/8*1./,DEL/8*0./
  402. C    DATA CAC/1/,CCNT/8*0/
  403. C    DATA ACV/8*0/
  404. C    DATA OLDVV/1./
  405. C
  406. C PARSE ARGUMENTS FIRST
  407. C FIRST 2 ARGS ARE X AND A AC'S (OR GENERAL CELLS)
  408. C DEFAULT NO REDOING THIS...
  409.     KALKIT=0
  410.     IBGN=K+5
  411.     LEND=IBGN+20
  412.     CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LX,ID2A,IVALID)
  413.     IF (IVALID.EQ.0)GOTO 9900
  414.     IF(LINE(LSTCHR).NE.',')GOTO 9900
  415.     IBGN=LSTCHR+1
  416.     LEND=IBGN+20
  417.     CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LA,ID2B,IVALID)
  418.     IF (IVALID.EQ.0)GOTO 9900
  419.     IF(LINE(LSTCHR).NE.',')GOTO 9900
  420.     IBGN=LSTCHR+1
  421.     LEND=IBGN+20
  422.     CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LW,ID3B,IVALID)
  423.     IF (IVALID.EQ.0)GOTO 9900
  424.     IF(LINE(LSTCHR).NE.',')GOTO 9900
  425.     IF(ID3B.NE.1)GOTO 9900
  426.     IBGN=LSTCHR+1
  427.     LEND=IBGN+20
  428.     CALL VARSCN(LINE,IBGN,LEND,LSTCHR,LI,ID3B,IVALID)
  429.     IF (IVALID.EQ.0)GOTO 9900
  430.     IF(LINE(LSTCHR).NE.',')GOTO 9900
  431.     IF(ID3B.NE.1)GOTO 9900
  432. C    IBGN=LSTCHR+1
  433. C    LEND=IBGN+20
  434. C LOOP OVER VALUES TO VARY NOW
  435.     DO 99 N=1,8
  436. 99    ACV(N)=0.
  437.     DO 100 N=1,8
  438. C ALLOW UP TO 8 DIMENSIONS VARIATION
  439.     IBGN=LSTCHR+1
  440.     LEND=IBGN+20
  441.     CALL VARSCN(LINE,IBGN,LEND,LSTCHR,ACV(N),ID3B,IVALID)
  442.     IF (IVALID.EQ.0)GOTO 9900
  443.     IF(LINE(LSTCHR).NE.';')GOTO 110
  444.     IF(ID3B.NE.1)GOTO 9900
  445.     IBGN=LSTCHR+1
  446.     LEND=IBGN+20
  447. 100    CONTINUE
  448. 110    CONTINUE
  449. C NOW HAVE ALL AC POINTERS SET UP.
  450. C IF I IS NOW 0 OR NEGATIVE (ITER COUNT), REINITIALIZE.
  451.     ASSIGN 111 TO LGET
  452.     LLL=LI
  453.     GOTO 500
  454. 111    CONTINUE
  455.     IF(XVAC.GT.0.)GOTO 112
  456. C INITIALIZE COUNTS
  457.     LLL=LW
  458. C GET VALUE OF W FRACTION
  459.     ASSIGN 114 TO LGET
  460.     GOTO 500
  461. 114    CONTINUE
  462.     VW=XVAC
  463.     OLDVV=1.
  464.     DO 113 N=1,8
  465.     CCNT(N)=0
  466.     DERIV(N)=1.
  467.     DEL(N)=VW
  468. 113    CONTINUE
  469.     CAC=1
  470. C COPY CURRENT AC'S INTO SAVED ONES NOW.
  471.     DO 117 N=1,26
  472.     LLL=N
  473.     ASSIGN 118 TO LGET
  474.     GOTO 500
  475. 118    AC(N)=XVAC
  476. 117    CONTINUE
  477. C AFTER THE INIT, JUST RETURN SINCE WE DON'T WANT TO TRY ANY ITERATIONS
  478. C WHEN ITER COUNT EXPIRES.
  479.     KALKIT=0
  480.     RETURN
  481. C HERE WHEN ITER COUNT IS POSITIVE.
  482. 112    CONTINUE
  483.     XVAC=XVAC-1.
  484. C UPDATE ITERATION COUNT NOW...
  485.     KALKIT=XVAC
  486.     ASSIGN 120 TO LPUT
  487.     GOTO 600
  488. 120    CONTINUE
  489. C
  490. C NOW PROCEED WITH VARIATIONS...
  491.     IF(CAC.LT.1.OR.CAC.GT.8)CAC=1
  492.     IF(CCNT(CAC).GE.1)GOTO 200
  493. C CCNT WAS 0 SO WE DIDN'T GET OUR PARTIAL YET. VARY THE
  494. C AC WE'RE LOOKING AT (CAC = CURRENT AC) AND USE NEW VALUE OF
  495. C (X-A) FOR A NUMERICAL DERIVATIVE RESULT AFTER A RECALC OF SCREEN...
  496.     CCNT(CAC)=1
  497. C JUST STARTED THIS AC SO VARY BY THE APPROPRIATE DELTA AND
  498. C EXIT, ALLOWING PARTIAL TO BE COMPUTED NEXT TIME.
  499.     LLL=LW
  500.     ASSIGN 400 TO LGET
  501.     GOTO 500
  502. 400    CONTINUE
  503. C GET W ACC. VALUE
  504.     VW=XVAC
  505.     IF(VW.EQ.0.)VW=.5
  506. C GET CURRENT AC, FIND HOW TO UPDATE IT.
  507.     LLL=ACV(CAC)
  508.     IF(LLL.LE.0)GOTO 9900
  509.     ASSIGN 121 TO LGET
  510.     GOTO 500
  511. 121    CONTINUE
  512. C NOW XVAC HAS CURRENT AC FOR THE ONE WE'RE VARYING
  513. C ADD DEL TO IT AND GET NEW ONE...
  514. C SAVE OLD X AC VALUE FOR NEXT ITERATION.
  515. C NOTE LLL IS STILL SET AT CURRENTLY VARYING AC
  516. C SAVE CURRENT (UNVARIED) VALUE TOO FOR NEXT TIME AROUND.
  517.     OLDVV=XVAC
  518.     IF(OLDVV.EQ.0.)OLDVV=1.
  519.     IF(DEL(CAC).EQ.0.)DEL(CAC)=VW
  520.     XVAC=XVAC*(1.+DEL(CAC))
  521. C NOW ALL SET... JUST SAVE CURRENT AC'S AND CURRENT X,A
  522. C SO WE CAN GET DIFFERENCE NEXT TIME AROUND.
  523. C    AC(ACV(CAC))=XVAC
  524. C STORE XVAC INTO REAL ACCUMULATORS TOO, SO IT'LL WORK
  525. C WHEN ALL AC'S ARE RELOADED BELOW.
  526.     ASSIGN 412 TO LPUT
  527.     GOTO 600
  528. 412    CONTINUE
  529. C AT 1000, RELOAD AC ARRAY FROM REAL AC'S... BUT GET OUR MODIFIED
  530. C ONE WE JUST STORED TOO.
  531.     GOTO 1000
  532. 200    CONTINUE
  533. C COUNT HERE IS 1 SO WE ALREADY HAVE INFO NOW FOR OUR PARITAL
  534. C DERIVATIVE. COMPUTE IT AND VARY THE SELECTED AC USING IT
  535. C THEN STORE IT AND RESET CCNT(CAC) TO 0
  536.     CCNT(CAC)=0
  537. C MUST GET NEW X AND A VALUES NOW.
  538.     CALL XVBLGT(LX,ID2A,XVAC)
  539. C    XVAC=XVBLS(LX,ID2A)
  540.     IF(ID2A.NE.1)GOTO 201
  541.     LLL=LX
  542.     ASSIGN 201 TO LGET
  543. C EXTRACT CURRENT X FROM AVBLS
  544.     GOTO 500
  545. 201    CONTINUE
  546.     XCURR=XVAC
  547.     CALL XVBLGT(LA,ID2B,XVAC)
  548. C    XVAC=XVBLS(1,1)
  549.     IF(ID2B.NE.1)GOTO 202
  550.     LLL=LA
  551.     ASSIGN 202 TO LGET
  552.     GOTO 500
  553. 202    CONTINUE
  554.     ACURR=XVAC
  555. C NOW WE HAVE ENOUGH TO COMPUTE PARTIAL DERIVATIVE WE NEED.
  556.     IF(ACV(CAC).LE.0)GOTO 9900
  557.     IF(OLDVV.EQ.0.)OLDVV=AC(ACV(CAC))
  558.     IF(OLDVV.EQ.0.)OLDVV=1.
  559.     DERIV(CAC)=((XCURR-ACURR)-(OLDX-OLDA))/(DEL(CAC)*OLDVV)
  560. C NEGATIVE FEEDBACK: IF GOING POSITIVE, MAKE IT NEGATIVE...
  561. C THIS IS NOT AN ANALYTICAL PROCEDURE ... JUST STEPS IN RIGHT DIRECTION
  562. C BY APPROPRIATE AMOUNT AND CONTINUES...
  563. C CLAMP VARIATION TO INITIAL PERCENTAGE IN W ACCUMULATOR
  564.     LLL=LW
  565. C OBTAIN VALUE OF W VARIATION NOW...IN CASE USER SETS IT UP TO VARY
  566.     ASSIGN 203 TO LGET
  567.     GOTO 500
  568. 203    CONTINUE
  569.     VW=XVAC
  570. C
  571. C TO ATTEMPT TO GET TO THE ZERO OF (X-A), WE REALLY NEED TO
  572. C DIVIDE BY THE DERIVATIVE. HOWEVER, IN CASES WHERE THE FUNCTION
  573. C IS NEAR ITS LOCAL MINIMUM AND SLOWLY VARYING, WE REALLY DON'T WANT
  574. C TO STEP FAR AWAY (IT MAY NEVER REACH THE ZERO). THEREFORE, TEST
  575. C TO SEE IF THE DERIVATIVE IS LARGE AND ALLOW DIVISION WHERE IT IS
  576. C OVER A SOMEWHAT ARBITRARY THRESHOLD (USED 1.0 BELOW), BUT
  577. C MULTIPLY BY DERIVATIVE OTHERWISE, SO THAT AS THE FUNCTION APPROACHES
  578. C ZERO SLOPE, THE STEPS GET FINER TO GET INTO THE LOCAL MINIMUM (IF ANY).
  579. C
  580. C FORCE NONZERO VARIATION JUST SO WE DON'T GET STUCK.
  581.     IF(DERIV(CAC).EQ.0.)DERIV(CAC)=.01
  582.     IF(DABS(DERIV(CAC)).GT.1.)GOTO 405
  583.     DEL(CAC)=-(OLDX-OLDA)*VW*DERIV(CAC)
  584.     GOTO 406
  585. 405    CONTINUE
  586.     DEL(CAC)=-(OLDX-OLDA)*VW/DERIV(CAC)
  587. 406    CONTINUE
  588. C VERY IMPORTANT TO CLAMP SIZE OF STEPS HERE SO WE DON'T WILDLY DIVERGE
  589. C IN EARLY GOING. SMALL STEPS TAKE LONGER BUT GET TO MINIMA; LARGER ONES
  590. C WHERE WE DON'T KNOW FUNCTION SHAPE CAN BE DISASTERS.
  591.     IF(DABS(DEL(CAC)).GT.VW)DEL(CAC)=VW*SIGN(DEL(CAC))
  592. C NOW RESTORE AC'S TO OLD ONES AND VARY CURRENT ONE BY
  593. C THE NEW DELTA.
  594.     IF(ACV(CAC).LE.0)GOTO 9900
  595. C NEXT LINE MAKES ADJUSTMENT NEEDED TO OUR VARYING AC.
  596.     AC(ACV(CAC))=OLDVV*(1.+DEL(CAC))
  597. C NOW COPY SAVED OLD AC'S ONTO NEW ONES SO WE START WITH AC'S ALL AS THEY
  598. C WERE IN FIRST STEP SO WE VARY FROM INITIAL X, NOT FROM FIRST VARIED X
  599. C LOCATION...
  600.     DO 204 N=1,26
  601.     XVAC=AC(N)
  602.     LLL=N
  603.     ASSIGN 205 TO LPUT
  604.     GOTO 600
  605. 205    CONTINUE
  606. 204    CONTINUE
  607. C MOVE ON TO THE NEXT CAC VALUE
  608.     CAC=CAC+1
  609.     IF(ACV(CAC).LE.0.OR.CAC.GT.8)CAC=1
  610. 1000    CONTINUE
  611. C SAVE OLD AC'S NOW FOR NEXT TIME
  612.     DO 1100 N=1,26
  613.     LLL=N
  614.     ASSIGN 1101 TO LGET
  615.     GOTO 500
  616. 1101    AC(N)=XVAC
  617. 1100    CONTINUE
  618. C REMEMBER OLD X AND A VALUES SINCE WE LOOK FOR X=A AS
  619. C A SEARCH CONDITION. WE MUST ASSUME THAT SOME SORT OF
  620. C VARIATION OF ACCUMULATORS GIVEN WILL ALLOW US TO SATISFY
  621. C THE EQUATION (X-A)=0.
  622.     OLDX=AC(LX)
  623.     IF(ID2A.NE.1)CALL XVBLGT(LX,ID2A,OLDX)
  624. C    IF(ID2A.NE.1)OLDX=XVBLS(LX,ID2A)
  625.     OLDA=AC(LA)
  626.     IF(ID2B.NE.1)CALL XVBLGT(LA,ID2B,OLDA)
  627. C    IF(ID2B.NE.1)OLDA=XVBLS(LA,ID2B)
  628.     RETURN
  629. 9900    CONTINUE
  630.     RETCD=3
  631.     RETURN
  632. C PROC TO LOAD XVAC WITH VBLS(LLL)
  633. 500    CONTINUE
  634.     DO 501 KKKKN=1,8
  635. 501    LAC(KKKKN)=AVBLS(KKKKN,LLL)
  636.     GOTO LGET,(111,114,118,400,121,201,202,203,1101)
  637. C PROC TO STORE XVAC INTO VBLS(LLL)
  638. 600    CONTINUE
  639.     DO 601 KKKKN=1,8
  640. 601    AVBLS(KKKKN,LLL)=LAC(KKKKN)
  641.     GOTO LPUT,(120,412,205)
  642.     END
  643. c -h- xqtcmd.for    Fri Aug 22 13:45:23 1986    
  644. C $DO66
  645.     SUBROUTINE XQTCMD(ICODE)
  646. C COPYRIGHT (C) 1983,1984 GLENN AND MARY EVERHART
  647. c All Rights Reserved
  648. C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON
  649. C SCREEN. ROW 0 IN DISPLAY IS THE 27 ACCUMULATORS A-Z AND %, WITH
  650. C % BEING THE LAST-COMPUTED VALUE FROM THE CALC PROGRAM, WHICH
  651. C KNOWS HOW TO ACCESS THE DATA BUT IS JUST PASSED COMMAND STRINGS
  652. C FROM THE DISK BASED FILE HERE.
  653.     CHARACTER*1 FORM,FVLD,CMDLIN(132),CL127(127)
  654. C ALLOCATE EXTRA SLOP SPACE AFTER CMDLIN
  655.     CHARACTER*1 CLWW(136)
  656.     EQUIVALENCE(CLWW(1),CMDLIN(1))
  657.     CHARACTER*127 CMDLNA
  658.     EQUIVALENCE(CMDLIN(1),CL127(1),CMDLNA(1:1))
  659. C    EQUIVALENCE(CMDLNA,CMDLIN(1))
  660.     CHARACTER*127 WRKCHR,FORMCH,fwt
  661. C    equivalence(fwt(1:1),formch(1:1))
  662.     CHARACTER*1 LET1,LET2,FORM2(128),NMSH(80)
  663.     CHARACTER*1 WRKCHA(132),WRK127(127)
  664.     EQUIVALENCE(WRKCHA(1),WRKCHR(1:1),WRK127(1),FORM2(1))
  665. C    EQUIVALENCE(FORM2(1),WRK127(1))
  666. C ***<<<< RDD COMMON START >>>***
  667.     InTeGer*4 RRWACT,RCLACT
  668. C    COMMON/RCLACT/RRWACT,RCLACT
  669.     InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
  670.      1  IDOL7,IDOL8
  671. C    common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
  672. C     1  IDOL7,IDOL8
  673.     InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
  674. C    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
  675.     InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
  676. C    COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
  677. C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
  678. C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
  679.     InTeGer*4 KLVL
  680. C    COMMON/KLVL/KLVL
  681.     InTeGer*4 IOLVL,IGOLD
  682. C    COMMON/IOLVL/IOLVL
  683. C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
  684. C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
  685.     COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
  686.      1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
  687.      2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
  688. C ***<<< RDD COMMON END >>>***
  689. CCC    InTeGer*4 RRWACT,RCLACT
  690. CCC    COMMON/RCLACT/RRWACT,RCLACT
  691.     INTEGER*4 VNLT
  692.     EXTERNAL INDX
  693. c    EQUIVALENCE(FORM2(1),WRKCHR)
  694.     COMMON/NMSH/NMSH
  695.     REAL*8 XVBLS(1,1)
  696.     INTEGER KPYBAK
  697. CCC    Integer*4 FH
  698. CCC    Common/CONSFH/FH
  699. C ***<<< KLSTO COMMON START >>>***
  700.     InTeGer*4 DLFG
  701. C    COMMON/DLFG/DLFG
  702.     InTeGer*4 KDRW,KDCL
  703. C    COMMON/DOT/KDRW,KDCL
  704.     InTeGer*4 DTRENA
  705. C    COMMON/DTRCMN/DTRENA
  706.     REAL*8 EP,PV,FV
  707.     DIMENSION EP(20)
  708.     INTEGER*4 KIRR
  709. C    COMMON/ERNPER/EP,PV,FV,KIRR
  710.     InTeGer*4 LASTOP
  711. C    COMMON/ERROR/LASTOP
  712.     CHARACTER*1 FMTDAT(9,76)
  713. C    COMMON/FMTBFR/FMTDAT
  714.     CHARACTER*1 EDNAM(16)
  715. C    COMMON/EDNAM/EDNAM
  716.     InTeGer*4 MFID(2),MFMOD(2)
  717. C    COMMON/FRM/MFID,MFMOD
  718.     InTeGer*4 JMVFG,JMVOLD
  719. C    COMMON/FUBAR/JMVFG,JMVOLD
  720.     COMMON/KLSTO/DLFG,KDRW,KDCL,DTRENA,EP,PV,FV,KIRR,
  721.      1  LASTOP,FMTDAT,EDNAM,MFID,MFMOD,JMVFG,JMVOLD
  722. C ***<<< KLSTO COMMON END >>>***
  723. CCC    InTeGer*4 JMVFG,JMVOLD
  724.     INTEGER*4 JVBLS(2,1,1)
  725. CCC    COMMON/IOLVL/IOLVL
  726. C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
  727. C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
  728. C PUT JMVFG INTO A PSECT BY ITSELF SO IT WILL SURVIVE OVERLAYS.
  729. CCC    COMMON/FUBAR/JMVFG,JMVOLD
  730.     DIMENSION FORM(128),FVLD(1,1)
  731.     CHARACTER*1 DFE,FVWRK,FVWRK2,FRM127(127)
  732.     EQUIVALENCE(FORM(1),FORMCH(1:1),FRM127(1))
  733. C    EQUIVALENCE(FORM(1),FRM127(1)),(FRM127(1),FORMCH)
  734.     DIMENSION DFE(14)
  735.     CHARACTER*14 CDFE
  736.     EQUIVALENCE(CDFE(1:1),DFE(1))
  737. C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
  738. C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
  739. C SO INITIALLY IGNORE.
  740. C FVLD=2 = CONST NUMERIC ONLY, COMPUTED. =3, CONST, NEEDS CALC.
  741. C
  742. C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2
  743. C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN.
  744. CCC    InTeGer*4 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6,
  745. CCC     1  IDOL7,IDOL8
  746.  
  747. CCC    COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6,
  748. CCC     1  IDOL7,IDOL8
  749. CCC    InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
  750. CCC    InTeGer*4 LLCMD,LLDSP
  751. CCC    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
  752.     DIMENSION NRDSP(20,75),NCDSP(20,75)
  753.     COMMON/D2R/NRDSP,NCDSP
  754.     InTeGer*4 ILNFG,ILNCT,RCF
  755. C ***<<< NULETC COMMON START >>>***
  756.     InTeGer*4 ICREF,IRREF
  757. C    COMMON/MIRROR/ICREF,IRREF
  758.     InTeGer*4 MODPUB,LIMODE
  759. C    COMMON/MODPUB/MODPUB,LIMODE
  760.     InTeGer*4 KLKC,KLKR
  761.     REAL*8 AACP,AACQ
  762. C    COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
  763.     InTeGer*4 NCEL,NXINI
  764. C    COMMON/NCEL/NCEL,NXINI
  765.     CHARACTER*1 NAMARY(20,301)
  766. C    COMMON/NMNMNM/NAMARY
  767.     InTeGer*4 NULAST,LFVD
  768. C    COMMON/NULXXX/NULAST,LFVD
  769.     COMMON/NULETC/ICREF,IRREF,MODPUB,LIMODE,
  770.      1  KLKC,KLKR,AACP,AACQ,NCEL,NXINI,NAMARY,NULAST,LFVD
  771. C ***<<< NULETC COMMON END >>>***
  772. CCC    COMMON/NCEL/NCEL,NXINI
  773.     CHARACTER*1 ILINE(106)
  774.     COMMON/ILN/ILNFG,ILNCT,ILINE
  775. C ***<<< XVXTCD COMMON START >>>***
  776.     CHARACTER*1 OARRY(100)
  777.     InTeGer*4 OSWIT,OCNTR
  778. C    COMMON/OAR/OSWIT,OCNTR,OARRY
  779. C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
  780. C    InTeGer*4 IPS1,IPS2,MODFLG
  781.     InTeGer*4 IC1POS,IC2POS,MODFLG
  782. CCC    COMMON/ICPOS/IC1POS,IC2POS,MODFLG
  783. C    COMMON/ICPOS/IPS1,IPS2,MODFLG
  784.        InTeGer*4 XTCFG,IPSET,XTNCNT
  785.        CHARACTER*1 XTNCMD(80)
  786. C       COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
  787. C VARY FLAG ITERATION COUNT
  788.     INTEGER KALKIT
  789. C    COMMON/VARYIT/KALKIT
  790.     InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
  791.     InTeGer*4 RCMODE,IRCE1,IRCE2
  792. C    COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  793. C     1  IRCE2
  794. C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
  795. C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
  796. C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
  797. C RCFGX ON.
  798. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
  799. C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
  800. C  AND VM INHIBITS. (SETS TO 1).
  801.     INTEGER*4 FH
  802. C FILE HANDLE FOR CONSOLE I/O (RAW)
  803. C    COMMON/CONSFH/FH
  804.     CHARACTER*1 ARGSTR(52,4)
  805. C    COMMON/ARGSTR/ARGSTR
  806.     COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IC1POS,IC2POS,MODFLG,
  807.      1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
  808.      2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  809.      3  IRCE2,FH,ARGSTR
  810. C ***<<< XVXTCD COMMON END >>>***
  811. CCC    InTeGer*4 IC1POS,IC2POS,MODFLG
  812. CCC    COMMON/ICPOS/IC1POS,IC2POS,MODFLG
  813. CCC    CHARACTER*1 OARRY(100)
  814. CCC    InTeGer*4 OSWIT,OCNTR
  815. CCC    COMMON/OAR/OSWIT,OCNTR,OARRY
  816. C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
  817.     InTeGer*4 TYPE(1,1),VLEN(9)
  818.     CHARACTER*1 AVBLS(20,27),VBLS(8,1,1)
  819.     CHARACTER*1 FVLDTP
  820.     REAL*8 XAC,ZAC
  821.     EQUIVALENCE(XAC,AVBLS(1,27)),(ZAC,AVBLS(1,26))
  822.     REAL*8 XXAC,XYAC
  823.     EQUIVALENCE(XXAC,AVBLS(1,24)),(XYAC,AVBLS(1,25))
  824. CCC    InTeGer*4 NULAST,LFVD
  825. CCC    COMMON/NULXXX/NULAST,LFVD
  826. CCC    CHARACTER*1 ARGSTR(52,4)
  827. CCC    COMMON/ARGSTR/ARGSTR
  828. C    EQUIVALENCE(ARGSTR(1,1),VBLS(1,1,1))
  829. C USE VBLS ENTRIES THAT WOULD CORRESPOND TO THE UNUSED SPACE
  830. C IN VBLS ARRAY FOR ACCUMULATORS A-Z TO HOLD UP TO 4 ARGUMENTS
  831. C FROM A COMMAND < WHICH READS IN SPACE-DELIMITED ARGUMENTS.
  832. C THIS WILL ALLOW INTERACTIVE ENTRY OF DATA AND AUTO
  833. C SUBSTITUTION OF ARGUMENTS VIA THE EDit COMMAND.
  834.     EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1))
  835.     EQUIVALENCE(JVBLS(1,1,1),XVBLS(1,1))
  836.     COMMON/V/TYPE,AVBLS,VBLS,VLEN
  837. CCC    COMMON/KLVL/KLVL
  838.     CHARACTER*1 DEFVB(12)
  839. CCC    InTeGer*4 MODPUB,LIMODE
  840. CCC    COMMON/MODPUB/MODPUB,LIMODE
  841.     COMMON/DEFVBX/DEFVB
  842. CCC    InTeGer*4 FORMFG,RCFGX,PZAP,RCONE,RCMODE,
  843. CCC     1  IRCE1,IRCE2
  844. CCC    COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,
  845. CCC     1  IRCE1,IRCE2
  846. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
  847. C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
  848. C  AND VM INHIBITS. (SETS TO 1).
  849. C
  850. C DISPLAY ARRAY WILL KEEP A COPY OF VARIABLES DISPLAYED AND FORMATS
  851. C USED LOCALLY WHICH DISPLAY ROUTINE CAN USE TO SEE WHAT ACTUALLY
  852. C NEEDS TO BE REFRESHED ON SCREEN. DRWV AND DCLV ARE COLS, ROWS OF
  853. C DISPLAY ACTUALLY USED FOR SCREEN.
  854.     InTeGer*4 CWIDS(20)
  855. C CWIDS IS WIDTHS IN CHARACTERS OF COLUMNS ON DISPLAY. NOTE THAT BECAUSE
  856. C OF PECULIAR INVERSION WHICH I AM TOO LAZY TO CORRECT IT IS DIMENSIONED
  857. C AS 20 NOT 75.
  858.     REAL*8 DVS(20,75)
  859.     INTEGER*4 LDVS(2,20,75)
  860.     EQUIVALENCE(LDVS(1,1,1),DVS(1,1))
  861.     COMMON /FVLDC/FVLD
  862. C    CHARACTER*1 DFMTS(10,20,75)
  863. C 10 CHARACTERS PER ENTRY.
  864.     COMMON/DSPCMN/DVS,CWIDS
  865. C THISRW,THISCL = CURRENT DISPLAYED LOCS.
  866.     InTeGer*4 THISRW,THISCL
  867. C    CHARACTER*1 IBITMP(2258)
  868. C    COMMON/INITD/IBITMP
  869. C FOLLOWING COMMON IS TO CONTROL "EXTERNAL" CALL OF XQTCMD
  870. C TO ALLOW USE FROM INSIDE CELLS.
  871. CCC    CHARACTER*1 XTNCMD(80)
  872. CCC    InTeGer*4 XTCFG,XTNCNT,IPSET
  873. CCC    COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
  874.     CHARACTER*1 blanks
  875.     dimension blanks(30)
  876.     data blanks/30*' '/
  877. C
  878.     OSWIT=2
  879. C ISSUE A PROMPT FOR COMMAND AND DO A COMMAND
  880. C
  881. C  COMMANDS INCLUDE:
  882. C E = ENTER NUMBERS OR FORMULAS
  883. C M = MOVE DIRECTION (1,2,3,4 = U,D,L,R)
  884. C D = DISPLAY CHARACTERISTIC CHANGES
  885. C
  886. C DISPLAY ALTERING SUBCOMMANDS:
  887. C  DL V1:V2 RN:M OR CN:M - DISPLAY VARIABLE RANGE V1:V2 AT DISPLAY
  888. C  ROW OR COL N THRU M.
  889. C  RN:M MEANS ACROSS A ROW ON DISPLAY STARTING AT DISPLAY COORD N,M
  890. C  CN:M MEANS DOWN A DISPLAY COLUMN STARTING AT DISPLAY COORD N,M
  891. C  DF V1:V2 FORMAT
  892. C  SET FORMAT FOR DISPLAY OF V1 THRU V2 TO FORMAT (NOT INCL. )
  893. C  A OR L DESIGNATOR SAYS SHOW TEXT IN FORMULA BUFFER. ELSE SHOW
  894. C  NUMBER VALUE AT THAT LOC.
  895. C  DT V1:V2 F OR I - SET NUMERIC TYPE OF V1 THRU V2 TO FLOAT OR INT.
  896. C  DW N,M - SET WIDTH OF COL. N TO M CHARS WIDE.
  897. C  DB MC,MR - SET MAX COLS TO MC, MAX ROWS TO MR.
  898. C
  899. C V = VIEWSCREEN UPDATE. REDISPLAY EVERYTHING FROM SCRATCH.
  900. C VF = VIEW BUT DISPLAY FORMULAS ALL LOCS.
  901. C VM = DISABLE REDRAWING SCREEN UNTIL A V IS SEEN.
  902. C C = COPY NUMBERS/FORMULAS/DISPLAY STUFF(FORMAT)/ALL/RELOCATING
  903. C 1,2,3,4 = MOVE CURSOR UP,DOWN,LEFT,RIGHT 1 ROW/COL
  904. C (THESE DO NOT INVALIDATE CALCULATION SO RECALCULATION IS NOT
  905. C DONE FOR THESE COMMANDS.)
  906. C F FILENAME/NNN  FILL SCREEN (DISPLAYED PART ONLY) FROM FILENAME,
  907. C    SKIPPING NNN RECORDS FIRST IF CALLED FOR. /NNN PART OPTIONAL.
  908. C  (SPLITS STUFF READ IN ACROSS COLUMNS CURRENTLY DEFINED AND
  909. C   SETS FVLD FOR DISPLAY OF TEXT, NOT #S.)
  910. C AR/A n R/C ADDS/SUBTRACTS (INSERTS/DELETES) n ROWS OR COLUMNS
  911. C   AT CURENT LOCATION. AR/AA SELECTS RELOCATING/ABSOLUTE.
  912. C R = RECALCULATE SHEET. 17 = RECALCULATE MANUALLY ONLY (R RESETS)
  913. C K = DROP INTO CALC CALCULATOR (*E RETURNS TO SHEET)
  914. C L = LOCATE CURSOR (MOVE TO POSITION ON SHEET)
  915. C (L VARIABLE IS THE COMMAND, AND IT LOCATES ORIGIN ON PHYSICAL
  916. C SHEET. WILL ALSO MOVE CURSOR ON DISPLAY SHEET IF THAT CELL IS
  917. C DISPLAYED, BUT OTHERWISE DOES NOT DISPLAY THE NUMBER.)
  918. C Z = ZERO FORMULA/NUMBERS (OR ALL SHEET)
  919. C  ZERO VARIABLE ZEROES THAT VARIABLE
  920. C  ZERO VARIABLE1:VARIABLE2 ZEROES THAT RANGE (ROW OR COL)
  921. C  ZERO * ZEROES ALL OF THE SHEET.
  922. C X = EXIT (RETURNS TO OS)
  923. C P = PUT NUMBERS TO FILE. ALWAYS GENERATES P#+nn#+mm forms based on
  924. C current location.
  925. C G = GET NUMBERS OUT OF FILE. USES CURRENT ORIGIN FROM L COMMAND OR 1,1
  926. C TO ENTER NUMBERS (ALLOWS COMBINING DATA).
  927. C W = WRITE SCREEN ON PRINTER (HARDCOPY FORMAT APPROX. AS DISPLAY.)
  928. C OA VARIABLE = SET ORIGIN OF DISPLAY SHEET TO VARIABLE LOC IN
  929. C  PHYSICAL SHEET (CLAMPED TO MAX. SIZE OF SHEET). STARTS AT R1,C1 OF
  930. C  DISPLAY SHEET.
  931. C OR VARIABLE = SET ORIGIN OF DISPLAY SHEET TO LOC'N OF VARIABLE IN
  932. C  PHYSICAL SHEET. MODIFIES DISPLAY SHEET STARTING AT CURRENT DISPLAY
  933. C  LOCATION RATHER THAN AT 1,1.
  934. C
  935. C NOTE THAT N-ARY FUNCTIONS ARE FNAMEARGS,ARGS,...
  936. C AND RANGES ARE CELL1:CELLN. MULTIPLE COMMANDS IN FORMULA ARE
  937. C DELIMITED BY \ CHARACTER.
  938. C
  939. C RETURN CODES:
  940. C IF ICODE=1, COMMAND JUST MOVES ON DISPLAY, SO NO NEED TO RECALCULATE
  941. C THE ENTIRE SHEET.
  942. C ICODE =-1 ==> REINITIALIZE DISPLAY DEFAULTS
  943. C ICODE =2  ==> REDRAW WHOLE SCREEN
  944. C ICODE =-2 ==> NEW SPREAD SHEET FILE SETUP.
  945. C OTHER: ALL OK.
  946. 498    CONTINUE
  947.     KLVL=1
  948.     ICODE=3
  949. C DEFAULT RETURN CODE SAYING ALL WELL
  950. C FIRST DISPLAY CURRENT CELL AGAIN IN NORMAL.
  951.     THISRW=DROW
  952.     THISCL=DCOL
  953.     FORM(1)=0
  954. C GET IN THE CURRENT FORMAT WHEREVER WE ARE, EVEN IF NOT ON DISPLAY SHEET.
  955. C    IRRX=(PCOL-1)*60+PROW
  956.     CALL REFLEC(PCOL,PROW,IRRX)
  957.     CALL WRKFIL(IRRX,FORM2,0)
  958.     CALL CE2A(FORM2,FORM)
  959. C    READ(7'IRRX)FORM
  960.     IF(THISRW.LE.0.OR.THISCL.LE.0)GOTO 200
  961.     N1=NRDSP(THISRW,THISCL)
  962.     N2=NCDSP(THISRW,THISCL)
  963.     IXLSTC=THISCL
  964.     IXLSTR=THISRW
  965.     IF(THISCL.GT.DCLV.OR.THISRW.GT.DRWV)GOTO 200
  966. C REDRAW LAST DISPLAYED CELL IN NORMAL (I.E., NOT REVERSE) VIDEO.
  967. C    IF(ICHAR(FVLD(N1,N2)).EQ.0)GOTO 200
  968. C ONLY REDRAW NUMBERS. DIRECT DISPLAY OR NOTHING GETS IGNORED.
  969.     J=8
  970. C    IRRX=(N2-1)*60+N1
  971.     CALL REFLEC(N2,N1,IRRX)
  972. C ADD 6 COLS FOR LABELS
  973.     DO 1 M1=1,DROW
  974. C FIND DISPLAY COLUMN TO USE
  975. 1    J=J+CWIDS(M1)
  976.     J=J-CWIDS(DROW)
  977. C USE THISCL+1 TO LET 1ST ROW BE LABELS.
  978.     ICCC=THISCL+2
  979. C 0 = 1 IF VT100, 0 IF VT52
  980. C SAVE PHYS COORDS BEING DISPLAYED NEXT. FVLD CAN BE TESTED FOR NUMERICS
  981. C DIRECTLY, IF UVT100 NEEDS THAT ACCESS.
  982.     IC1POS=N1
  983.     IC2POS=N2
  984.     IF(PZAP.NE.0)GOTO 3607
  985.     CALL UVT100(1,ICCC,J)
  986. C SELECT ROW "THISCL", COL "J"
  987.     CALL UVT100(13,7,0)
  988.     CALL FVLDGT(N1,N2,FVLD(1,1))
  989. C    IF(FVLD(1,1).EQ.0)WRITE(6,5538)
  990. C5538    FORMAT('>-<')
  991.     ivv=min0(30,cwids(DROW))
  992. c reset blanks to be sure we write something even for vt52
  993. ccc    blanks(1)='>'
  994.     IF(ICHAR(FVLD(1,1)).EQ.0)CALL SWRT(BLANKS,IVV)
  995. ccc    blanks(1)=32
  996. cccccc no VT52's in PCs...
  997. C5538    FORMAT(1H+,30(a1,'\'))
  998. 3607    CONTINUE
  999. C WE CAN BE SURE THE COLUMN IS 3 WIDE OR MORE...
  1000.     CALL FVLDGT(N1,N2,FVLDTP)
  1001.     IF(ICHAR(FVLDTP).EQ.0)GOTO 200
  1002. C    IRRX=(N2-1)*60+N1
  1003. C SELECT REVERSE VIDEO
  1004.     DO 5540 KKKK=1,100
  1005. 5540    CMDLIN(KKKK)=char(32)
  1006.     CALL WRKFIL(IRRX,FORM2,0)
  1007.     CALL CE2A(FORM2,FORM)
  1008. d    write(*,1094)n1,n2,(form(kkkk),kkkk=1,40)
  1009. d1094   format(' Decoded x cell',2i10,'=',40a1)
  1010. C    READ(7'IRRX)FORM
  1011. C    IF(JCHAR(FORM(120)).LE.0)GOTO 200
  1012.     IF(JCHAR(FVLDTP).LT.0.OR.FORMFG.NE.0)
  1013.      1  WRITE(CMDLNA(1:127),8201)(FORM(II),II=1,100)
  1014. 8201    FORMAT(128A1)
  1015.     IF(FORMFG.NE.0)GOTO 4320
  1016.     DO 6301 KKK=1,9
  1017.     KKKK=ICHAR(FORM(KKK+119))
  1018. C    KKKK=DFMTS(KKK,THISRW,THISCL)
  1019. 6301    DFE(KKK+1)=CHAR(MAX0(32,KKKK))
  1020.     DFE(11)=CHAR(32)
  1021. C 32 = ASCII SPACE
  1022.     DFE(1)='('
  1023.     DFE(12)=' '
  1024.     DFE(13)=' '
  1025.     DFE(14)=')'
  1026. d    write(*,1093)dfe
  1027. d1093    format(' DFE (xqtcmd) format=',14a1,';')
  1028.     CALL TYPGET(N1,N2,TYPE(1,1))
  1029.     IF(TYPE(1,1).EQ.2.AND.JCHAR(FVLDTP).GT.0)
  1030.      1  WRITE(CMDLNA(1:127),DFE,ERR=4320)DVS(THISRW,THISCL)
  1031.     IF(TYPE(1,1).NE.2.AND.JCHAR(FVLDTP).GT.0)
  1032.      1   WRITE(CMDLNA(1:127),DFE,ERR=4320)LDVS(1,THISRW,THISCL)
  1033. C REDRAW THIS COL. WITH REVERSE VIDEO HERE.
  1034. 4320    IF(PZAP.EQ.0)CALL SWRT(CMDLIN,CWIDS(THISRW))
  1035. C9800    FORMAT('+',128(A,'\'))
  1036. 9000    FORMAT(128A1)
  1037.     IF(PZAP.EQ.0)CALL UVT100(13,0,0)
  1038. C NOTE THIS REDRAWS PREVIOUS COL. IN REVERSE VIDEO.
  1039. C NO CARRIAGE CTL
  1040. 200    CONTINUE
  1041.     IF(PZAP.NE.0)GOTO 3608
  1042.     KKKK=JCHAR(FVLDTP)
  1043. C SKIP LAST LINE UPDATE IF NOT NEEDED FOR SPEEDIER CURSOR
  1044. C POSITIONING.
  1045.     IF(NULAST.EQ.NCEL.AND.LFVD.EQ.0.AND.KKKK.EQ.0)GOTO 222
  1046.     CALL UVT100(1,LLDSP,1)
  1047.     CALL UVT100(12,2,0)
  1048.     IF(JCHAR(FORM(1)).LE.0)GOTO 222
  1049.     DO 1711 IVVVV=1,109
  1050.         IVV=110-IVVVV
  1051.     IF(JCHAR(FORM(IVV)).GT.32)GOTO 2711
  1052. 1711    CONTINUE
  1053. 2711    CONTINUE
  1054. d    write(*,4092)ncel,form(1),form(2),form(3)
  1055. d4092    format(' Xqtcmd ncel prt=',i9,' form 1-3=',3a1)
  1056.     write(fwt(1:127),9092)ncel,(form(ii),ii=1,IVV)
  1057. 9092    FORMAT(1X,I5,' Used. Curr=',109A1)
  1058.     IVV=IVV+18
  1059.     call swrt(fwt(1:127),IVV)
  1060. C3608    CONTINUE
  1061. 222    CALL UVT100(1,LLCMD,1)
  1062.     NULAST=NCEL
  1063.     LFVD=KKKK
  1064.     CALL UVT100(12,2,0)
  1065. C NOTE PROW IS ACROSS TOP, PCOL IS DOWN SIDE
  1066. C PROW GOES AS ID1, ALPHAS
  1067. C PCOL GOES AS ID2, NUMERICS
  1068.     CALL IN2AS(PROW,FORM)
  1069. C NOTE PCOL STARTS AT 2 FOR NORMAL SHEET VARIABLES. PCOL=1 IS FOR ACCUMULATORS
  1070.     CALL UVT100(13,0,0)
  1071. C WRITE OUT LABEL WITH APPROPRIATE SIZE TO HOLD ROW NUMBER
  1072. C LET PROMPT END WITH > OR : DEPENDING ON OPERATING MODE.
  1073.     FVLDTP='>'
  1074.     IF(MODPUB.EQ.1)FVLDTP=':'
  1075. d    write(*,4091)prow,pcol,fvldtp
  1076. d4091    format(' prow, pcol, mode char=',2i10,4a1)
  1077.     IF(PCOL.GE.10000)GOTO 6401
  1078.     ii=pcol-1
  1079.     write(fwt(1:127),9001,err=3608)
  1080.      1   (form(i),i=1,4),ii,FVLDTP
  1081. C    FORM(9)=FVLDTP
  1082.     III=9
  1083.     GOTO 6402
  1084. 6401    CONTINUE
  1085.     ii=pcol-1
  1086.     write(fwt(1:127),9401,err=3608)
  1087.      1   (form(i),i=1,4),ii,FVLDTP
  1088. C    FORM(10)=FVLDTP
  1089.     III=10
  1090. 6402    CONTINUE
  1091.     CALL SWRT(fwt(1:127),III)
  1092. 9401    FORMAT(4A1,I5,1A1)
  1093. 9001    FORMAT(4A1,I4,1A1)
  1094. 3608    CONTINUE
  1095.     IF(XTCFG.NE.0)GOTO 3870
  1096.     Rewind 11
  1097.     IF(IOLVL.NE.11.or.FH.eq.0)READ(IOLVL,9002,END=510,ERR=510)CMDLIN
  1098. C FOR READING THE CONSOLE, WE NEED A QIO$ TO CAPTURE ESCAPE SEQUENCES.
  1099.     IF(IOLVL.EQ.11.and.FH.ne.0)CALL GETTTL(CMDLIN)
  1100.     CALL GTMUNG(CMDLIN)
  1101. C ALLOW CMD LANGUAGE TO LOOK MORE "STANDARD" VIA MUNGE OF INPUTS
  1102. C TO DO THE "EV" OR "ET" OR "EN" FOR USER AND TREAT / AS CMD
  1103. C PREFIX...
  1104.     GOTO 3871
  1105. 3870    CONTINUE
  1106.     XTCFG=0
  1107.     DO 3872 I=1,XTNCNT
  1108.     CMDLIN(I)=XTNCMD(I)
  1109. 3872    CONTINUE
  1110. C COPY IN EXTERNAL COMMAND AND LET IT BE EXECUTED. IT'S THE USER'S
  1111. C PROBLEM IF THE COMMAND REQUIRES STILL FURTHER INPUT...
  1112. C ALSO NULL OUT SOME DELIMITER CHARS AFTER THE COMMAND READ IN.
  1113.     CMDLIN(XTNCNT+1)=Char(0)
  1114.     CMDLIN(XTNCNT+2)=Char(0)
  1115. 3871    CONTINUE
  1116. 9002    FORMAT(64A1,64A1,32A1)
  1117.     CMDLIN(132)=Char(0)
  1118.     CMDLIN(131)=Char(0)
  1119.     CMDLIN(130)=Char(0)
  1120. C  SAVE CURRENT PHYS ROW, COL IN AC'S X AND Y
  1121.     XXAC=PROW
  1122.     XYAC=PCOL
  1123. C ZAP IN SPECIAL FUNCTION KEY REPLIES INTO NORMAL FORMS
  1124.     CALL CMDMUN(CMDLIN)
  1125.     DO 9048 I=1,129
  1126.     K=130-I
  1127. C START AT BACK OF LINE AND ZAP WHITESPACE BY NULL TERMINATOR
  1128.     IF(ICHAR(CMDLIN(K)).GT.32)GOTO 9049
  1129.     CMDLIN(K)=Char(0)
  1130. C ALSO GET RID OF POSSIBLE TRAILING CR, LF.
  1131. 9048    CONTINUE
  1132. 9049    CONTINUE
  1133. C
  1134. C THIS GETS COMMAND LINE IN. NOW ACTON IT.
  1135. C REPOS'N TO OLD LINE NOW.
  1136.     CALL UVT100(1,LLCMD,1)
  1137. C
  1138. C THE FOLLOWING SECTION IMPLEMENTS THE ADDITIONAL FUNCTION OF
  1139. C JOURNALING: (DONE ON VAX ONLY SINCE SPACE REQUIREMENTS FOR FILE
  1140. C OPERATIONS MAY BE A PROBLEM ON PDP11'S).
  1141. C    Command +J FILENAME will record all remaining
  1142. C    line inputs at this point in it. (Assumes JNLFLG=0 initially)
  1143. C    Command +N closes journal file.
  1144.     K=K+1
  1145.     IF(CMDLIN(1).EQ.'+'.AND.CMDLIN(2).EQ.'J'.AND.JNLFLG.NE.1)
  1146.      1   GOTO 4290
  1147.     IF(CMDLIN(1).EQ.'+'.AND.CMDLIN(2).EQ.'N')GOTO 4292
  1148.     IF(JNLFLG.EQ.1)WRITE(10,9002)(CMDLIN(IV),IV=1,K)
  1149.     GOTO 4291
  1150. 4292    CONTINUE
  1151.     CLOSE(10)
  1152.     JNLFLG=0
  1153.     GOTO 9990
  1154. 4290    CONTINUE
  1155.     JNLFLG=1
  1156. C    USE WHATEVER FILE NAME THE USER HAS SUPPLIED AFTER THE +J
  1157. C    FOR FILE TO JOURNAL ONTO. (NO MORE QUESTIONS NEEDED.)
  1158.     CALL WASSIG(10,CMDLIN(4))
  1159.     GOTO 9990
  1160. 4291    CONTINUE
  1161. C
  1162. C
  1163. C ALLOW COMMENTS IF LINE BEGINS WITH * (JUST LIKE CALC)
  1164.     IF(CMDLIN(1).NE.'*')GOTO 6002
  1165.     ICODE=1
  1166. C NO RECALC JUST FOR COMMENTS...
  1167.     GOTO 9990
  1168. 6002    CONTINUE
  1169. C
  1170. C * NEW ****************
  1171. C ADD PLACE TO PUT IN USER COMMANDS. DEFAULT IS NONE EXIST, DO NOTHING
  1172.     IGOTIT=0
  1173.     CALL USRCMD(CMDLIN,ICODE,IGOTIT)
  1174. C WHEN WE GET A COMMAND, SET IGOTIT TO 1 AND WE THEN PROCESS COMMAND NORMALLY
  1175.     IF(IGOTIT.EQ.1)GOTO 9990
  1176. C * NEW ****************
  1177. C
  1178. C COMMAND -PROMPT  WILL READ FROM LUN 5 TO ARGSTR
  1179. C TERMINATING WITH SPACES.
  1180.     IF(CMDLIN(1).NE.'-')GOTO 350
  1181.     ICODE=5
  1182.     CALL UVT100(1,LLCMD,1)
  1183.     CALL UVT100(12,2,0)
  1184.     CALL VWRT(CMDLIN(2),49)
  1185. C    WRITE(0,9800)(CMDLIN(IV),IV=2,50)
  1186.     READ(11,9000,END=510,ERR=510)FORM2
  1187.     II=1
  1188.     KK=1
  1189.     DO 351 KKK=1,128
  1190. C LOAD UP OUR ARGUMENTS IN ARGSTR(N,1) TO ARGSTR(N,4)
  1191.     ARGSTR(KK,II)=FORM2(KKK)
  1192.     KK=KK+1
  1193.     ARGSTR(KK,II)=0
  1194.     IF(KK.LT.52)GOTO 352
  1195. 354    KK=1
  1196.     II=II+1
  1197.     IF(II.GT.4)GOTO 353
  1198. 352    CONTINUE
  1199.     IF(ICHAR(FORM2(KKK)).GT.32)GOTO 351
  1200. C ON SPACE, GO TO THE NEXT ARGUMENT. ALSO SPILL INTO
  1201. C THE NEXT ARGUMENT IF WE SEE NO SPACES AND JUST TRAIL ALONG.
  1202.     GOTO 354
  1203. 351    CONTINUE
  1204. 353    GOTO 9990
  1205. 350    CONTINUE
  1206. C
  1207. C CONTROL SCROLLING. PERMIT THE COMMAND "SC" TO TURN SCROLLING ON
  1208. C AND "NS" TO TURN IT BACK OFF.
  1209.     IVV=-1
  1210.     IF(CMDLIN(1).EQ.'S'.AND.CMDLIN(2).EQ.'C')IVV=1
  1211.     IF(CMDLIN(1).EQ.'N'.AND.CMDLIN(2).EQ.'S')IVV=0
  1212.     IF(IVV.GE.0)IDOL7=IVV
  1213.     IF(IVV.GE.0)ICODE=5
  1214.     IF(IVV.GE.0)GOTO 9990
  1215. C
  1216. C ALLOW PROGRAMMED "REWIND" OF INPUT COMMAND LINE ON
  1217. C COMMAND LINE BEGINNING WITH "<". MAKE IT CONDITIONAL
  1218. C BY SAYING THAT IF % IS NEGATIVE WE WON'T DO IT.
  1219.     IF(CMDLIN(1).NE.'<')GOTO 356
  1220.     ICODE=5
  1221.     IF(XAC.GT.0..AND.IOLVL.NE.11)REWIND IOLVL
  1222.     GOTO 9990
  1223. 356    CONTINUE
  1224. C
  1225. C HANDLE @FILE COMAND TO CHANGE TO INPUT OFF THAT FILE.
  1226.     IF(CMDLIN(1).NE.'@')GOTO 511
  1227. C WOW, A FILE. (OR AT LEAST SO WE HOPE).
  1228.     CALL RASSIG(3,CMDLIN(2))
  1229. C USE FACT THAT WE JUST NULL TERMINATED THE FILENAME PART AND SET
  1230. C IT TO BE LUN 3.
  1231.     IOLVL=3
  1232. C NOW GO BACK FOR ANOTHER COMMAND...NO SENSE WASTING RECALC TIME SINCE
  1233. C NOTHING HAS REALLY HAPPENED YET.
  1234. C NOTE EVERY READ TO LUN 3 HAS EOF/ERROR CHECK TO GO TO 510 TO RESET
  1235. C TO LUN 5 INPUT AND CLOSE FILE WE OPENED ON 3.
  1236.     GOTO 498
  1237. 511    CONTINUE
  1238. C
  1239. C AA n R, AA n C, AR n R, AR n C COMMANDS
  1240. C
  1241.     IF(CMDLIN(1).NE.'O'.OR.CMDLIN(2).NE.'V')GOTO 6887
  1242. C OV + TURNS ON OVERRIDE
  1243. C OV - TURNS OFF OVERRIDE
  1244. C ALLOWS ONE TO OVERRIDE $ SIGN FORMS' ABSOLUTE NATURE
  1245.     IF(CMDLIN(3).EQ.'+'.OR.CMDLIN(4).EQ.'+')IDOL3=1
  1246.     IF(CMDLIN(3).EQ.'-'.OR.CMDLIN(4).EQ.'-')IDOL3=0
  1247.     GOTO 9990
  1248. 6887    CONTINUE
  1249.     IF(CMDLIN(1).NE.'A')GOTO 8845
  1250. C ADD ROWS OR COLUMNS (OR REMOVE THEM) AT THE CURRENT PHYSICAL LOCATION
  1251. C WHERE AA MEANS ADD ABSOLUTE (NO RELOCATION), AR MEANS ADD RELOCATING
  1252. C (RELOCATE ALL VARIABLES BELOW), AND R OR C SAYS TO ADD/SEBTRACT ROWS
  1253. C OR COLUMNS.
  1254. C
  1255. C FIRST COLLECT THE ARGUMENTS TO THE FUNCTION.
  1256.     KM1=3
  1257.     KM2=10
  1258.     CALL GN(KM1,KM2,ICNT,CMDLIN)
  1259. C GETS THE NUMBER. IF NO NUMBER SEEN OR ZERO, RETURNS 0. IGNORE THEN.
  1260.     IF(ICNT.EQ.0)GOTO 9990
  1261.     ICR=0
  1262. C LOOK FOR THE R OR C
  1263. C START AT CMDLIN(4) TO PASS THE AR/AA AND THE NUMBER IF ANY.
  1264.     DO 8844 KKK=4,50
  1265.     IF(CMDLIN(KKK).EQ.'R')ICR=1
  1266.     IF(CMDLIN(KKK).EQ.'C')ICR=2
  1267.     IF(ICR.NE.0)GOTO 8846
  1268. C SKIP OUT ON FIRST ROW OR COLUMN DESIGNATOR SEEN
  1269. 8844    CONTINUE
  1270. 8846    CONTINUE
  1271.     IF(ICR.EQ.0)GOTO 9990
  1272.     ICODE=2
  1273. C NOW WE HAVE ALL ARGUMENTS. SET UP FOR THE COPY AND PARASITE THE
  1274. C LOGIC USED FOR THE CA OR CR COMMANDS. (NOTE THAT 2ND CHARACTER
  1275. C IS A OR R IN CMDLIN ALREADY SO THOSE COMMANDS' LOGIC WILL BE OK.)
  1276.     JRTR=PROW
  1277.     JRTC=PCOL
  1278.     IF(ICR.EQ.2)JRTC=1
  1279.     IF(ICR.EQ.1)JRTR=1
  1280. C RELOC THESHOLD IS PHYSICAL CURRENT POSITION.
  1281.     IF(ICR.EQ.1)GOTO 8843
  1282. C INSERT OR DELETE COLUMNS
  1283. C FIRST FIGURE OUT HOW MANY COLUMNS MUST BE MOVED RIGHT
  1284.     KD=60-PROW-IABS(ICNT)+1
  1285. C LET THIS WORK ONLY ON PRIME SHEET. TOO HARD TO FIGURE IT OUT ON REFLECTED
  1286. C ONES AND IT'LL FOUL LOTS OF USERS UP.
  1287.     IF(KD.LE.0)GOTO 9990
  1288. C CAN'T MOVE 0 COLUMNS. DOESN'T MAKE SENSE.
  1289.     DO 8842 KR=1,KD
  1290.     IRA=60-KR+1
  1291. C IRA IS DESTINATION COLUMN IN EACH LOOP.
  1292.     IF(ICNT.LT.0)IRA=PROW-1+KR
  1293. C IRS IS SOURCE COLUMN
  1294.     IRS=60-KR+1-ICNT
  1295.     IF(ICNT.LT.0)IRS=PROW+KR-ICNT-1
  1296. C
  1297. C IF DELETING COLUMNS AND DESTINATION IS PAST CURRENT
  1298. C ACTIVE MAX, SKIP THE MOVE SINCE WE'RE NOT ACCOMPLISHING ANYTHING.
  1299.     IF(ICNT.LT.0.AND.IRA.GT.RRWACT)GOTO 8842
  1300. C IF ADDING COLUMNS AND SOURCE IS PAST CURRENT MAX ACTIVE THEN
  1301. C WE'RE DOING NOTHING, SO SKIP THE WORK
  1302.     IF(ICNT.GT.0.AND.IRS.GT.RRWACT)GOTO 8842
  1303.     JDELT=RCLACT
  1304. C    JDELT=301
  1305. C LOOP WE'LL CALL IS OVER ENTIRE ROWS, BUT ONLY DO ONE AT A TIME HERE
  1306.     JD1A=IRA
  1307.     JD1B=1
  1308.     ID1A=IRS
  1309.     ID2A=1
  1310.     I1IN=0
  1311.     I2IN=1
  1312.     JIN1=0
  1313.     JIN2=1
  1314.     ASSIGN 8840 TO KPYBAK
  1315. C CALL INTERNAL COPY-RANGE PROCEDURE INSIDE CA/CR LOGIC
  1316.     GOTO 8364
  1317. 8840    CONTINUE
  1318. 8842    CONTINUE
  1319. C
  1320. C NOW CLEAN UP THE REST OF FORMULAS IF THERE ARE ANY TO DO...
  1321. C MUST RELOCATE OTHER FORMULAE IF CMDLIN(2) IS R
  1322.     KX=PROW-1
  1323. C RELY ON RCLACT HAVING BEEN UPDATED TO REFLECT NEW
  1324. C ADDITIONS IF ANY
  1325.     KY=RCLACT
  1326. C    KY=301
  1327. C RELOCATE UPPER LEFT PART OF SHEET
  1328. C NOTE II1,II2,JJ1,JJ2,JRTR,JRTC ARE UNCHANGED FROM PRIOR CALL SO
  1329. C MAY BE USED... RELVBL ONLY CARES ABOUT RELATIVE MOTION ANYHOW...
  1330. 3600    CONTINUE
  1331.     IF(CMDLIN(2).NE.'R'.OR.KX.LE.0.OR.KY.LE.0)GOTO 9990
  1332.     DO 3601 KK=1,KX
  1333.     DO 3601 KK2=1,KY
  1334.     CALL FVLDGT(KK,KK2,FVLD(1,1))
  1335.     IF(ICHAR(FVLD(1,1)).NE.1)GOTO 3601
  1336. C ONLY RELOCATE FORMULAS, NOT TEXT OR NUMBERS (OR EMPTIES...)
  1337. C    IRX=(KK2-1)*60+KK
  1338.     CALL REFLEC(KK2,KK,IRX)
  1339.     CALL WRKFIL(IRX,FORM,0)
  1340. C    READ(7'IRX)FORM
  1341.     CALL RELVBL(FORM,FORM2,II1,II2,JJ1,JJ2,JRTR,JRTC)
  1342.     CALL WRKFIL(IRX,FORM2,1)
  1343. C    WRITE(7'IRX)FORM2
  1344. 3601    CONTINUE
  1345.     GOTO 9990
  1346. 8843    CONTINUE
  1347. C ROW INSERT/DELETE
  1348. C AGAIN FIND HOW MANY ROWS TO MOVE.
  1349.     KD=301-PCOL-IABS(ICNT)+1
  1350.     IF(KD.LE.0)GOTO 9990
  1351.     DO 8839 KC=1,KD
  1352. C ICA = DESTINATION AND ICS IS SOURCE
  1353.     ICA=301-KC+1
  1354.     ICS=301-KC+1-ICNT
  1355.     IF(ICNT.GT.0)GOTO 8838
  1356.     ICA=PCOL-1+KC
  1357.     ICS=PCOL+KC-1-ICNT
  1358. 8838    CONTINUE
  1359. C IF INSERTING ROWS AND SRC ROW IS BEYOND ACTIVE AREA, SKIP
  1360.     IF(ICNT.GT.0.AND.ICS.GT.RCLACT)GOTO 8839
  1361. C IF DELETING ROWS AND DST ROW IS BEYOND ACTIVE AREA, SKIP
  1362.     IF(ICNT.LT.0.AND.ICA.GT.RCLACT)GOTO 8839
  1363. C NOW CALL COPY LOOP AGAIN.
  1364.     JDELT=RRWACT
  1365. C    JDELT=60
  1366.     JD1A=1
  1367.     JD1B=ICA
  1368. C DEST
  1369.     ID1A=1
  1370.     ID2A=ICS
  1371. C SOURCE
  1372.     I1IN=1
  1373.     I2IN=0
  1374.     JIN1=1
  1375.     JIN2=0
  1376.     ASSIGN 8836 TO KPYBAK
  1377. C CALL INTERNAL RANGE COPY PROCEDURE TO COPY A ROW
  1378.     GOTO 8364
  1379. 8836    CONTINUE
  1380. 8839    CONTINUE
  1381.     KX=RRWACT
  1382. C    KX=60
  1383.     KY=PCOL-1
  1384.     GOTO 3600
  1385. 8845    CONTINUE
  1386. C OA AND OR COMMANDS. SET DISPLAY SHEET MAPPING TO ORIGIN AS FOUND BY
  1387. C  VARIABLE, STARTING AT 1,1 OR (DROW,DCOL) FOR OA AND OR RESPECTIVELY.
  1388.     IF(CMDLIN(1).NE.'O')GOTO 650
  1389. C PROCESS COMMAND...
  1390.     LRO=1
  1391.     LCO=1
  1392.     IF(CMDLIN(2).EQ.'R')LRO=MAX0(1,DROW)
  1393.     IF(CMDLIN(2).EQ.'R')LCO=MAX0(1,DCOL)
  1394.     LRO=MIN0(LRO,19)
  1395.     LCO=MIN0(LCO,74)
  1396. C    LRO=MIN0(LRO,(20-1))
  1397. C    LCO=MIN0(LCO,(75-1))
  1398. C NOW HAVE CORRECT ORIGIN IN DISPLAY SHEET TO USE SET UP.
  1399. C GRAB VARIABLE ID.
  1400.     LA=INDX(CMDLIN,32)
  1401.     IF(LA.GT.20)LA=3
  1402.     LE=40
  1403.     CALL VARSCN(CMDLIN,LA,LE,LSTCX,ID1,ID2,IVLD)
  1404.     IF(IVLD.EQ.0)GOTO 651
  1405. C NOW HAVE VARIABLE NAME AND LOCATION... CAN DO IT FINALLY.
  1406. C NOTE WE'RE GUARANTEED WE START OFF IN BOUNDS BUT MUST CHECK
  1407. C ALONG THE WAY TO BE SURE WE STAY THAT WAY.
  1408.     IQQ=0
  1409.     KKKK=0
  1410.     IF(CMDLIN(3).NE.'D')GOTO 6712
  1411. c allow ORA or ORD commands to leave window displacements
  1412. c alone. Fix up so this is default mode for scrolling (making
  1413. c program behavior easier to understand.)
  1414. 7112    CONTINUE
  1415.     KKKK=1
  1416. 6712    CONTINUE
  1417.     KKKKK=NRDSP(LRO,LCO)
  1418.     KKKKKK=NCDSP(LRO,LCO)
  1419. 5711    CONTINUE
  1420. C TO ALLOW REFLECTIONS MUST ALLOW ALL SORTS OF ORIGINS.
  1421.     DO 652 IRO=LRO,DRWV
  1422.     DO 653 ICO=LCO,DCLV
  1423. C HERE CAN SET UP NRDSP AND NCDSP SUITABLY
  1424.     IVV=IRO-LRO
  1425.     IVVV=ICO-LCO
  1426.     IF(KKKK.EQ.0)GOTO 1653
  1427.     IVV=NRDSP(IRO,ICO)-KKKKK
  1428.     IVVV=NCDSP(IRO,ICO)-KKKKKK
  1429. 1653    CONTINUE
  1430.     NRDSP(IRO,ICO)=ID1+IVV
  1431.     NCDSP(IRO,ICO)=ID2+IVVV
  1432. 653    CONTINUE
  1433. 652    CONTINUE
  1434.     IF(DROW.LE.0.OR.DCOL.LE.0)GOTO 3924
  1435.     PROW=NRDSP(DROW,DCOL)
  1436.     PCOL=NCDSP(DROW,DCOL)
  1437. 3924    CONTINUE
  1438. C FORCE REDRAW OF WHOLE SHEET.
  1439.     ICODE=6
  1440.     IF(RCMODE.LE.0)GOTO 9990
  1441. C SKIP RECALC IF IN OLD MODE...
  1442.     ICODE=2
  1443. 651    GOTO 9990
  1444. 650    CONTINUE
  1445. C F FILENAME/NNN
  1446. C READ IN TEXT FROM FILE NAMED AND SPREAD ACROSS DISPLAY SCREEN. SET
  1447. C DISPLAYED SCREEN INTO FVLD(NN)=-1 TO SHOW TEXT ONLY.
  1448.     IF(CMDLIN(1).NE.'F')GOTO 1740
  1449.     LA=INDX(CMDLIN,32)
  1450. C PASS SPACE
  1451.     KKK=ICHAR('/')
  1452.     LB=INDX(CMDLIN(LA+1),KKK)
  1453.     LB=LB+LA
  1454. C LB= LOC OF / CHARACTER
  1455.     LB=MIN0(80,LB)
  1456.     IF(LB.LE.2)GOTO 1741
  1457.     IF((LB-LA).LE.1) GOTO 1741
  1458.     CMDLIN(LB)=0
  1459.     CALL RASSIG(4,CMDLIN(LA+1))
  1460. C THIS OUGHT TO OPEN THE FILE IF IT EXISTS..
  1461. C NOW IF THERE'S A NUMBER THERE, EXTRACT IT.
  1462.     LSKP=0
  1463.     IF(LB.GT.78.OR.LB.LE.5)GOTO 1743
  1464.     LAA=LB+1
  1465.     LAAA=LB+7
  1466.     CALL GN(LAA,LAAA,LSKP,CMDLIN)
  1467. 1743    CONTINUE
  1468. C NOW SKIP THE LINES
  1469.     IF(LSKP.LE.0)GOTO 1744
  1470.     DO 1745 IV=1,LSKP
  1471.     READ(4,8201,END=1742,ERR=1742)FORM2
  1472. 1745    CONTINUE
  1473. 1744    CONTINUE
  1474. C NOW WE'RE READY TO READ IN THE STUFF.
  1475.     ICODE=2
  1476.     DO 1746 LA=1,DCLV
  1477.     DO 1751 IV=1,128
  1478. 1751    FORM2(IV)=Char(32)
  1479.     READ(4,8201,END=1742,ERR=1742)FORM2
  1480.     IXC=0
  1481.     DO 1747 LB=1,DRWV
  1482. C DRWV = # ACROSS TOP...
  1483. C DCLV=LENGTH
  1484.     ID1=NRDSP(LB,LA)
  1485.     ID2=NCDSP(LB,LA)
  1486. C GET PHYSICAL SHEET COORDINATES AS ID1,ID2
  1487. C MUST THEN COPY CWIDS(LB) CHARS ONTO FILE...
  1488.     CALL FVLDST(ID1,ID2,char(255))
  1489. C    FVLD(ID1,ID2)=-1
  1490. C    IRX=(ID2-1)*60+ID1
  1491.     CALL REFLEC(ID2,ID1,IRX)
  1492.  
  1493.     CALL WRKFIL(IRX,FORM,0)
  1494. C    READ(7'IRX)FORM
  1495.     FORM(119)=Char(255)
  1496.     DO 1749 IVV=1,110
  1497. 1749    FORM(IVV)=0
  1498.     DO 1748 IVV=1,CWIDS(LB)
  1499.     IXC=IXC+1
  1500. 1748    FORM(IVV)=FORM2(IXC)
  1501.     CALL WRKFIL(IRX,FORM,1)
  1502. 1747    CONTINUE
  1503. 1746    CONTINUE
  1504. 1742    CLOSE(4)
  1505. 1741    GOTO 9990
  1506. 1740    CONTINUE
  1507.     IF(CMDLIN(1).NE.'E')GOTO 8000
  1508. C ENTER COMMAND
  1509. C EN expression. expression may be numbers/text.
  1510.     LA=INDX(CMDLIN,32)
  1511.     LA=LA+1
  1512. C SKIP SPACE AFTER "EN"
  1513.     IF(LA.GT.4)LA=4
  1514.     IF (LA.GE.100)GOTO 7901
  1515.     LE=132-LA
  1516.     LE=MIN0(110,LE)
  1517. C    IRX=(PCOL-1)*60+PROW
  1518.     CALL REFLEC(PCOL,PROW,IRX)
  1519. C FIND WHERE IN FILE TO STORE.
  1520.     CALL WRKFIL(IRX,FORM2,0)
  1521.     CALL CE2A(FORM2,FORM)
  1522. C    READ(7'IRX)FORM
  1523.     IF(CMDLIN(2).EQ.'D')
  1524.      1   CALL SED(CMDLIN(LA),FORM,FORM2,ARGSTR,ZAC,110)
  1525. C IF COMMAND IS "ED <DELIM>STRING1<DELIM>STRING2<DELIM>" THEN
  1526. C  SUBSTITUTE STRING2 FOR STRING1 IN FORMULA, RETURN IT TO THE
  1527. C  COMMAND LINE, AND REENTER IT.
  1528. C  NOTE THAT THE STRINGS MAY CONTAIN &n FORMS WHERE 1-4 MEAN
  1529. C  ENTERED ARGUMENTS 1-4, 5 TREATS XAC AS A NUMBER, AND 6
  1530. C  TREATS ZAC AS A SINGLE CHARACTER (ZAC IS VARIABLE Z).
  1531.     DO 5133 II=1,110
  1532. 5133    FORM(II)=0
  1533.     NALF=0
  1534.     NSG=-1
  1535.     NXNUM=3
  1536.     KSG=0
  1537.     N=1
  1538.     IRCE1=PROW
  1539.     IRCE2=PCOL
  1540. C SAVE FOR RE, RI MODES
  1541.     IF(CMDLIN(2).EQ.'T'.OR.CMDLIN(2).EQ.'"')KSG=1
  1542. C "ET" FORMULA ENTERS TEXT ONLY
  1543. C "EV" FORMULA ENTERS NUMBER
  1544.     IF(CMDLIN(2).EQ.'V')NSG=1
  1545. 2097    CONTINUE
  1546.     IF(N.GT.LE)GOTO 7902
  1547. C    DO 7902 N=1,LE
  1548. C LOOK FOR ALPHAS. IF WE FIND ANY, FLAG NOT NUMERIC
  1549. C NOTE @ INCLUDED SINCE COULD HAVE A *@3 COMMAND TO CALL 3.CMD
  1550. C AND REFER TO OTHER CELLS.
  1551. C THIS IS A RESTRICTION: COMMANDS TO CMND NEED TO HAVE ALPHAS
  1552. C SOMEWHERE OR THIS WILL BE FOOLED.
  1553.     IF(CMDLIN(LA).EQ.'P'.AND.
  1554.      1  CMDLIN(LA+1).EQ.'#'.AND.
  1555.      2  CMDLIN(LA+2).EQ.'0'.AND.
  1556.      3  CMDLIN(LA+3).EQ.'#'.AND.
  1557.      4  CMDLIN(LA+4).EQ.'0') GOTO 3356
  1558.     IF(ICHAR(CMDLIN(LA)).GE.ICHAR('@').AND.ICHAR(CMDLIN(LA))
  1559.      1  .LE.ICHAR('Z'))NXNUM=1
  1560. 3356    CONTINUE
  1561.     IF(CMDLIN(LA).EQ.'+'.OR.CMDLIN(LA).EQ.'-')NSG=1
  1562.     IF(CMDLIN(LA).EQ.'['.OR.CMDLIN(LA).EQ.'.')NSG=1
  1563.     IF(CMDLIN(LA).EQ.'(')NSG=1
  1564.     IF(CMDLIN(LA).EQ.'"')KSG=1
  1565. C ON SEEING THE _@V1,V2 CONSTRUCT, REPLACE WITH THE VARIABLE
  1566. C ADDRESSED BY V1,V2 (COL,ROW) BY NAME.
  1567. C ON SEEING THE _#V1 CONSTRUCT, UNPACK UP TO 8 CHARS OUT OF
  1568. C REAL*8 VARIABLE (PACKED BY MULTIPLYING BY 128 EARLIER).
  1569. C  IN EACH CASE, ADJUSTN AND LE TO CONTINUE APPROPRIATELY.
  1570.     IF(CMDLIN(LA).EQ.'_'.AND.CMDLIN(LA+1).EQ.'@')CALL
  1571.      1  SVBL(CMDLIN,LA,N,LE,FORM)
  1572.     IF(CMDLIN(LA).EQ.'_'.AND.CMDLIN(LA+1).EQ.'#')CALL
  1573.      1  SSTR(CMDLIN,LA,N,LE,FORM)
  1574.     FORM(N)=CMDLIN(LA)
  1575.     IF(ICHAR(CMDLIN(LA)).GT.32)NALF=NALF+1
  1576.     LA=LA+1
  1577. C FAKE OUT DO LOOP SINCE SVBL OR SSTR MAY MUNG INDICES INSIDE IT
  1578.     N=N+1
  1579.     GOTO 2097
  1580. 7902    CONTINUE
  1581.     IF(KSG.NE.0)NSG=-1
  1582.     FORM(110)=0
  1583.     IF(ICHAR(FORM(119)).NE.0)GOTO 7903
  1584. C LEAVE DISPLAY INDICATOR ALONE IF SET BUT SET VBL OTHERWISE.
  1585.     IVVVV=NSG*NXNUM
  1586.     FORM(119)=CHAR(IVVVV)
  1587. C SET NEG FOR DISPLAY OF FORMULA, NOT NUMBER. ALLOWS TEXT ENTRY.
  1588. C ASSUME FORMULA IF WE SEE + OR -
  1589. 7903    CONTINUE
  1590. C FORCE FORM TO FOLLOW EDITS EVEN IF FORMAT/TYPE PRESET.
  1591.     IVVVV=JCHAR(FORM(119))
  1592.     IF(IVVVV.NE.0)FORM(119)=CHAR(ISGN(IVVVV)*NXNUM)
  1593.     IF(NALF.LE.0)GOTO 6221
  1594.     CALL FVLDST(PROW,PCOL,FORM(119))
  1595. C ENCODE CELL NAMES PRIOR TO STORING
  1596.     CALL CA2E(FORM,FORM2)
  1597.     CALL WRKFIL(IRX,FORM2,1)
  1598. 6221    CONTINUE
  1599.     ASSIGN 7904 TO NBK
  1600.     GOTO 7905
  1601. C LOOK UP PROW, PCOL, LEAVE DISPLAY COORDS IN LR,LC
  1602. 7905    CONTINUE
  1603.     DO 7906 LA1=1,DRWV
  1604.     LR=LA1
  1605.     DO 7906 LA2=1,DCLV
  1606.     LC=LA2
  1607.     IF(NRDSP(LA1,LA2).EQ.PROW.AND.NCDSP(LA1,LA2).EQ.PCOL)GOTO7907
  1608. 7906    CONTINUE
  1609. C IF WE FALL OUT OF THE LOOP, WE DIDN'T FIND THE LOC; FLAG BY PUTTING 0'S.
  1610.     LR=0
  1611.     LC=0
  1612.     GOTO 7908
  1613. 7907    CONTINUE
  1614. C ARRIVE HERE ON SUCCESS. LR, LC ALL SET UP.
  1615. 7908    CONTINUE
  1616.     GOTO NBK,(7904,8901,8957)
  1617. 7904    CONTINUE
  1618.     IF(LR.EQ.0.OR.LC.EQ.0)GOTO 7901
  1619.     THISRW=LR
  1620.     THISCL=LC
  1621. C    ASCII 1,2,3,4 ARE VALUES 49,50,51,52 IN DECIMAL.
  1622.     LRO=1
  1623.     LCO=1
  1624.     ID1=NRDSP(1,1)
  1625.     ID2=NCDSP(1,1)
  1626.     IF(.NOT.(JMVFG.EQ.51.AND.THISRW.EQ.1))GOTO 7110
  1627. C MUST SCROLL LEFT
  1628.     IF(IDOL7.EQ.0)GOTO 7110
  1629.     IF(ID1.LE.1)GOTO 7110
  1630.     ID1=MAX0(1,ID1-DRWV+2)
  1631.     DROW=MAX0(1,DRWV-2)
  1632.     IQQ=1
  1633.     GOTO 7112
  1634. 7110    CONTINUE
  1635.     IF(JMVFG.EQ.51)THISRW=MAX0(1,(THISRW-1))
  1636.     IF(.NOT.(JMVFG.EQ.52.AND.THISRW.EQ.DRWV))GOTO 7116
  1637. C MUST SCROLL RIGHT
  1638.     IF(IDOL7.EQ.0)GOTO 7116
  1639.     DROW=3
  1640. C    ID1=MIN0(60,ID1+DRWV-MIN0(DRWV,2))
  1641.     ID1=ID1+DRWV-MIN0(DRWV,2)
  1642.     IQQ=1
  1643.     GOTO 7112
  1644. C 7112 FAKES OUT OA CALL TO SCROLL OVER.
  1645. 7116    CONTINUE
  1646.     IF(JMVFG.EQ.52)THISRW=MIN0((THISRW+1),DRWV)
  1647.     IF(.NOT.(JMVFG.EQ.49.AND.THISCL.EQ.1))GOTO 7117
  1648. C MUST SCROLL UP
  1649.     IF(IDOL7.EQ.0)GOTO 7117
  1650.     IF(ID2.LE.2)GOTO 7117
  1651.     DCOL=MAX0(1,DCLV-2)
  1652.     ID2=MAX0(2,ID2-DCLV+2)
  1653.     IQQ=1
  1654.     GOTO 7112
  1655. 7117    CONTINUE
  1656.     IF(JMVFG.EQ.49)THISCL=MAX0(1,(THISCL-1))
  1657.     IF(.NOT.(JMVFG.EQ.50.AND.THISCL.EQ.DCLV))GOTO 7118
  1658. C MUST SCROLL DOWN
  1659.     IF(IDOL7.EQ.0)GOTO 7118
  1660.     DCOL=3
  1661. C    ID2=MIN0(301,ID2+DCLV-MIN0(DCLV,2))
  1662.     ID2=ID2+DCLV-MIN0(DCLV,2)
  1663.     IQQ=1
  1664.     GOTO 7112
  1665. 7118    CONTINUE
  1666.     IF(JMVFG.EQ.50)THISCL=MIN0((THISCL+1),DCLV)
  1667.     DROW=THISRW
  1668.     DCOL=THISCL
  1669.     PROW=NRDSP(DROW,DCOL)
  1670.     PCOL=NCDSP(DROW,DCOL)
  1671. C FORCE REDO OF BOTH LAST AND NEW COLUMN BY DISPLAYER.
  1672.     DVS(LR,LC)=DVS(LR,LC)+.0000000057
  1673.     DVS(DROW,DCOL)=DVS(DROW,DCOL)+.000000062
  1674. 7901    GOTO 9990
  1675. 8000    IF(CMDLIN(1).NE.'M')GOTO 8001
  1676.     ICODE=1
  1677. C MACROCELL COMMAND IF MH (HIDE) OR MS (SHOW)
  1678.     IF(CMDLIN(2).EQ.'S')IDOL4=1
  1679.     IF(CMDLIN(2).EQ.'H')IDOL4=0
  1680.     IF(CMDLIN(2).EQ.'S'.OR.CMDLIN(2).EQ.'H')GOTO 9990
  1681. C MOVE COMMAND
  1682. C M1,M2,M3,M4 MOTION DIRECTION IS U,D,L,R
  1683.     IVVV=ICHAR(CMDLIN(2))
  1684. C ALLOW M0 TO MEAN RESTORE PRIOR STATE OF AUTOMOVE AND
  1685. C SAVE CURRENT STATE AS NEW PRIOR ONE. M1 THRU M5 MEAN SET
  1686. C AUTOMOVE TO 1-5 (5=NO MOTION) AND SAVE OLD STATE AS LAST
  1687. C STATE.
  1688.     IF(CMDLIN(2).EQ.'0')IVVV=JMVOLD
  1689.     JMVOLD=JMVFG
  1690.     JMVFG=IVVV
  1691. C    JMVFG=ICHAR(CMDLIN(2))
  1692. C STORE CHARACTER AS MOVE FLAG
  1693.     GOTO 9990
  1694. 8001    IF(CMDLIN(1).NE.'D')GOTO 8002
  1695. C DISPLAY COMMANDS
  1696. C
  1697. C DISPLAY SORT
  1698. C DSRA 1
  1699. C DS = CONSTANT KEYWORD
  1700. C R/C=ROW/COL (DISPLAY COORD #S)
  1701. C A/D=ASCENDING/DESCENDING ORDER
  1702. C NUMBER= DISPLAY COORD ROW/COL # TO SORT ON.
  1703. C SORTS NUMERIC FIELDS ONLY.
  1704.     IF(CMDLIN(2).NE.'S')GOTO 1752
  1705.     ICODE=2
  1706. C MUST REDRAW. WE DO WHOLESALE RELOCATIONS OF THINGS HERE.
  1707. C FIRST GET ARGUMENTS
  1708.     LAA=6
  1709.     LBB=15
  1710.     CALL GN(LAA,LBB,NBR,CMDLIN)
  1711. C THIS EXTRACTS THE NUMBER OF ROW/COL TO USE.
  1712. C DEFAULT IS PHYS, COL, ASCENDING
  1713. C    IF(NBR.LE.0.OR.NBR.GT.MAX0(20,75))GOTO 9990
  1714.     IF(NBR.LE.0.OR.NBR.GT.75)GOTO 9990
  1715.     SSIGN=1.
  1716.     IF(CMDLIN(4).EQ.'D')SSIGN=-1.
  1717. C SSIGN USED TO CONTROL ASCENDING/DESCENDING SORT (MULTIPLY BY IT)
  1718. C GET LENGTH TO GO THRU IN SORT
  1719.     IF(CMDLIN(3).EQ.'C')IDELTA=DCLV-1
  1720.     IF(CMDLIN(3).EQ.'R')IDELTA=DRWV-1
  1721.     I1IN=0
  1722.     I2IN=1
  1723. C GET PHYSICAL COORDINATES OF ROW/COL WE'RE SORTING ON.
  1724.     IF(CMDLIN(3).EQ.'R')GOTO 6222
  1725.     ID1=NRDSP(NBR,1)
  1726.     ID2=NCDSP(NBR,1)
  1727.     GOTO 1753
  1728. 6222    CONTINUE
  1729.     ID1=NRDSP(1,NBR)
  1730.     ID2=NCDSP(1,NBR)
  1731.     I1IN=1
  1732.     I2IN=0
  1733. C HACK TO HANDLE ROW/COL ALIKE
  1734. 1753    CONTINUE
  1735.     IFLIP=0
  1736. C IFLIP = BUBBLESORT FLAG WE CHANGED SOMETHING
  1737. C (USE SIMPLE MINDED SMALL SORT. TOO MUCH OVHD FOR BETTER ONE...NO ROOM)
  1738.     ID1A=ID1
  1739.     ID2A=ID2
  1740. C IGNORE CASE OF IDELTA=0... SHOULDN'T BE ANY WAY FOR THAT TO HAPPEN
  1741.     DO 1754 IV=1,IDELTA
  1742. C SORT HERE. IFLIP=1 IF WE INVERT ANYTHING.
  1743. C JUST COMPARE XVBLS...
  1744. C NOTE WE ASSUME A "NORMAL" TYPE DISPLAY, JUST RESET PHYSICAL STUFF.
  1745.     CALL XVBLGT(ID1A,ID2A,XAC)
  1746.     CALL XVBLGT(ID1A+I1IN,ID2A+I2IN,XVBLS(1,1))
  1747.     IF(XAC*SSIGN.LE.XVBLS(1,1)*SSIGN)GOTO 1755
  1748. C FLIP ASSIGNMENTS
  1749. C FLIP XVBLS NUMBERS TOO TO MAINTAIN SORT. WE RECOMPUTE ANYWAY..
  1750.     CALL XVBLST(ID1A+I1IN,ID2A+I2IN,XAC)
  1751.     CALL XVBLST(ID1A,ID2A,XVBLS(1,1))
  1752.     IFLIP=1
  1753. C SWAP ASSIGNMENTS OF DISPLAY STUFF IF IN RANGE
  1754. C OPERATES LIKE A SORTED OA COMMAND
  1755. C CURRENT PHYSICAL ROW IS ID2A (1...RCL LIMITS)
  1756. C AND PHYS COL IS ID1A.
  1757. C    LDELTA=DRW-1
  1758.     LDELTA=19
  1759. C FOR REASSIGNMENT, ROLE OF I1IN,I2IN CAN BE REVERSED...
  1760.     ID1B=1
  1761. C NOTE DISPLAY ID2 IS 1 LESS THAN PHYSICAL ONE. (AC'S)
  1762.     ID2B=ID2A-1
  1763.     IF(ID2B.LE.0)GOTO 1754
  1764.     IF(CMDLIN(3).NE.'R')GOTO 1756
  1765. C ROW...
  1766. C    LDELTA=DCL-1
  1767.     LDELTA=74
  1768. C ID1 SAME AS DISPLAY COORDS
  1769.     ID1B=ID1A
  1770.     ID2B=1
  1771. 1756    CONTINUE
  1772.     DO 1757 IVV=1,LDELTA
  1773. C FLIP THE ROW/COL 1 ENTRY AT A TIME. JUST CHANGES ASSIGNMENTS.
  1774.     JD1=NRDSP(ID1B,ID2B)
  1775.     JD2=NCDSP(ID1B,ID2B)
  1776.     NRDSP(ID1B,ID2B)=NRDSP(ID1B+I1IN,ID2B+I2IN)
  1777.     NCDSP(ID1B,ID2B)=NCDSP(ID1B+I1IN,ID2B+I2IN)
  1778.     NRDSP(ID1B+I1IN,ID2B+I2IN)=JD1
  1779.     NCDSP(ID1B+I1IN,ID2B+I2IN)=JD2
  1780.     ID1B=ID1B+I2IN
  1781.     ID2B=ID2B+I1IN
  1782. 1757    CONTINUE
  1783. C WE CAN ALWAYS FLIP SINCE WE STAY ON DISPLAY SHEET.
  1784. 1755    CONTINUE
  1785.     ID1A=ID1A+I1IN
  1786.     ID2A=ID2A+I2IN
  1787. 1754    CONTINUE
  1788. C DONE 1 PASS. IF ANYTHING CHANGED, TRY AGAIN.
  1789.     IF(IFLIP.NE.0)GOTO 1753
  1790. C DONE SORT AT END
  1791.     GOTO 9990
  1792. 1752    CONTINUE
  1793. C
  1794.     IF(CMDLIN(2).NE.'L')GOTO 8101
  1795. C DL = DISPLAY LOCATE V1:V2 N:M
  1796.     ASSIGN 8103 TO IBACK
  1797.     GOTO 8104
  1798. C STRIP VARIABLE NAMES OFF CMD LINE STARTING AT POSITION 3
  1799. 8104    LA=3
  1800.     LE=98
  1801.     L1=0
  1802.     CALL VARSCN(CMDLIN(1),LA,LE,LSTC,ID1A,ID2A,IVLD)
  1803.     L2=0
  1804. C L1,L2 = FLAGS VARIABLE 1,2 FOUND VALIDLY
  1805.     LA=LSTC+1
  1806.     LE=100-LA
  1807.     IF(LE.LE.0.OR.IVLD.LE.0)GOTO 8102
  1808.     L1=1
  1809.     IF(CMDLIN(LSTC).NE.':')GOTO 8102
  1810. C MUST SEE : BETWEEN NAMES. NO SPACES PERMITTED.
  1811.     CALL VARSCN(CMDLIN,LA,LE,LSTC,ID1B,ID2B,IVLD)
  1812.     IF(IVLD.LE.0)GOTO 8102
  1813.     L2=1
  1814. 8102    CONTINUE
  1815. C NOTE THAT LSTC RETURNS AS CHARACTER AFTER VARIABLE LAST GRABBED IN INPUT LINE.
  1816.     GOTO IBACK,(8103,8112,8121,8301,8953)
  1817. C NOW PICK UP RN:M OR CN:M (R=ROW,C=COL)
  1818. 8103    CONTINUE
  1819.     IF(L1.LT.1)GOTO 8101
  1820. C INVALID UNLESS AT LEAST 1 VBL NAME SEEN.
  1821.     LA=LSTC+2
  1822.     RCF=0
  1823.     IF(CMDLIN(LSTC+1).EQ.'R')RCF=2
  1824.     IF(CMDLIN(LSTC+1).EQ.'C')RCF=1
  1825.     IF(RCF.EQ.0)GOTO 8101
  1826.     KM1=1
  1827.     CALL GN(KM1,LE,NUM1,CMDLIN(LA))
  1828.     IF(NUM1.EQ.0)GOTO 8101
  1829.     KKK=ICHAR(':')
  1830.     LE=INDX(CMDLIN(LA),KKK)
  1831.     NUM2=0
  1832.     IF(LE.GT.100)GOTO 8101
  1833.     LA=LA+LE
  1834.     KM1=1
  1835.     KM8=8
  1836.     CALL GN(KM1,KM8,NUM2,CMDLIN(LA))
  1837. C NOW NUM1,NUM2 ARE DESIRED ROW/COL RANGE. NOW SET UP DISPLAY.
  1838.     IF(NUM2.EQ.0.OR.NUM2.GT.75)GOTO 8101
  1839.     IF(NUM1.GT.20)GOTO 8101
  1840. C ILLEGAL ROW/COL IS A NO-GO.
  1841. C R N:M MEANS STARTING AT COL N ROW M GOING L TO R.
  1842. C C N:M MEANS DOWN STARTING THERE. DISPLAY COORDS ASSUMED.
  1843.     IF(ID1A.NE.ID1B.AND.ID2A.NE.ID2B)GOTO 8101
  1844. C ONLY HANDLE ROWS OR COLS, NOT DIAGONALS.
  1845. C MUST BE A PHYS MTX ROW OR COL.
  1846.     LRINC=0
  1847.     LCINC=0
  1848.     IF(RCF.EQ.1)LRINC=1
  1849.     IF(RCF.EQ.2)LCINC=1
  1850.     ASSIGN 8108 TO JBACK
  1851.     GOTO 8109
  1852. C COPY DATA
  1853. 8109    CONTINUE
  1854.     ICODE=6
  1855.     IDELT=1
  1856.     IF(L2.NE.0)IDELT=MAX0(IABS(ID1A-ID1B),IABS(ID2A-ID2B))+1
  1857.     I1IN=0
  1858.     I2IN=1
  1859.     IF(ID1A.EQ.ID1B)GOTO 8106
  1860.     I1IN=1
  1861.     I2IN=0
  1862. 8106    CONTINUE
  1863.     ID1=ID1A
  1864.     ID2=ID2A
  1865.     GOTO JBACK,(8108,8113,8122,8307,8954)
  1866. 8108    CONTINUE
  1867.     ICODE=1
  1868.     IR=NUM1
  1869.     IC=NUM2
  1870. C 1 DIM COPY OF DATA, FOR IDELT ELEMENTS.
  1871.     DO 8105 NM=1,IDELT
  1872. C CLAMP TO MAX DISPLAY ARRAY
  1873.     IF(IR.GT.20.OR.IC.GT.75)GOTO 8105
  1874.     NRDSP(IR,IC)=ID1
  1875.     NCDSP(IR,IC)=ID2
  1876.     DVS(IR,IC)=DVS(IR,IC)-1.E-14
  1877. C    THISRW=IR
  1878. C    THISCL=IC
  1879. C    JRX=(ID2-1)*60+ID1
  1880.     CALL REFLEC(ID2,ID1,JRX)
  1881.     CALL WRKFIL(JRX,FORM2,0)
  1882. C    READ(7'JRX)FORM2
  1883. C    DO 7104 N7=1,9
  1884. C7104    DFMTS(N7,IR,IC)=FORM2(N7+119)
  1885. C    DFMTS(10,IR,IC)=0
  1886.     IR=IR+LCINC
  1887.     IC=IC+LRINC
  1888. C NOTE REVERSAL FOR DISPLAY.
  1889.     ID1=ID1+I1IN
  1890.     ID2=ID2+I2IN
  1891. 8105    CONTINUE
  1892. 8101    CONTINUE
  1893.     IF(CMDLIN(2).NE.'F')GOTO 8111
  1894. C DF STUFF - SET FORMAT.
  1895.     ASSIGN 8112 TO IBACK
  1896.     GOTO 8104
  1897. 8112    CONTINUE
  1898. C NOW HAVE VARIABLE ID'S SET UP
  1899.     IF(L1.LE.0)GOTO 8120
  1900. C MUST HAVE 1 OR MORE...
  1901.     ASSIGN 8113 TO JBACK
  1902.     GOTO 8109
  1903. C IDELT NOW SET UP. SET FORMATS UP NOW.
  1904. C FORMATS ARE IN [] BRACKETS. FIND THESE AND USE.
  1905. 8113    CONTINUE
  1906.     ICODE=1
  1907.     KKK=ICHAR('[')
  1908.     LA=INDX(CMDLIN,KKK)+1
  1909.     KKK=ICHAR(']')
  1910.     LB=INDX(CMDLIN,KKK)-1
  1911.     LDELT=LB-LA+1
  1912.     LDELT=MIN0(LDELT,9)
  1913.     DO 8114 LN=1,IDELT
  1914. C IDELT IS OVER VRBL LIST GIVEN. MAY BE 1 ONLY.
  1915. C    IRRX=(ID2-1)*60+ID1
  1916.     CALL REFLEC(ID2,ID1,IRRX)
  1917.     CALL WRKFIL(IRRX,FORM,0)
  1918. C    READ(7'IRRX)FORM
  1919.     IF(CMDLIN(LA).EQ.'*')GOTO 7115
  1920.     IF(CMDLIN(LA).EQ.'A'.OR.CMDLIN(LA).EQ.'L')GOTO 7115
  1921. C KEEP EXISTING FORMAT IF [*] IS USED.
  1922.     DO 7989 KKKK=1,9
  1923. 7989    FORM(119+KKKK)=Char(0)
  1924.     DO 8115 LNA=1,LDELT
  1925.     FORM(LNA+119)=CMDLIN(LA-1+LNA)
  1926.     IF(LNA.LT.9)FORM(LNA+120)=0
  1927. 8115    CONTINUE
  1928. 7115    CONTINUE
  1929. C    FORM(128)=0
  1930.     CALL FVLDGT(ID1,ID2,FVWRK)
  1931.     IVVVV=JCHAR(FVWRK)
  1932.     IF(IVVVV.EQ.0)IVVVV=3
  1933. C SET UP DEFAULT AS NUMERIC.
  1934. C    IVVVV=FVLD(ID1,ID2)
  1935. C    FVLD(ID1,ID2)=MAX0(1,IABS(IVVVV))
  1936.     IVVVV=MAX0(1,IABS(IVVVV))
  1937.     IF(CMDLIN(LA).EQ.'A'.OR.CMDLIN(LA).EQ.'L')IVVVV=
  1938.      1  MIN0(-1,-IABS(IVVVV))
  1939.     CALL FVLDST(ID1,ID2,CHAR(IVVVV))
  1940.     IF(CMDLIN(LA).EQ.'I')CALL TYPSET(ID1,ID2,4)
  1941.     IF(CMDLIN(LA).EQ.'F'.OR.CMDLIN(LA).EQ.'E')
  1942.      1   CALL TYPSET(ID1,ID2,2)
  1943.     FORM(119)=CHAR(IVVVV)
  1944. C
  1945. C TO BE SURE WE DON'T FOUL UP THE FILE, TRY AN ENCODE ON THIS FORMAT
  1946. C PRIOR TO THE WRITE. THAT WAY IF WE BOMB, THE FILE WE HAVE DIRECT ACCESS
  1947. C DATA ON IS NOT CLOBBERED.
  1948.     IF(IVVVV.LE.0)GOTO 7990
  1949.     DO 7988 KKK=1,9
  1950.     KKKK=ICHAR(FORM(119+KKK))
  1951. 7988    DFE(KKK+1)=CHAR(MAX0(32,KKKK))
  1952.     DFE(1)='('
  1953.     DFE(12)=' '
  1954.     DFE(13)=' '
  1955.     DFE(14)=')'
  1956.     CALL TYPGET(N1,N2,TYPE(1,1))
  1957.     CALL FVLDGT(N1,N2,FVLD(1,1))
  1958. d    write(*,1092)dfe
  1959. d1092    format(' DFE (tst.xqtcmd) format=',14a1,';')
  1960.     IF(JCHAR(FVLD(1,1)).LE.0)GOTO 7990
  1961.     IF(TYPE(1,1).NE.2)GOTO 6223
  1962.     WRITE(WRKCHR(1:127),DFE,ERR=4302)DVS(THISRW,THISCL)
  1963. d    write(*,1091)dvs(thisrw,thiscl)
  1964. d1091    format(' xqtcmd value dvs(here)=',d20.10)
  1965.     GOTO 7990
  1966. 6223    CONTINUE
  1967.         WRITE(WRKCHR(1:127),DFE,ERR=4302)LDVS(1,THISRW,THISCL)
  1968. 7990    CONTINUE
  1969.     CALL WRKFIL(IRRX,FORM,1)
  1970.     DO 8116 NX1=1,20
  1971.     DO 8116 NX2=1,75
  1972. C LOCATE DISPLAY CELL IF ANY
  1973.     IF(NRDSP(NX1,NX2).EQ.ID1.AND.NCDSP(NX1,NX2).EQ.ID2)GOTO 8117
  1974. 8116    CONTINUE
  1975.     GOTO 8118
  1976. 8117    CONTINUE
  1977.     DVS(NX1,NX2)=DVS(NX1,NX2)-1.23E-12
  1978. 8118    CONTINUE
  1979.     ID1=ID1+I1IN
  1980.     ID2=ID2+I2IN
  1981. 8114    CONTINUE
  1982. 8111    CONTINUE
  1983.     IF(CMDLIN(2).NE.'T')GOTO 8120
  1984. C DT DISPLAY TYPE
  1985.     ASSIGN 8121 TO IBACK
  1986.     GOTO 8104
  1987. C GET VBL NAMES
  1988. 8121    ASSIGN 8122 TO JBACK
  1989.     GOTO 8109
  1990. 8122    LA=LSTC+1
  1991.     IF(L1.LE.0)GOTO 8120
  1992.     KTYP=2
  1993.     IF(CMDLIN(LA).EQ.'I')KTYP=4
  1994.     ICODE=1
  1995.     DO 8123 LNA=1,IDELT
  1996.     CALL TYPSET(ID1,ID2,KTYP)
  1997. C    TYPE(ID1,ID2)=KTYP
  1998.     DO 8126 NX1=1,DRWV
  1999.     DO 8126 NX2=1,DCLV
  2000.     IF(NRDSP(NX1,NX2).EQ.ID1.AND.NCDSP(NX1,NX2).EQ.ID2)GOTO 8127
  2001. C FIND DISPLAY LOC IF ANY AND SET IT UP FOR REDRAW
  2002. 8126    CONTINUE
  2003.     GOTO 8128
  2004. 8127    CONTINUE
  2005.     DVS(NX1,NX2)=DVS(NX1,NX2)-1.211E-16
  2006. 8128    CONTINUE
  2007.     ID1=ID1+I1IN
  2008.     ID2=ID2+I2IN
  2009. 8123    CONTINUE
  2010. 8120    CONTINUE
  2011.     IF(CMDLIN(2).NE.'W')GOTO 8130
  2012. C DW SETS COL WIDTH
  2013.     ASSIGN 8131 TO KBACK
  2014.     GOTO 8132
  2015. C GET 2 NUMBERS STARTING AT CMDLIN(4)
  2016. 8132    CONTINUE
  2017.     KM1=1
  2018.     KM6=6
  2019.     CALL GN(KM1,KM6,NCL,CMDLIN(4))
  2020.     KKK=ICHAR(',')
  2021.     LA=INDX(CMDLIN(4),KKK)
  2022. C COMMA MUST BE SEPARATOR
  2023.     LCWID=7
  2024.     IF(LA.GT.100)GOTO 8138
  2025.     KM1=1
  2026.     CALL GN(KM1,KM6,LCWID,CMDLIN(LA+4))
  2027. 8138    GOTO KBACK,(8131,8141)
  2028. 8131    CONTINUE
  2029.     ICODE=6
  2030.     NCL=MAX0(1,NCL)
  2031.     NCL=MIN0(NCL,20)
  2032.     LCWID=MAX0(1,LCWID)
  2033.     LCWID=MIN0(LCWID,110)
  2034. C COL WIDTH IS 3 TO 110 CHARS.
  2035.     IF(NCL.GT.0)CWIDS(NCL)=LCWID
  2036. 8133    CONTINUE
  2037. 8130    CONTINUE
  2038.     IF(CMDLIN(2).NE.'B')GOTO 8140
  2039. C DB = BOUNDS ON ROW,COL
  2040.     ASSIGN 8141 TO KBACK
  2041.     GOTO 8132
  2042. C PARASITE OTHER CODE TO GET DIGITS
  2043. 8141    MC=NCL
  2044.     MR=LCWID
  2045.     MC=MIN0(MC,20)
  2046.     MR=MIN0(MR,75)
  2047. C CLAMP RANGE TO LEGAL
  2048.     IF(MC.GT.0)DRWV=MC
  2049.     IF(MR.GT.0)DCLV=MR
  2050.     ICODE=2
  2051. C REDRAW SCREEN WHEN BOUNDS CHANGE.
  2052. 8140    CONTINUE
  2053.     GOTO 9990
  2054. 8002    IF(CMDLIN(1).NE.'V')GOTO 8003
  2055. C VIEW REDRAW COMMAND
  2056.     IF(CMDLIN(2).EQ.'C'.OR.CMDLIN(2).EQ.'B')CALL SWSET(0)
  2057.     IF(CMDLIN(2).EQ.'I')CALL SWSET(1)
  2058.     IF(CMDLIN(2).EQ.'C'.OR.CMDLIN(2).EQ.'B')MODFLG=0
  2059.     IF(CMDLIN(2).EQ.'I')MODFLG=1
  2060. C VI MEANS VIEW IBM MODE, USING BIOS CALLS FOR DIRECT SCREEN OUTPUT.
  2061.     IF(CMDLIN(2).EQ.'C')CALL UVT100(20,0,0)
  2062.     IF(CMDLIN(2).EQ.'B')CALL UVT100(21,0,0)
  2063. C VC SETS VIEW COLOR MODE
  2064. C VB SETS VIEW B+W MODE
  2065. C REQUIRES UVTGEN MODULE...
  2066.     PZAP=0
  2067.     FORMFG=0
  2068.     IF(CMDLIN(2).EQ.'F')FORMFG=1
  2069.     IF(CMDLIN(2).EQ.'M')PZAP=1
  2070.     ICODE=6
  2071.     GOTO 9990
  2072. 8003    IF(CMDLIN(1).NE.'C'.AND.CMDLIN(1).NE.'I')GOTO 8004
  2073. C COPY NUMBERS COMMAND
  2074. C COPY (NUMBERS,FORMAT,DISPLAY,ALL)
  2075. C CV=COPY VALUE, CD=COPY DISPLAY FMT, CF=COPY FORMULA, CA=COPY ALL
  2076. C Ca V1:V2 V3:V4 COPIES FIRST RANGE TO SECOND.
  2077. C IR RANGES DOES INPLACE RELOCATION...
  2078. C
  2079. C COLLECT ARGS
  2080.     ASSIGN 8301 TO IBACK
  2081.     GOTO 8104
  2082. 8301    CONTINUE
  2083. C NOW L1,L2 SAY IF VBLS(ID1A,ID2A) AND (ID1B,ID2B) EXIST
  2084. C COLLECT JD2A,JD2B. USE SIMILAR INTERNAL PROCEDURE CODE.
  2085.     IF(L1.LE.0)GOTO 8399
  2086.     ASSIGN 8302 TO MBACK
  2087.     GOTO 8303
  2088. 8303    CONTINUE
  2089. C COLLECT 2 VARS STARTING AT LSTC+3
  2090. C SKIPS LSTC DELIMITER.
  2091.     LJ1=0
  2092.     LJ2=0
  2093.     LA=LSTC+1
  2094.     LE=110-LA
  2095.     IF(LE.LE.0)GOTO 8304
  2096.     CALL VARSCN(CMDLIN,LA,LE,LSTC,JD1A,JD1B,IVLD)
  2097.     LA=LSTC+1
  2098.     LE=110-LA
  2099.     IF(LE.LE.0.OR.IVLD.LE.0)GOTO 8304
  2100.     LJ1=1
  2101.     IF(CMDLIN(LSTC).NE.':')GOTO 8304
  2102.     CALL VARSCN(CMDLIN,LA,LE,LSTC,JD2A,JD2B,IVLD)
  2103.     IF(IVLD.LE.0)GOTO 8304
  2104.     LJ2=1
  2105. 8304    GOTO MBACK,(8302)
  2106. 8302    CONTINUE
  2107.     IF(LJ1.LE.0)GOTO 8399
  2108.     IDELT=1
  2109.     IF(L2.NE.0.AND.(ID1A.NE.ID1B.AND.ID2A.NE.ID2B))GOTO 8305
  2110.     IF(L2.NE.0)IDELT=MAX0(IABS(ID1A-ID1B),IABS(ID2A-ID2B))+1
  2111. 8305    CONTINUE
  2112.     JDELT=1
  2113.     IF(LJ2.EQ.0)GOTO 8306
  2114.     IF(JD1A.NE.JD2A.AND.JD1B.NE.JD2B)GOTO 8306
  2115.     JDELT=MAX0(IABS(JD1A-JD2A),IABS(JD1B-JD2B))+1
  2116. 8306    IF(L2.NE.0)JDELT=MIN0(IDELT,JDELT)
  2117. C CHANGE FOR REPLICATE :  JDELT CAN BE JUST JDELT IF L2=0
  2118.     ASSIGN 8307 TO JBACK
  2119. C 8109 IS WHERE WE SET UP I1IN AND I2IN ASSUMING THAT THE VARIABLES
  2120. C ARE SET PROPERLY. HANDLED AS AN INTERNAL PROCEDURE.
  2121.     GOTO 8109
  2122. 8307    CONTINUE
  2123.     JIN1=1
  2124.     JIN2=0
  2125.     IF(JD1B.EQ.JD2B)GOTO 8308
  2126.     JIN1=0
  2127.     JIN2=1
  2128. 8308    CONTINUE
  2129. C CHANGE FOR REPLICATE: IF L2 IS 0 (NO 2ND SRC VARIABLE), NO BUMPS
  2130. C PAST THE SINGLE VARIABLE SPECIFIED.
  2131.     IF(L2.EQ.0)I1IN=0
  2132.     IF(L2.EQ.0)I2IN=0
  2133. C FOR PCC-PC DO RECALC ALWAYS TO ALLOW DISPLAY TO LOOK OK
  2134.     ICODE=3
  2135. C    ICODE=1
  2136. C FORCE RECALC IF ONLY 1 SOURCE VARIABLE.
  2137. C    IF(L2.EQ.0)ICODE=3
  2138.     JRTR=PROW
  2139.     JRTC=PCOL
  2140. C JRTR AND JRTC = RELOCATION THRESHOLDS
  2141. C CELLS ABOVE OR LEFT OF JRTR,JRTC WILL NOT BE RELOCATED IN A CR
  2142. C OPERATION. THIS WILL GENERALLY BE THE PHYSICAL COLUMN OR ROW
  2143. C OF THE CURRENT POSITION. CELLS LOWER OR EQUAL, OR TO THE RIGHT
  2144. C OF THE CURRENT LOCATION OR EQUAL, WILL BE RELOCATED. (VARIABLE
  2145. C NAMES GET EDITED)
  2146.     ASSIGN 8365 TO KPYBAK
  2147.     GOTO 8364
  2148. C 8364 BEGINS COPY PROCEDURE SECTION
  2149. C GOES FOR JDELT CELLS WITH I1IN AND I2IN BEING SOURCE INCREMENTS FOR
  2150. C RRW DIMENSION, RCL DIMENSION, AND JIN1,2 BEING INCREMENTS FOR
  2151. C DESTINATION RRW,RCL DIMENSIONS RESPECTIVELY. USES CMDLIN(2) TO
  2152. C FLAG WHETHER TO HANDLE ALL, JUST FORMAT, RELOCATE, ETC.
  2153. C  ALSO ID1A,ID2A ARE START SOURCE LOCATION
  2154. C  JD1A,JD1B = DEST START LOCATION.
  2155. C
  2156. C COPIES 1 ROW OR COLUMN AT A TIME.
  2157. 8364    CONTINUE
  2158. C    ICODE=1
  2159. C SET DISPLAY UPDATE ON COPIED CELLS
  2160. CCD    DO 3620 JV=1,BRRCL
  2161. CCD3620    IBITMP(JV)=0
  2162.     DO 8309 JV=1,JDELT
  2163.     DO 8380 NX1=1,DRWV
  2164.     DO 8380 NX2=1,DCLV
  2165. C LOCATE DISPLAY CELL IF ANY
  2166.     IF(NRDSP(NX1,NX2).EQ.ID1.AND.NCDSP(NX1,NX2).EQ.ID2)GOTO 8387
  2167. 8380    CONTINUE
  2168.     GOTO 8388
  2169. 8387    CONTINUE
  2170.     DVS(NX1,NX2)=DVS(NX1,NX2)+1.245E-14
  2171. 8388    CONTINUE
  2172. C    JRXX=(JD1B-1)*60+JD1A
  2173. C    IRXX=(ID2A-1)*60+ID1A
  2174.     CALL REFLEC(JD1B,JD1A,JRXX)
  2175.     CALL REFLEC(ID2A,ID1A,IRXX)
  2176.     CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
  2177.     KKKKK=JCHAR(FVLD(1,1))
  2178.     CALL FVLDGT(JD1A,JD1B,FVLD(1,1))
  2179.     IF(KKKKK.EQ.0.AND.ICHAR(FVLD(1,1)).EQ.0)GOTO 8314
  2180. C    IF(FVLD(ID1A,ID2A).EQ.0.AND.FVLD(JD1A,JD1B).EQ.0)GOTO 8314
  2181.     CALL WRKFIL(IRXX,FORM,0)
  2182.     CALL WRKFIL(JRXX,FORM2,0)
  2183.     IF(KKKKK.EQ.-2)CALL FVLDST(ID1A,ID2A,CHAR(253))
  2184.     IF(KKKKK.EQ.2)CALL FVLDST(ID1A,ID2A,CHAR(3))
  2185.     IF(jchar(FORM (119)).EQ. 2)FORM (119)=Char(3)
  2186.     IF(jchar(FORM (119)).EQ.-2)FORM (119)=Char(253)
  2187.     IF(jchar(FORM2(119)).EQ. 2)FORM2(119)=Char(3)
  2188.     IF(jchar(FORM2(119)).EQ.-2)FORM2(119)=Char(253)
  2189.     IF(CMDLIN(2).NE.'R'.AND.CMDLIN(2).NE.'A')GOTO 8310
  2190.     IF(CMDLIN(2).NE.'R')GOTO 8366
  2191. C RELOCATE, THEN WRITE NEW CELL
  2192.     II1=ID1A
  2193.     II2=ID2A
  2194.     JJ1=JD1A
  2195.     JJ2=JD1B
  2196.     CALL RELVBL(FORM,FORM2,II1,II2,JJ1,JJ2,JRTR,JRTC)
  2197. C THE ABOVE WILL RELOCATE FORM INTO FORM2 WHICH WE NOW EMIT.
  2198. C ALLOW IR COMMAND TO DO INPLACE RELOCATION.
  2199.     IF(CMDLIN(1).NE.'I')GOTO 6224
  2200.     CALL WRKFIL(IRXX,FORM2,1)
  2201.     GOTO 9222
  2202. 6224    CONTINUE
  2203.     CALL WRKFIL(JRXX,FORM2,1)
  2204.     GOTO 8367
  2205. 8366    CONTINUE
  2206.     CALL WRKFIL(JRXX,FORM,1)
  2207. C    WRITE(7'JRXX)FORM
  2208. 8367    CONTINUE
  2209.     CALL TYPGET(ID1A,ID2A,TYPE(1,1))
  2210.     CALL TYPSET(JD1A,JD1B,TYPE(1,1))
  2211. C    TYPE(JD1A,JD1B)=TYPE(ID1A,ID2A)
  2212.     CALL XVBLGT(ID1A,ID2A,XVBLS(1,1))
  2213.     CALL XVBLST(JD1A,JD1B,XVBLS(1,1))
  2214. C    XVBLS(JD1A,JD1B)=XVBLS(ID1A,ID2A)
  2215.     CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
  2216.     CALL FVLDST(JD1A,JD1B,FVLD(1,1))
  2217. C    FVLD(JD1A,JD1B)=FVLD(ID1A,ID2A)
  2218. 9222    ID1A=ID1A+I1IN
  2219.     ID2A=ID2A+I2IN
  2220.     JD1A=JD1A+JIN1
  2221.     JD1B=JD1B+JIN2
  2222.     GOTO 8309
  2223. 8310    CONTINUE
  2224.     IF(CMDLIN(2).NE.'V')GOTO 8312
  2225.     CALL TYPGET(ID1A,ID2A,TYPE(1,1))
  2226.     CALL TYPSET(JD1A,JD1B,TYPE(1,1))
  2227. C    TYPE(JD1A,JD1B)=TYPE(ID1A,ID2A)
  2228.     CALL XVBLGT(ID1A,ID2A,XVBLS(1,1))
  2229.     CALL XVBLST(JD1A,JD1B,XVBLS(1,1))
  2230. C    XVBLS(JD1A,JD1B)=XVBLS(ID1A,ID2A)
  2231. 8312    IF(CMDLIN(2).NE.'D')GOTO 8313
  2232.     CALL FVLDGT(ID1A,ID2A,FVLD(1,1))
  2233.     CALL FVLDST(JD1A,JD1B,FVLD(1,1))
  2234. C    FVLD(JD1A,JD1B)=FVLD(ID1A,ID2A)
  2235.     DO 8315 LXQ=1,10
  2236. 8315    FORM2(118+LXQ)=FORM(118+LXQ)
  2237.     CALL WRKFIL(JRXX,FORM2,1)
  2238. C    WRITE(7'JRXX)FORM2
  2239. 8313    IF(CMDLIN(2).NE.'F')GOTO 8314
  2240.     DO 8316 LXQ=1,110
  2241. 8316    FORM2(LXQ)=FORM(LXQ)
  2242.     CALL WRKFIL(JRXX,FORM2,1)
  2243. 8314    CONTINUE
  2244.     ID1A=ID1A+I1IN
  2245.     ID2A=ID2A+I2IN
  2246.     JD1A=JD1A+JIN1
  2247.     JD1B=JD1B+JIN2
  2248. 8309    CONTINUE
  2249. C RETURN POINT FROM COPY LOOP IN NORMAL COPY
  2250.     GOTO KPYBAK,(8840,8836,8365)
  2251. 8365    CONTINUE
  2252. 8399    GOTO 9990
  2253. 8004    IF(CMDLIN(1).LT.'1'.OR.CMDLIN(1).GT.'4')GOTO 8005
  2254. C 1,2,3,4 POSITIONING COMMANDS
  2255. C USE LLT AND LGT LEXICAL ORDERING TESTS, NOT ARITHMETIC ONES...
  2256.     ICODE=5
  2257. C    IF(CMDLIN(1).EQ.'3')THISRW=MAX0(1,(THISRW-1))
  2258. C    IF(CMDLIN(1).EQ.'4')THISRW=MIN0((THISRW+1),DRWV)
  2259. C    IF(CMDLIN(1).EQ.'1')THISCL=MAX0(1,(THISCL-1))
  2260. C    IF(CMDLIN(1).EQ.'2')THISCL=MIN0((THISCL+1),DCLV)
  2261. C COULD ADD SCROLLING HERE IF DESIRED.
  2262. C    ASCII 1,2,3,4 ARE VALUES 49,50,51,52 IN DECIMAL.
  2263.     MVFG=ICHAR(CMDLIN(1))
  2264.     LRO=1
  2265.     LCO=1
  2266.     ID1=NRDSP(1,1)
  2267.     ID2=NCDSP(1,1)
  2268.     IF(.NOT.(MVFG.EQ.51.AND.THISRW.EQ.1))GOTO 2110
  2269. C MUST SCROLL LEFT
  2270.     IF(IDOL7.EQ.0)GOTO 2110
  2271.     IF(ID1.LE.1)GOTO 2110
  2272.     ID1=MAX0(1,ID1-DRWV+2)
  2273.     DROW=MAX0(1,DRWV-2)
  2274.     IQQ=1
  2275.     GOTO 7112
  2276. 2110    IF(MVFG.EQ.51)THISRW=MAX0(1,(THISRW-1))
  2277.     IF(.NOT.(MVFG.EQ.52.AND.THISRW.EQ.DRWV))GOTO 2116
  2278. C MUST SCROLL RIGHT
  2279.     IF(IDOL7.EQ.0)GOTO 2116
  2280.     DROW=3
  2281. C    ID1=MIN0(60,ID1+DRWV-MIN0(DRWV,2))
  2282.     ID1=ID1+DRWV-MIN0(DRWV,2)
  2283.     IQQ=1
  2284.     GOTO 7112
  2285. C 7112 FAKES OUT OA CALL TO SCROLL OVER.
  2286. 2116    IF(MVFG.EQ.52)THISRW=MIN0((THISRW+1),DRWV)
  2287.     IF(.NOT.(MVFG.EQ.49.AND.THISCL.EQ.1))GOTO 2117
  2288. C MUST SCROLL UP
  2289.     IF(IDOL7.EQ.0)GOTO 2117
  2290.     IF(ID2.LE.2)GOTO 2117
  2291.     DCOL=MAX0(1,DCLV-2)
  2292.     ID2=MAX0(2,ID2-DCLV+2)
  2293.     IQQ=1
  2294.     GOTO 7112
  2295. 2117    IF(MVFG.EQ.49)THISCL=MAX0(1,(THISCL-1))
  2296.     IF(.NOT.(MVFG.EQ.50.AND.THISCL.EQ.DCLV))GOTO 2118
  2297. C MUST SCROLL DOWN
  2298.     IF(IDOL7.EQ.0)GOTO 2118
  2299.     DCOL=3
  2300. C    ID2=MIN0(301,ID2+DCLV-MIN0(DCLV,2))
  2301.     ID2=ID2+DCLV-MIN0(DCLV,2)
  2302.     IQQ=1
  2303.     GOTO 7112
  2304. 2118    IF(MVFG.EQ.50)THISCL=MIN0((THISCL+1),DCLV)
  2305.     PROW=NRDSP(THISRW,THISCL)
  2306.     PCOL=NCDSP(THISRW,THISCL)
  2307.     DROW=THISRW
  2308.     DCOL=THISCL
  2309.     GOTO 9990
  2310. 8005    CONTINUE
  2311. 8007    IF(CMDLIN(1).NE.'R')GOTO 8008
  2312.     IF(CMDLIN(2).NE.'B')GOTO 7333
  2313. C RB VAR SETS RELOCATE BOUNDARY TO VAR COORDS
  2314.     IF(CMDLIN(3).EQ.'*')GOTO 7332
  2315. C NORMAL RB COMMAND
  2316. C RB VAR USES VAR NAME TO RESET BDY
  2317.     LO=3
  2318.     KKKK=20
  2319.     CALL VARSCN(CMDLIN,LO,KKKK,IV,ID1,ID2,IVALID)
  2320.     IF(IVALID.LE.0)GOTO 9990
  2321. C IGNORE ERRORS
  2322.     IDOL5=ID1
  2323.     IDOL6=ID2
  2324.     GOTO 9990
  2325. 7332    IDOL5=20000
  2326.     IDOL6=20000
  2327. C RB* RESETS RELOCATE BDY TO END OF SHEET
  2328.     GOTO 9990
  2329. 7333    CONTINUE
  2330. C RECOMPUTE SHEET.
  2331. C RM COMMAND SETS MANUAL FLAG.
  2332.     RCFGX=0
  2333.  
  2334.     RCONE=0
  2335.     IF(CMDLIN(2).NE.'S')GOTO 5114
  2336.     RRWACT=60
  2337.     RCLACT=301
  2338. 5114    CONTINUE
  2339. C RCFGX NONZERO INHIBITS RECALCULATION.
  2340. C RCONE SET 1 TO FORCE RECALC OF ALL.
  2341. C CHANGE FROM OTHER SYNTAX: RF FORCES RECALC, R DOES NOT.
  2342.     IF(CMDLIN(2).EQ.'F'.OR.CMDLIN(2).EQ.'R')RCONE=1
  2343. C NOTE RXF (X=ANY CHAR BUT F) ACTS LIKE OLD VERSION RXF.
  2344. C BARE R COMMAND HOWEVER JUST REDOES CALC. F NOW MEANS "FORCE"
  2345. C AND SEEMS A BIT MORE MNEMONIC THIS WAY. ALLOW RR COMMAND
  2346. C TO WORK AS WELL AS RF.
  2347.     IF(CMDLIN(2).NE.'R')RCMODE=0
  2348.     IF(CMDLIN(2).EQ.'E')RCMODE=1
  2349.     IF(CMDLIN(2).EQ.'I')RCMODE=2
  2350. C RE, RI MODE CONTROLS... ALSO RR ACTS LIKE RF BUT STAYS IN
  2351. C RE OR RI MODE... RECALC ENTRY OR INCREMENTAL...
  2352.     IF(CMDLIN(2).EQ.'M')RCFGX=1
  2353.     ICODE=3
  2354. C 3rd char I Inhibits recalc this time but sets modes...
  2355.     IF(CMDLIN(3).EQ.'I')ICODE=1
  2356.     GOTO 9990
  2357. 8008    IF(CMDLIN(1).NE.'K')GOTO 8009
  2358. C DROP INTO CALC BARE.
  2359.     IF(IPSET.NE.0)GOTO 9990
  2360. C CAN'T CALL CALC RECURSIVELY
  2361.     OSWIT=0
  2362.     ILNFG=0
  2363. C    ICODE=-1
  2364. C CLOSE UNIT 1 JUST IN CASE...
  2365.     CLOSE(1)
  2366.     CALL UVT100(11,2,0)
  2367. C ERASE DSPLY
  2368.     KLVL=1
  2369.     ILNCT=0
  2370. C ICODE SET TO 420 SPECIAL CODE TO TELL MAIN PGM TO CALL INTERACTIVE
  2371. C CALCULATOR FCN.
  2372.     ICODE=420
  2373.     GOTO 9990
  2374. 8009    IF(CMDLIN(1).NE.'L')GOTO 8010
  2375. C LOCATE CURSOR ORIGIN
  2376. C FORMAT IS L VARIABLE
  2377. C ONLY 1 VARIABLE NAME TO BE ENTERED.
  2378.     LA=2
  2379.     LE=30
  2380.     CALL VARSCN(CMDLIN,LA,LE,LSTC,ID1A,ID2A,IVLD)
  2381.     L1=IVLD
  2382. C    ASSIGN 8900 TO IBACK
  2383. C    GOTO 8104
  2384. 8900    IF(L1.LT.1)GOTO 9990
  2385. 3800    PROW=ID1A
  2386.     PCOL=ID2A
  2387. C LOOK UP DISPLAY COORDS IF ANY
  2388.     ASSIGN 8901 TO NBK
  2389.     GOTO 7905
  2390. 8901    CONTINUE
  2391.     DROW=LR
  2392.     DCOL=LC
  2393.     THISRW=LR
  2394.     THISCL=LC
  2395. 3801    ICODE=1
  2396.     GOTO 9990
  2397. 8010    CONTINUE
  2398.     IF(CMDLIN(1).NE.'>')GOTO 3802
  2399. C >STRING SEARCHES FORMULAE FOR STRING
  2400.     LA=MIN0(IDOL5,RRWACT)
  2401.     LB=MIN0(IDOL6,RCLACT)
  2402. C NO ACTION UNLESS VALID SEARCH REGION (CURRENT TO RELOC BDY)
  2403. C EXISTS.
  2404.     IF(LA.LT.PROW.OR.LB.LT.PCOL)GOTO 3801
  2405.     DO 3803 ID1=PROW,LA
  2406.     DO 3803 ID2=PCOL,LB
  2407.     ID1A=ID1
  2408.     ID2A=ID2
  2409.     CALL FVLDGT(ID1,ID2,FVLD(1,1))
  2410.     IF(JCHAR(FVLD(1,1)).EQ.0)GOTO 3803
  2411. C HAVE VALID CELL HERE, SO GRAB ITS FORMULA AND COMPARE FOR THE ONE
  2412. C WE'RE LOOKING FOR. IF CMD LINE STARTS WITH >> ANCHOR THE SEARCH AT 1ST
  2413. C COL.
  2414.     LMX=50
  2415.     LMN=2
  2416.     IF(CMDLIN(2).NE.'>')GOTO 3805
  2417.     LMX=1
  2418.     LMN=3
  2419. 3805    CONTINUE
  2420. C    IRX=(ID2-1)*60+ID1
  2421.     CALL REFLEC(ID2,ID1,IRX)
  2422.     CALL WRKFIL(IRX,FORM,0)
  2423.     CALL CE2A(FORM,FORM2)
  2424.     DO 3804 IV=1,LMX
  2425.     KKKK=109-IV
  2426. C COMPARE FORMULA TEXT. USE EXISTING SCMP ROUTINE.
  2427.     CALL SCMP(CMDLIN(LMN),FORM2(IV),KKKK,KKK)
  2428.     IF(KKK.EQ.1.AND.JCHAR(FORM2(IV)).GT.0)GOTO 3800
  2429.     IF(JCHAR(FORM2(IV)).LE.0)GOTO 3803
  2430. 3804    CONTINUE
  2431. 3803    CONTINUE
  2432. C IF WE FALL THROUGH, WE FAILED TO FIND FORMULA SO FORGET IT.
  2433.     GOTO 3801
  2434. 3802    CONTINUE
  2435.     IF(CMDLIN(1).NE.'Z')GOTO 8011
  2436. C ZERO COMMAND
  2437. C ZA OR ZE V1:V2
  2438.     IF(CMDLIN(2).NE.'A')GOTO 8950
  2439. C ZA = ZERO ALL. BE SURE HE MEANS IT.
  2440.     CALL UVT100(1,LLDSP,1)
  2441. c    WRITE(0,8951)
  2442. c8951    FORMAT('Really Zero All of sheet [Y/N]?\')
  2443.     call Vwrt('Really Zero ALL of sheet [Y/N]?',31)
  2444.     III=IOLVL
  2445. C    IF(III.EQ.5)III=0
  2446.     READ(III,8952,END=510,ERR=510)(FORM2(KKI),KKI=1,4)
  2447. 8952    FORMAT(4A1)
  2448.     ICODE=6
  2449.     IF(FORM2(1).NE.'Y'.AND.FORM2(1).NE.'y')GOTO 9990
  2450.     CALL UVT100(11,2,0)
  2451.     ICODE=-4
  2452.     GOTO 9990
  2453. 8950    IF(CMDLIN(2).NE.'E')GOTO 9990
  2454.     ASSIGN 8953 TO IBACK
  2455.     GOTO 8104
  2456. C GET NAMES
  2457. 8953    IF(L1.LE.0)GOTO 9990
  2458.     ASSIGN 8954 TO JBACK
  2459.     GOTO 8109
  2460. 8954    CONTINUE
  2461.     DO 8955 NI=1,128
  2462. 8955    FORM2(NI)=0
  2463.     FORM2(118)=Char(15)
  2464.     DO 8823 NI=1,9
  2465. 8823    FORM2(119+NI)=DEFVB(1+NI)
  2466.     DO 8956 NI=1,IDELT
  2467. C    IRX=(ID2-1)*60+ID1
  2468.     CALL REFLEC(ID2,ID1,IRX)
  2469.     CALL WRKFIL(IRX,FORM2,1)
  2470.     CALL FVLDST(ID1,ID2,CHAR(0))
  2471.     CALL XVBLST(ID1,ID2,0.0D0)
  2472.     IPRS=PROW
  2473.     IPCS=PCOL
  2474.     PROW=ID1
  2475.     PCOL=ID2
  2476.     ASSIGN 8957 TO NBK
  2477. C FIND DISPLAY LOC IF ANY
  2478.     GOTO 7905
  2479. 8957    PROW=IPRS
  2480.     PCOL=IPCS
  2481.     IF(LR.EQ.0.OR.LC.EQ.0)GOTO 8958
  2482.     DVS(LR,LC)=DVS(LR,LC)+1.E-11
  2483. 8958    CONTINUE
  2484.     ID1=ID1+I1IN
  2485.     ID2=ID2+I2IN
  2486. 8956    CONTINUE
  2487.     GOTO 9990
  2488. 8011    IF(CMDLIN(1).NE.'X')GOTO 8012
  2489. C EXIT TO OS
  2490. C SINCE THERE'S NO WORKFILE HERE, MAKE SURE HE MEANS IT...
  2491.     IF(IPSET.NE.0)GOTO 9990
  2492.     ICODE=2
  2493.     CALL UVT100(1,LLDSP,1)
  2494.         call 
  2495.      1 swrt('Exit now may lose data unless sheet has been saved'
  2496.      2 ,50)
  2497.     CALL UVT100(1,LLCMD,1)
  2498.     call Vwrt('Confirm Exit Request [Y/N]:',27)
  2499.     III=IOLVL
  2500. C    IF(IOLVL.EQ.5)III=0
  2501.     READ(III,8952,END=510,ERR=510)(FORM2(KKI),KKI=1,4)
  2502.     IF(FORM2(1).NE.'Y'.AND.FORM2(1).NE.'y')GOTO 9990
  2503. C END CALL TO GET OUT OF HERE
  2504.     Close(unit=11)
  2505.     Close(unit=3)
  2506.     Call TTYDEI
  2507.         STOP
  2508. C    CALL EXIT
  2509. 8012    IF(CMDLIN(1).NE.'S')GOTO 8013
  2510. C SAVE SHEET TO DISK (NEW SET OF DATA)
  2511. C NOW JUST PERMITS RESTART...
  2512.     ICODE=-2
  2513.     ISTAT=-2
  2514.     CALL UVT100(11,2,0)
  2515.     GOTO 9990
  2516. 8013    IF(CMDLIN(1).NE.'P')GOTO 8014
  2517.     IRTN=0
  2518.     CALL PGET(CMDLIN,ICODE,IRTN)
  2519.     IF(IRTN.EQ.1)GOTO 510
  2520.     GOTO 9990
  2521. 8014    CONTINUE
  2522. 8015    IF(CMDLIN(1).NE.'G')GOTO 8016
  2523. C GET INPUT NUMBERS OFF SEQUENTIAL FILE. USE CURRENT ORIGIN
  2524.     ICODE=2
  2525.     IRTN=0
  2526.     CALL PGGET(CMDLIN,ICODE,IRTN)
  2527.     IF(IRTN.EQ.1)GOTO 510
  2528. C FLAG WE NEED AT LEAST ONE FULL CALC BEFORE GOING TO PARTIALS...
  2529. C (OK TOO IF IN OLD RCMODE=0 MODE)
  2530.     RCMODE=-IABS(RCMODE)
  2531.     GOTO 9990
  2532. 8016    IF(CMDLIN(1).NE.'W')GOTO 8017
  2533. C WRITE (PRINT) SCREEN OUT TO FILE (MAY BE PRINTER)
  2534. C    CALL DSPSHT(10)
  2535. C    ICODE=1
  2536.     ICODE=400
  2537. C CODE 10 IS PRINT SECRET CODE TO DSPSHT.
  2538.     GOTO 9990
  2539. 8017    CONTINUE
  2540.     IF(CMDLIN(1).NE.'H')GOTO 5019
  2541.     IF(IPSET.NE.0)GOTO 9990
  2542.     IVVV=0
  2543.     IVVVV=ICHAR(CMDLIN(2))
  2544.     ivvx=ICHAR(cmdlin(3))
  2545. 9308    CONTINUE
  2546.     IF(IVVVV.GE.48.AND.IVVVV.LE.57)IVVV=IVVVV-48
  2547.     if(ivvx.lt.48.or.ivvx.gt.57)goto 9381
  2548. c implement 2 digit help code.
  2549.     ivvvx=ivvx-48
  2550.     ivvv=(ivvv*10)+ivvvx
  2551.     ivvv=min0(ivvv,99)
  2552. 9381    continue
  2553. C SELECT HELP LEVEL 0-9 IF SPECIFIED.
  2554.     ICODE=30+IVVV
  2555.     GOTO 9990
  2556. 5019    CONTINUE
  2557. C *** ALLOW EVALUATION OF A CELL TO PERMIT INTERACTIVE COMMAND FILES TO
  2558. C *** BE CONTROLLED RATIONALLY. KEYWORD IS "TEST"
  2559.     IF(CMDLIN(1).NE.'T'.OR.CMDLIN(2).NE.'E')GOTO 4302
  2560. C TEST EXPRESSION IS SYNTAX.
  2561. C COPY CMDLIN INTO XTNCMD AND FLAG VIA ICODE=430
  2562.     XTNCNT=0
  2563.     ICODE=430
  2564.     DO 4307 N=1,80
  2565. 4307    XTNCMD(N)=0
  2566. C FIRST ZERO OUT EXTERNAL CMD LINE, THEN FILL IN WHAT'S NEEDED.
  2567.     DO 4303 N=1,79
  2568.     XTNCMD(N)=CMDLIN(3+N)
  2569. C ALLOW "TE <ANY EXPRESSION>" WITH OPTIONAL SPACE. JUST RETURNS VALUE IN
  2570. C % VARIABLE.
  2571.     IF(ICHAR(XTNCMD(N)).LT.32)GOTO 4304
  2572.     XTNCNT=N
  2573. 4303    CONTINUE
  2574. 4304    CONTINUE
  2575.     XTNCMD(XTNCNT+1)=Char(0)
  2576.     GOTO 9990
  2577. 4302    CONTINUE
  2578. C LET DOUBLE DOT (..) INDICATE TO GO BACK TO CONSOLE, CLOSING INPUT FILE
  2579.     IF (CMDLIN(1).EQ.'.'.AND.CMDLIN(2).EQ.'.')GOTO 510
  2580. C ELSE PRINT MESSAGE THAT WE DON'T UNDERSTAND THAT ONE & GO ON
  2581. C PRINT INVALID CMD MSG IF NOT JUST A SPACE OR C.R.
  2582.     IF(ICHAR(CMDLIN(1)).GT.32)CALL SWRT('Invalid Command.',16)
  2583.     GOTO 200
  2584. C ERROR ON READIN ADDRESS. REWIND TERMINAL IF USER
  2585. C TYPES CTRL Z (EOF), ELSE LEAVE INDIRECT FILES.
  2586. 510    CONTINUE
  2587. C    IF(IOLVL.EQ.5)REWIND 5
  2588.     CLOSE(3)
  2589. c    CLOSE(11)
  2590.     Rewind 11
  2591. c    OPEN(11,FILE='CON:0/0/100/100/Analy Command')
  2592.     IOLVL=11
  2593.     GOTO 498
  2594. 9990    CONTINUE
  2595. C HERE CLEAN UP AND RETURN
  2596. C FIRST DISPLAY LAST CURRENT COL IN NORMAL VIDEO
  2597.     IF(IXLSTR.LE.0.OR.IXLSTC.LE.0)GOTO 2000
  2598.     N1=NRDSP(IXLSTR,IXLSTC)
  2599.     N2=NCDSP(IXLSTR,IXLSTC)
  2600. C    IRRX=(N2-1)*60+N1
  2601.     CALL REFLEC(N2,N1,IRRX)
  2602. C REWRITE LAST LOCATION WITH NO REVERSE VIDEO.
  2603. C    IF(FVLD(N1,N2).EQ.0)GOTO 2000
  2604.     IF(IXLSTC.GT.DCLV.OR.IXLSTR.GT.DRWV)GOTO 2000
  2605. C ONLY REDRAW NUMBERS. DIRECT DISPLAY OR NOTHING GETS IGNORED.
  2606.     IF(ICODE.LT.0.OR.ICODE.EQ.2)GOTO 2000
  2607. C NO SENSE REDRAWING IF WE'RE ABOUT TO ERASE DISPLAY ANYWAY.
  2608.     IF(ICODE.GT.30)GOTO 2000
  2609.     J=8
  2610. C ADD 6 COLS FOR LABELS
  2611. C DROW,DCOL IS CURRENT DISPLAY LOC.
  2612.     DO 3301 M1=1,IXLSTR
  2613. C FIND DISPLAY COLUMN TO USE
  2614. 3301    J=J+CWIDS(M1)
  2615.     J=J-CWIDS(IXLSTR)
  2616. C USE THISCL+1 TO LET 1ST ROW BE LABELS.
  2617.     ICCC=IXLSTC+2
  2618. C JVTINC = 1 IF VT100, 0 IF VT52
  2619. C JVTINC NEEDED SINCE UVT100 FOR VT100 DOES BACKSPACE AT THE SGR ENTRY
  2620. C AND THUS WE NEED TO CORRECT FOR IT. THIS WAS FIXED IN THE UVT52
  2621. C VERSION AND ITS DESCENDANTS.
  2622.     IC1POS=N1
  2623.     IC2POS=N2
  2624.     IF(PZAP.NE.0)GOTO 2000
  2625.     CALL UVT100(1,ICCC,J)
  2626. C SELECT ROW "IXLSTC", COL "J"
  2627.     CALL UVT100(13,0,0)
  2628. C DESELECT REVERSE VIDEO
  2629.     CALL FVLDGT(N1,N2,FVLDTP)
  2630.     ivv=min0(30,cwids(IXLSTR))
  2631.     IF(ICHAR(FVLDTP).EQ.0)CALL SWRT(BLANKS,IVV)
  2632.     IF(ICHAR(FVLDTP).EQ.0)GOTO 2000
  2633.     CALL WRKFIL(IRRX,FORM2,0)
  2634.     CALL CE2A(FORM2,FORM)
  2635. C    READ(7'IRRX)FORM
  2636.     DO 5546 KKKK=1,100
  2637.     IV=ICHAR(FORM(KKKK))
  2638.     IV=MAX0(IV,32)
  2639. 5546    FORM(KKKK)=Char(IV)
  2640.     IF(JCHAR(FVLDTP).LT.0.OR.FORMFG.NE.0)
  2641.      1  WRITE(CMDLNA(1:127),8201)(FORM(II),II=1,100)
  2642. C FILL IN TEXT FOR FORMULA IF FVLD < 0 HERE; BELOW, FILL IN VALUE TEXT IF FVLD
  2643. C > 0.
  2644.     IF(FORMFG.NE.0)GOTO 4324
  2645. C ALWAYS DO FORMULAS IF FORMFG SET (VF MODE).
  2646.     DO 6302 KKK=1,9
  2647.     KKKK=ICHAR(FORM(KKK+119))
  2648. C    KKKK=DFMTS(KKK,IXLSTR,IXLSTC)
  2649. 6302    DFE(KKK+1)=CHAR(MAX0(32,KKKK))
  2650.     DFE(11)=char(32)
  2651. C 32 = ASCII SPACE
  2652.     DFE(1)='('
  2653. C REMEMBER: NO \ EDITING IN INTERNAL WRITES!
  2654.     DFE(12)=' '
  2655.     DFE(13)=' '
  2656.     DFE(14)=')'
  2657.     CALL TYPGET(N1,N2,TYPE(1,1))
  2658.     IF(JCHAR(FVLDTP).LE.0)GOTO 4324
  2659.     IF(TYPE(1,1).NE.2)GOTO 6226
  2660.         WRITE(CMDLNA(1:127),DFE,ERR=4324)DVS(IXLSTR,IXLSTC)
  2661.     GOTO 4324
  2662. 6226    CONTINUE
  2663.     WRITE(CMDLNA(1:127),DFE,ERR=4324)LDVS(1,IXLSTR,IXLSTC)
  2664. C REDRAW THIS COL. WITHOUT REVERSE VIDEO HERE.
  2665. 4324    CALL SWRT(CMDLIN,CWIDS(IXLSTR))
  2666. C NOTE THIS REDRAWS PREVIOUS COL. IN NORMAL VIDEO.
  2667. C NO CARRIAGE CTL
  2668. 2000    CONTINUE
  2669. C NOW COMPLETE ANY CLEANUP.
  2670. C SET CMDLIN TO 0 AT START TO INHIBIT ANY MISINTERPRETATION.
  2671. C WE USE CMDLIN AS A BUFFER IN REDRAWIND DSPLY SO DON'T LET IT GET
  2672. C CLOBBERED.
  2673.     DO 945 K=1,132
  2674. 945    CMDLIN(K)=Char(0)
  2675.     RETURN
  2676.     END
  2677.