C DATATRIEVE INTERFACE FUNCTIONS
c optional for VAX VMS AnalytiCalc
C Include by linking with DTRIF.FVX
C Exclude by linking with DTRIF.FVD
C
C THIS IS THE NON-DTR VERSION with dummy entry points for
C the DTR functions BUT supplying the new non-DTR functions
c completely.
C
c
c Attempt to provide a reasonable interface to DTR by
c allowing passing of commands to DTR both interactively and
c from within a cell, and retrieving numbers and text into
c cells. Also permit sending replies to DTR (for replies in
c procedures) from text in cells or numbers (values) in cells
c so that interaction is two-way.
c
C GLENN EVERHART 1985
	SUBROUTINE DTRINI
C INITIALIZE DATATRIEVE
C CALLED AT START OF PROGRAM, ONCE-FOR-ALL.
C ***
C ***
C ********>>>>>>>><<<<<<<<********
c no DTR; therefore, no init.
	RETURN
	END
	SUBROUTINE DTRFIN
C INITIALIZE DATATRIEVE
C CALLED AT END OF PROGRAM, ONCE-FOR-ALL.
C ********>>>>>>>><<<<<<<<********
	RETURN
	END
	SUBROUTINE DTRCMD(LINE)
	LOGICAL*1 LINE(80)
	CHARACTER*62 LINEC
C	EQUIVALENCE(LINEC,LINE(1))
	INCLUDE 'VKLUGPRM.FTN'
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	INTEGER RETCD
C
C
C DEFINE FILE AREAS FOR MAPPING FILES...
C ONE INPUT FILE, TO BE ACCESSED AS A RANDOM ACCESS FILE OF 128 BYTE
C RECORDS OF DATA IF RANDOM, OR AS A FORMULA FILE IF SEQUENTIAL, AND
C ONE OUTPUT FILE TO BE WRITTEN THE SAME WAY. INPUT FILE CAN BE
C INPUT - ONLY OR READ/WRITE.
C
C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL)
C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED.
C
C MFIOPN =	0	IF NOT OPEN
C		1	IF OPEN FOR READ ONLY, SEQUENTIAL
C		2	IF OPEN READ ONLY, RANDOM
C		3	IF OPEN READ/WRITE, RANDOM.
C
C MFOOPN =	0	IF NOT OPEN
C		1	IF OPEN WRITE SEQUENTIAL
C		2	IF OPEN WRITE RANDOM
C
C OTHER OPTIONS DON'T MAKE SENSE.
C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS
C MFILUN,MFOLUN ARE LOGICAL UNITS.
	INTEGER*2 MFIOPN,MFIRL,MFIRH,MFICL,MFICH
	INTEGER*2 MFOOPN,MFORL,MFORH,MFOCL,MFOCH
	INTEGER*2 MFILUN,MFOLUN,MFIFLG,MFOFLG
	COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH,
     1  MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG
C
C
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	REAL*8 TAC,UAC,VAC,WAC,YAC
	REAL*8 TMP
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(WAC,AVBLS(1,23)),(YAC,AVBLS(1,25))
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	INTEGER*2 XTNCNT,XTCFG,IPSET
	LOGICAL*1 XTNCMD(80)
	INTEGER*2 FORMFG,RCFGX,PZAP,RCONE
	INTEGER*2 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	INTEGER*2 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
	INTEGER KALKIT
	COMMON/VARYIT/KALKIT
C ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	INTEGER*2 DTRENA
	COMMON/DTRCMN/DTRENA
	LOGICAL *1 LINECL(82)
C	CHARACTER*70 LINEC
	EQUIVALENCE(LINEC,LINECL(1))
	CHARACTER*80 SCRBUF
	LOGICAL*1 LBUF(128)
	LOGICAL*1 MBUF(128)
	CHARACTER*110 CLBUF,CMBUF
	EQUIVALENCE(CLBUF,LBUF(1)),(CMBUF,MBUF(1))
C USE CLBUF, CMBUF FOR CHARACTER COMPARISONS...
	CHARACTER*9 FMTB
	EQUIVALENCE (FMTB,LBUF(120))
	CHARACTER*11 FMTBF
	LOGICAL*1 IFVLD
C ********>>>>>>>><<<<<<<<********
C NULL OUT ANY TRAILING BLANKS ON COMMAND LINE
	DO 3332 N=1,80
	NN=81-N
	IF(LINE(NN).GT.32)GOTO 3333
	LINE(NN)=0
3332	CONTINUE
3333	CONTINUE
C SPACE FILL ENTIRE ARRAY
	DO 3334 N=1,82
3334	LINECL(N)=32
	RETCD=1
C HANDLE DTRCMD FUNCTIONS. LINE ARRAY PASSED IN HERE
C STARTS AFTER THE "DTR" SO WE CAN DECODE IT.
C EXECUTE DTR COMMAND
C  DTRCMD (COMMAND) GIVES DTR COMMAND FACILITY AT COMMAND
C LEVEL.
C ALLOW DTRIMM COMMAND TO USE DTR IMMEDIATE TERMINAL
C INTERFACE. THE REST CAN USE SAME COMMAND NAMES AS AFTER
C THE "DB" IN *U DBXXXX COMMANDS.
500	CONTINUE
C ENABLE/DISABLE FOR DTR FUNCTIONS
C SETTING DTRENA TO -1 IMPLIES DISABLE FUNCTIONS
	CALL SCMP(LINE,%REF('ENA'),3,ICODE)
	IF(ICODE.NE.1)GOTO 600
	DTRENA=1
	GOTO 9999
600	CONTINUE
	CALL SCMP(LINE,%REF('DIS'),3,ICODE)
	IF(ICODE.NE.1)GOTO 700
	DTRENA=-1
	GOTO 9999
700	CONTINUE
	CALL SCMP(LINE,%REF('OPINS'),5,ICODE)
C OPEN INPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 3800
C DTROPINS RANGE FILENAME
	IBGN=6
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=0
	OPEN(UNIT=MFILUN,FILE=LINE(LSTCH),ACCESS='SEQUENTIAL',
     1  STATUS='UNKNOWN',ERR=9990)
	MFIOPN=1
	GOTO 9999
3800	CONTINUE
	CALL SCMP(LINE,%REF('OPINRR'),6,ICODE)
C OPEN IN RANDOM READ
	IF(ICODE.NE.1)GOTO 3900
	KK=2
	GOTO 3910
3900	CONTINUE
	CALL SCMP(LINE,%REF('OPINRU'),6,ICODE)
C OPEN IN RANDOM UPDATE
	IF(ICODE.NE.1)GOTO 3950
	KK=3
3910	CONTINUE
C HANDLE INPUT DIRECT ACCESS OPEN COMMONLY FOR READ ONLY AND R/W
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=0
	NBK=(MFIRH-MFIRL+1)*(MFICH-MFICL+1)
	OPEN(UNIT=MFILUN,FILE=LINE(LSTCH),ACCESS='DIRECT',
     1  INITIALSIZE=NBK,FORM='UNFORMATTED',STATUS='UNKNOWN',
     1  RECL=32,BLOCKSIZE=128,ERR=9990)
	MFIOPN=KK
	GOTO 9999
3950	CONTINUE
	CALL SCMP(LINE,%REF('OPOUTS'),6,ICODE)
C OPEN OUTPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 4000
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=0
	OPEN(UNIT=MFOLUN,FILE=LINE(LSTCH),ACCESS='SEQUENTIAL',
     1  STATUS='UNKNOWN',ERR=9990)
	MFOOPN=1
	GOTO 9999
4000	CONTINUE
	CALL SCMP(LINE,%REF('OPOUTR'),6,ICODE)
C OPEN OUTPUT RANDOM
	IF(ICODE.NE.1)GOTO 4100
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	NBK=(MFORH-MFORL+1)*(MFOCH-MFOCL+1)
	LINE(LSTCH+25)=0
	OPEN(UNIT=MFOLUN,FILE=LINE(LSTCH),ACCESS='DIRECT',
     1  INITIALSIZE=NBK,FORM='UNFORMATTED',STATUS='UNKNOWN',
     1  RECL=32,BLOCKSIZE=128,ERR=9990)
	MFOOPN=2
	GOTO 9999
4100	CONTINUE
	CALL SCMP(LINE,%REF('CLSOUT'),6,ICODE)
C CLOSE OUTPUT 
	IF(ICODE.NE.1)GOTO 4200
	CLOSE(UNIT=MFOLUN)
	MFOOPN=0
	GOTO 9999
4200	CONTINUE
	CALL SCMP(LINE,%REF('CLSINP'),6,ICODE)
C CLOSE INPUT 
	IF(ICODE.NE.1)GOTO 4300
	CLOSE(UNIT=MFILUN)
	MFIOPN=0
	GOTO 9999
4300	CONTINUE
	CALL SCMP(LINE,%REF('ENAOUT'),6,ICODE)
C ENABLE OUTPUT 
	IF(ICODE.NE.1)GOTO 4400
	MFOFLG=1
	GOTO 9999
4400	CONTINUE
	CALL SCMP(LINE,%REF('ENAINP'),6,ICODE)
C ENABLE INPUT 
	IF(ICODE.NE.1)GOTO 4500
	MFIFLG=1
	GOTO 9999
4500	CONTINUE
	CALL SCMP(LINE,%REF('DISINP'),6,ICODE)
C DISABLE INPUT 
	IF(ICODE.NE.1)GOTO 4510
	MFIFLG=0
	GOTO 9999
4510	CONTINUE
	CALL SCMP(LINE,%REF('DISOUT'),6,ICODE)
C DISABLE OUTPUT
	IF(ICODE.NE.1)GOTO 4520
	MFOFLG=0
	GOTO 9999
4520	CONTINUE
	CALL SCMP(LINE,%REF('EDTINP'),6,ICODE)
C ENABLE INPUT FORCE
C COMMAND
C DTREDTINP RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4600
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4550 N1=IXRL,IXRH
	DO 4550 N2=IXCL,IXCH
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL FVLDST(N1,N2,-1)
	CALL WRKFIL(IRX,LBUF,0)
	CALL WRKFIL(IRX,LBUF,1)
4550	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4600	CONTINUE
	CALL SCMP(LINE,%REF('FMTOUT'),6,ICODE)
C FORMAT/WRITE OUTPUT
C COMMAND
C DTRFMTOUT RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4630
	IVLFG=1
	GOTO 4740
4630	CONTINUE
	CALL SCMP(LINE,%REF('VALOUT'),6,ICODE)
	IF(ICODE.NE.1)GOTO 4700
C VALOUT CMD OUTPUTS VALUES WITH LONG D FORMAT
	IVFLG=2
C	GOTO 4740
4740	CONTINUE
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4650 N1=IXRL,IXRH
	DO 4650 N2=IXCL,IXCH
C FIND INDEX FOR WRKFIL
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL XVBLGT(N1,N2,TMP)
C TMP IS REAL*8 SCRATCH
	CALL FVLDST(N1,N2,-1)
	CALL WRKFIL(IRX,LBUF,0)
C HAVING LOADED THE RECORD NOW (GETTING FORMAT, ETC.)
C NOW GRAB THE VALUE AND SAVE IT...
C FIRST MOVE THE FORMAT DOWN
C NOTE LINEC AND LINECL ARE EQUIVALENT BUT LINECL IS CHAR*1
	DO 4651 N=1,9
	LBUF(N+1)=LBUF(N+119)
4651	CONTINUE
	LBUF(1)='('
	LBUF(11)=')'
	LBUF(12)=0
C FORMAT NOW LIVES IN LOW PART OF LBUF
C D25.17 FORMAT WOULD DO FOR WRITE
	IF(IVLFG.EQ.1)WRITE(LINEC,LBUF,ERR=4652)TMP
	IF(IVLFG.EQ.2)WRITE(LINEC,4658,ERR=4652)TMP
4658	FORMAT(D25.17)
C USE BUILTIN FORMAT TO WRITE THE VALUE IF COMMANDED TO DO SO OR
C USE DISPLAY FORMAT.
4652	CONTINUE
	KK=1
	DO 4653 N=1,110
4653	LBUF(N)=0
	DO 4654 N=1,60
C COPY LINECL CHARS TO LBUF, SKIPPING SPACES
	KKK=LINECL(N)
	IF(KKK.LE.32)GOTO 4654
	LBUF(KK)=LINECL(N)
	KK=KK+1
4654	CONTINUE
	CALL WRKFIL(IRX,LBUF,1)
4650	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4700	CONTINUE
	CALL SCMP(LINE,%REF('CMPFRM'),6,ICODE)
	IF(ICODE.NE.1)GOTO 4800
C DBCMPFRM V1:V2
C RETURNS IN % THE INDEX OF FORMULA 1 IN FORMULA 2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C IF WE HAVE A COMMA AND ANOTHER MTX USE IT AS LENGTHS
	CALL REFLEC(IXCL,IXRL,IRXL)
	CALL REFLEC(IXCH,IXRH,IRXH)
	IF(LINE(LSTCH).NE.',')GOTO 4780
	IBGN=LSTCH+1
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IYRL,IYCL,IYRH,IYCH,IVLD)
	IF(IVLD.EQ.3)GOTO 4780
C GET THE LENGTHS NOW
	CALL XVBLGT(IYRL,IYCL,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	LBUFL=TMP
	CALL XVBLGT(IYRH,IYCH,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	MBUFL=TMP
C IF LENGTHS ARE OK FOR BOTH, THEN USE THEM AND DO THE
C COMPARISONS BASED ON THAT.
	GOTO 4770
4780	CONTINUE
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
	CALL WRKFIL(IRXH,MBUF,0)
C LOAD THE 2 FORMULAS.
C NOW FIND THE ENDS...
	DO 4750 N=1,110
	NN=111-N
	IF(LBUF(NN).GT.32)GOTO 4751
4750	CONTINUE
4751	LBUFL=NN
	DO 4760 N=1,110
	NN=111-N
	IF(MBUF(NN).GT.32)GOTO 4761
4760	CONTINUE
4761	MBUFL=NN
4770	CONTINUE
	NN=INDEX(CLBUF(1:LBUFL),CMBUF(1:MBUFL))
C NN IS LOCATION OF SUBSTRING NOW
	XAC=NN
C RETURN RESULT IN % ACCUMULATOR.
	WAC=0.
	IF(LLT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=-1.
	IF(LGT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=1.
C RETURN LESS/GREATER/EQUAL IN W ACCUMULATOR FOR POSSIBLE
C USE IN SORTS, ETC. THUS WE CAN TEST 2 STRINGS BY TESTING W ACCUM.
C (LEAVES X, Y ALONE SINCE W IS MORE FREQUENTLY FREE.)
	GOTO 9999
4800	CONTINUE
	CALL SCMP(LINE,%REF('LENFRM'),6,ICODE)
	IF(ICODE.NE.1)GOTO 4900
C DBLENFRM V1:V2
C RETURNS LENGTH OF FORMULA IN V1 IN % AND V2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C IF WE HAVE A COMMA AND ANOTHER MTX USE IT AS LENGTHS
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
C LOAD THE FORMULA.
C NOW FIND THE END...
	DO 4850 N=1,110
	NN=111-N
	IF(LBUF(NN).GT.32)GOTO 4851
4850	CONTINUE
4851	LBUFL=NN
	TMP=LBUFL
	XAC=TMP
C SAVE LENGTH IN OUTPUT CELL. DON'T TOUCH VALIDITY FOR THE CELL.
	NN=0
C SEE IF CELL IS VALID AND IF NOT VALID DON'T SAVE ANYTHING IN IT.
	CALL FVLDGT(IXRH,IXCH,NN)
	IF(NN.EQ.0)GOTO 9999
	CALL XVBLST(IXRH,IXCH,TMP)
	GOTO 9999
4900	CONTINUE
	CALL SCMP(LINE,%REF('TRMFRM'),6,ICODE)
	IF(ICODE.NE.1)GOTO 5000
C TRIM FORMULA
C DTRTRMFRM INCELL:OUTCELL,START:END
C RETURNS TRIMMED FORMULA TO CELL.
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCHR,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C GOT CELL HERE...BOTH FOR INPUT AND OUTPUT
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL REFLEC(IXCH,IXRH,IRXH)
	CALL WRKFIL(IRXL,LBUF,0)
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LOCHR=1
	IF(TMP.GT.0..AND.TMP.LT.110.)LOCHR=TMP
C LOCHR = START CHAR
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LHICHR=110
	IF(TMP.GT.0..AND.TMP.LT.110.)LHICHR=TMP
C LHICHR IS END CHARACTER
C NOW ALL ARGS ARE COLLECTED.
C (IGNORE WHAT WAS DELIMITER...)
C COPY DESIRED STUFF TO MBUF
	N=1
	DO 4910 NN=1,110
	MBUF(NN)=0
	IF(NN.LT.LOCHR.OR.NN.GT.LHICHR)GOTO 4910
	MBUF(N)=LBUF(NN)
	N=N+1
C COPY DESIRED PART OF FORMULA TO MBUF WITH THE REST ZEROED.
4910	CONTINUE
	DO 4911 NN=111,128
4911	MBUF(NN)=LBUF(NN)
	CALL WRKFIL(IRXH,MBUF,1)
C WRITE BUFFER BACK TO CELL AS TRIMMED NOW, GOING TO OUT CELL
C RATHER THAN INPUT CELL (TO ALLOW REPEATED CALCS TO BE STABLE.)
	GOTO 9999
5000	CONTINUE
	GOTO 9999
9990	RETCD=3
C ERROR RETURN
9999	RETURN
	END
	SUBROUTINE DTRFCT(LINE,RETCD)
	INTEGER*2 RETCD
	LOGICAL*1 LINE(80)
	LOGICAL *1 LINECL(82)
	CHARACTER*62 LINEC
	EQUIVALENCE(LINEC,LINECL(1))
C
C
C DEFINE FILE AREAS FOR MAPPING FILES...
C ONE INPUT FILE, TO BE ACCESSED AS A RANDOM ACCESS FILE OF 128 BYTE
C RECORDS OF DATA IF RANDOM, OR AS A FORMULA FILE IF SEQUENTIAL, AND
C ONE OUTPUT FILE TO BE WRITTEN THE SAME WAY. INPUT FILE CAN BE
C INPUT - ONLY OR READ/WRITE.
C
C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL)
C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED.
C
C MFIOPN =	0	IF NOT OPEN
C		1	IF OPEN FOR READ ONLY, SEQUENTIAL
C		2	IF OPEN READ ONLY, RANDOM
C		3	IF OPEN READ/WRITE, RANDOM.
C
C MFOOPN =	0	IF NOT OPEN
C		1	IF OPEN WRITE SEQUENTIAL
C		2	IF OPEN WRITE RANDOM
C
C OTHER OPTIONS DON'T MAKE SENSE.
C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS
C MFILUN,MFOLUN ARE LOGICAL UNITS.
	INTEGER*2 MFIOPN,MFIRL,MFIRH,MFICL,MFICH
	INTEGER*2 MFOOPN,MFORL,MFORH,MFOCL,MFOCH
	INTEGER*2 MFILUN,MFOLUN,MFIFLG,MFOFLG
	COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH,
     1  MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG
C
C
	INCLUDE 'VKLUGPRM.FTN'
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	REAL*8 TAC,UAC,VAC,WAC,YAC
	REAL*8 TMP
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(WAC,AVBLS(1,23)),(YAC,AVBLS(1,25))
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(TAC,AVBLS(1,20))
	EQUIVALENCE(UAC,AVBLS(1,21))
	EQUIVALENCE(VAC,AVBLS(1,22))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	INTEGER*2 XTNCNT,XTCFG,IPSET
	LOGICAL*1 XTNCMD(80)
	INTEGER*2 FORMFG,RCFGX,PZAP,RCONE
	INTEGER*2 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6
	INTEGER*2 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE
	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C LOOP CONTROL FOR VARY FUNCTION. SET ZERO IN SPREDSHT AND
C MUST BE SET POSITIVE HERE IF WE NEED ITERATIONS.
C (IMPLEMENT FOR VAX ONLY)
	INTEGER KALKIT
	COMMON/VARYIT/KALKIT
C ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	INTEGER*2 DTRENA
	COMMON/DTRCMN/DTRENA
C	CHARACTER*70 LINEC
	LOGICAL*1 LBUF(128)
	LOGICAL*1 MBUF(128)
	CHARACTER*110 CLBUF,CMBUF
	EQUIVALENCE(CLBUF,LBUF(1)),(CMBUF,MBUF(1))
C USE CLBUF, CMBUF FOR CHARACTER COMPARISONS...
c	LOGICAL*1 IFVLD
	RETCD=1
	IF(DTRENA.LT.0)GOTO 9999
C NULL OUT ANY TRAILING BLANKS ON COMMAND LINE
	DO 3332 N=1,76
	NN=77-N
	IF(LINE(NN).GT.32)GOTO 3333
	LINE(NN)=0
3332	CONTINUE
3333	CONTINUE
C SPACE FILL ENTIRE ARRAY
	DO 3334 N=1,82
3334	LINECL(N)=32
	RETCD=1
C HANDLE *U DBXXXX FUNCTIONS. LINE ARRAY PASSED IN HERE
C STARTS AFTER THE "DB" SO WE CAN DECODE IT.
C *U DBCMD (COMMAND) PASSES COMMAND TO DTR FOR ACTION
C  HOWEVER THIS DOES NOT RETURN A VALUE. USE FOR
C  SETUP PURPOSES ONLY.
C
C INTERFACE DOCUMENTATION:
C
C *U DBCMD COMMAND
C  WILL PASS COMMAND AND FLUSH MESSAGES.
C *U DBVAL COMMAND
C  WILL PASS COMMAND AND RETRIEVE CONTENTS OF
C  MESSAGE BUFFER AS VALUE IN % ACCUMULATOR
C  *U DBTXT CELL,COMMAND
C  WILL PASS COMMAND AND RETRIEVE MESSAGE BUFFER.
C   MESSAGE BUFFER WILL BE PLACED IN CELL NAMED
C   AS ASCII TEXT.
C  *U DBRPV CELL
C   WILL TAKE VALUE IN CELL AND USE AS A REPLY TO A
C   DTR QUERY (AS IN KEYBOARD INPUTS TO PROCEDURES).
C  *U DBRPT CELL
C   WILL TAKE TEXT IN CELL AND USE AS A REPLY TO A
C   DTR QUERY AS ABOVE.
C
C ALL THE ABOVE CALLS WILL BE ALSO IMPLEMENTED AS
C DIRECT "DTRXXX" COMMANDS FOR COMMAND LEVEL USE.
C
C NO NEED TO INCLUDE ABILITY TO STORE COMMANDS IN CELLS
C FOR EDITING SINCE {CELL CONSTRUCT PROVIDES THIS ALREADY.
C (AND AT COMMAND LEVEL THE __{CELL CONSTRUCT DOES ALSO.)
500	CONTINUE
	CALL SCMP(LINE,%REF('OPINS'),5,ICODE)
C OPEN INPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 3800
C DTROPINS RANGE FILENAME
	IBGN=6
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=0
	OPEN(UNIT=MFILUN,FILE=LINE(LSTCH),ACCESS='SEQUENTIAL',
     1  STATUS='UNKNOWN',ERR=9990)
	MFIOPN=1
	GOTO 9999
3800	CONTINUE
	CALL SCMP(LINE,%REF('OPINRR'),6,ICODE)
C OPEN IN RANDOM READ
	IF(ICODE.NE.1)GOTO 3900
	KK=2
	GOTO 3910
3900	CONTINUE
	CALL SCMP(LINE,%REF('OPINRU'),6,ICODE)
C OPEN IN RANDOM UPDATE
	IF(ICODE.NE.1)GOTO 3950
	KK=3
3910	CONTINUE
C HANDLE INPUT DIRECT ACCESS OPEN COMMONLY FOR READ ONLY AND R/W
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFIRL,MFICL,MFIRH,MFICH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=0
	NBK=(MFIRH-MFIRL+1)*(MFICH-MFICL+1)
	OPEN(UNIT=MFILUN,FILE=LINE(LSTCH),ACCESS='DIRECT',
     1  INITIALSIZE=NBK,FORM='UNFORMATTED',STATUS='UNKNOWN',
     1  RECL=32,BLOCKSIZE=128,ERR=9990)
	MFIOPN=KK
	GOTO 9999
3950	CONTINUE
	CALL SCMP(LINE,%REF('OPOUTS'),6,ICODE)
C OPEN OUTPUT SEQUENTIAL
	IF(ICODE.NE.1)GOTO 4000
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	LINE(LSTCH+25)=0
	OPEN(UNIT=MFOLUN,FILE=LINE(LSTCH),ACCESS='SEQUENTIAL',
     1  STATUS='UNKNOWN',ERR=9990)
	MFOOPN=1
	GOTO 9999
4000	CONTINUE
	CALL SCMP(LINE,%REF('OPOUTR'),6,ICODE)
C OPEN OUTPUT RANDOM
	IF(ICODE.NE.1)GOTO 4100
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,MFORL,MFOCL,MFORH,MFOCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	NBK=(MFORH-MFORL+1)*(MFOCH-MFOCL+1)
	LINE(LSTCH+25)=0
	OPEN(UNIT=MFOLUN,FILE=LINE(LSTCH),ACCESS='DIRECT',
     1  INITIALSIZE=NBK,FORM='UNFORMATTED',STATUS='UNKNOWN',
     1  RECL=32,BLOCKSIZE=128,ERR=9990)
	MFOOPN=2
	GOTO 9999
4100	CONTINUE
	CALL SCMP(LINE,%REF('CLSOUT'),6,ICODE)
C CLOSE OUTPUT 
	IF(ICODE.NE.1)GOTO 4200
	CLOSE(UNIT=MFOLUN)
	MFOOPN=0
	GOTO 9999
4200	CONTINUE
	CALL SCMP(LINE,%REF('CLSINP'),6,ICODE)
C CLOSE INPUT 
	IF(ICODE.NE.1)GOTO 4300
	CLOSE(UNIT=MFILUN)
	MFIOPN=0
	GOTO 9999
4300	CONTINUE
	CALL SCMP(LINE,%REF('ENAOUT'),6,ICODE)
C ENABLE OUTPUT 
	IF(ICODE.NE.1)GOTO 4400
	MFOFLG=1
	GOTO 9999
4400	CONTINUE
	CALL SCMP(LINE,%REF('ENAINP'),6,ICODE)
C ENABLE INPUT 
	IF(ICODE.NE.1)GOTO 4500
	MFIFLG=1
	GOTO 9999
4500	CONTINUE
	CALL SCMP(LINE,%REF('DISINP'),6,ICODE)
C DISABLE INPUT 
	IF(ICODE.NE.1)GOTO 4510
	MFIFLG=0
	GOTO 9999
4510	CONTINUE
	CALL SCMP(LINE,%REF('DISOUT'),6,ICODE)
C DISABLE OUTPUT
	IF(ICODE.NE.1)GOTO 4520
	MFOFLG=0
	GOTO 9999
4520	CONTINUE
	CALL SCMP(LINE,%REF('EDTINP'),6,ICODE)
C ENABLE INPUT FORCE
C COMMAND
C DTREDTINP RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4600
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4550 N1=IXRL,IXRH
	DO 4550 N2=IXCL,IXCH
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL FVLDST(N1,N2,-1)
	CALL WRKFIL(IRX,LBUF,0)
	CALL WRKFIL(IRX,LBUF,1)
4550	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4600	CONTINUE
	CALL SCMP(LINE,%REF('FMTOUT'),6,ICODE)
C FORMAT/WRITE OUTPUT
C COMMAND
C DTRFMTOUT RANGE
C GETS RANGE, THEN FOR EACH CELL IN RANGE READS IN (BY WRKFIL READ CALL)
C A CELL, SETS ITS FVLD CODE TO -1 (TO FLAG A TEXT CELL), AND WRITES
C IT OUT AGAIN.
	IF(ICODE.NE.1)GOTO 4630
	IVLFG=1
	GOTO 4740
4630	CONTINUE
	CALL SCMP(LINE,%REF('VALOUT'),6,ICODE)
	IF(ICODE.NE.1)GOTO 4700
C VALOUT CMD OUTPUTS VALUES WITH LONG D FORMAT
	IVFLG=2
C	GOTO 4740
4740	CONTINUE
C FORCE ENABLE OF READIN DURING THIS
	MFIFLG=1
	MFOFLG=1
C ENABLE OUTPUT TOO.
	IBGN=7
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	DO 4650 N1=IXRL,IXRH
	DO 4650 N2=IXCL,IXCH
C FIND INDEX FOR WRKFIL
	CALL REFLEC(N2,N1,IRX)
C SET THE ELEMENT AS VALID AND READ/WRITE IT ONCE.
	CALL XVBLGT(N1,N2,TMP)
C TMP IS REAL*8 SCRATCH
	CALL FVLDST(N1,N2,-1)
	CALL WRKFIL(IRX,LBUF,0)
C HAVING LOADED THE RECORD NOW (GETTING FORMAT, ETC.)
C NOW GRAB THE VALUE AND SAVE IT...
C FIRST MOVE THE FORMAT DOWN
C NOTE LINEC AND LINECL ARE EQUIVALENT BUT LINECL IS CHAR*1
	DO 4651 N=1,9
	LBUF(N+1)=LBUF(N+119)
4651	CONTINUE
	LBUF(1)='('
	LBUF(11)=')'
	LBUF(12)=0
C FORMAT NOW LIVES IN LOW PART OF LBUF
C D25.17 FORMAT WOULD DO FOR WRITE
	IF(IVLFG.EQ.1)WRITE(LINEC,LBUF,ERR=4652)TMP
	IF(IVLFG.EQ.2)WRITE(LINEC,4658,ERR=4652)TMP
4658	FORMAT(D25.17)
C USE BUILTIN FORMAT TO WRITE THE VALUE IF COMMANDED TO DO SO OR
C USE DISPLAY FORMAT.
4652	CONTINUE
	KK=1
	DO 4653 N=1,110
4653	LBUF(N)=0
	DO 4654 N=1,60
C COPY LINECL CHARS TO LBUF, SKIPPING SPACES
	KKK=LINECL(N)
	IF(KKK.LE.32)GOTO 4654
	LBUF(KK)=LINECL(N)
	KK=KK+1
4654	CONTINUE
	CALL WRKFIL(IRX,LBUF,1)
4650	CONTINUE
	MFIFLG=0
	MFOFLG=0
	GOTO 9999
4700	CONTINUE
	CALL SCMP(LINE,%REF('CMPFRM'),6,ICODE)
	IF(ICODE.NE.1)GOTO 4800
C DBCMPFRM V1:V2
C RETURNS IN % THE INDEX OF FORMULA 1 IN FORMULA 2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C IF WE HAVE A COMMA AND ANOTHER MTX USE IT AS LENGTHS
	CALL REFLEC(IXCL,IXRL,IRXL)
	CALL REFLEC(IXCH,IXRH,IRXH)
	IF(LINE(LSTCH).NE.',')GOTO 4780
	IBGN=LSTCH+1
	IVLD=0
	CALL GMTX(LINE,IBGN,LSTCH,IYRL,IYCL,IYRH,IYCH,IVLD)
	IF(IVLD.EQ.3)GOTO 4780
C GET THE LENGTHS NOW
	CALL XVBLGT(IYRL,IYCL,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	LBUFL=TMP
	CALL XVBLGT(IYRH,IYCH,TMP)
	IF(TMP.LT.1.OR.TMP.GT.109.)GOTO 4780
	MBUFL=TMP
C IF LENGTHS ARE OK FOR BOTH, THEN USE THEM AND DO THE
C COMPARISONS BASED ON THAT.
	GOTO 4770
4780	CONTINUE
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
	CALL WRKFIL(IRXH,MBUF,0)
C LOAD THE 2 FORMULAS.
C NOW FIND THE ENDS...
	DO 4750 N=1,110
	NN=111-N
	IF(LBUF(NN).GT.32)GOTO 4751
4750	CONTINUE
4751	LBUFL=NN
	DO 4760 N=1,110
	NN=111-N
	IF(MBUF(NN).GT.32)GOTO 4761
4760	CONTINUE
4761	MBUFL=NN
4770	CONTINUE
	NN=INDEX(CLBUF(1:LBUFL),CMBUF(1:MBUFL))
C NN IS LOCATION OF SUBSTRING NOW
	XAC=NN
C RETURN RESULT IN % ACCUMULATOR.
	WAC=0.
	IF(LLT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=-1.
	IF(LGT(CLBUF(1:LBUFL),CMBUF(1:MBUFL)))WAC=1.
C RETURN LESS/GREATER/EQUAL IN W ACCUMULATOR FOR POSSIBLE
C USE IN SORTS, ETC. THUS WE CAN TEST 2 STRINGS BY TESTING W ACCUM.
C (LEAVES X, Y ALONE SINCE W IS MORE FREQUENTLY FREE.)
	GOTO 9999
4800	CONTINUE
	CALL SCMP(LINE,%REF('LENFRM'),6,ICODE)
	IF(ICODE.NE.1)GOTO 4900
C DBLENFRM V1:V2
C RETURNS LENGTH OF FORMULA IN V1 IN % AND V2
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCH,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL WRKFIL(IRXL,LBUF,0)
C LOAD THE FORMULA.
C NOW FIND THE END...
	DO 4850 N=1,110
	NN=111-N
	IF(LBUF(NN).GT.32)GOTO 4851
4850	CONTINUE
4851	LBUFL=NN
	TMP=LBUFL
	XAC=TMP
C SAVE LENGTH IN OUTPUT CELL. DON'T TOUCH VALIDITY FOR THE CELL.
	NN=0
C SEE IF CELL IS VALID AND IF NOT VALID DON'T SAVE ANYTHING IN IT.
	CALL FVLDGT(IXRH,IXCH,NN)
	IF(NN.EQ.0)GOTO 9999
	CALL XVBLST(IXRH,IXCH,TMP)
	GOTO 9999
4900	CONTINUE
	CALL SCMP(LINE,%REF('TRMFRM'),6,ICODE)
	IF(ICODE.NE.1)GOTO 5000
C TRIM FORMULA
C DTRTRMFRM INCELL:OUTCELL,START:END
C RETURNS TRIMMED FORMULA TO CELL.
	IBGN=7
	IVLD=0
C USE GMTX TO GET CELL ADDRESSES.
	CALL GMTX(LINE,IBGN,LSTCHR,IXRL,IXCL,IXRH,IXCH,IVLD)
	IF(IVLD.EQ.3)GOTO 9990
C GOT CELL HERE...BOTH FOR INPUT AND OUTPUT
	CALL REFLEC(IXCL,IXRL,IRXL)
C GET INDEX OF EACH ELEMENT...
	CALL REFLEC(IXCH,IXRH,IRXH)
	CALL WRKFIL(IRXL,LBUF,0)
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LOCHR=1
	IF(TMP.GT.0..AND.TMP.LT.110.)LOCHR=TMP
C LOCHR = START CHAR
	LO=LSTCHR+1
	LHI=LSTCHR+21
	LSTCHR=LHI
	CALL VARSCN(LINE,LO,LHI,LSTCHR,JD1,JD2,IVLD)
	IF(IVLD.EQ.0)GOTO 9990
	CALL XVBLGT(JD1,JD2,TMP)
	LHICHR=110
	IF(TMP.GT.0..AND.TMP.LT.110.)LHICHR=TMP
C LHICHR IS END CHARACTER
C NOW ALL ARGS ARE COLLECTED.
C (IGNORE WHAT WAS DELIMITER...)
C COPY DESIRED STUFF TO MBUF
	N=1
	DO 4910 NN=1,110
	MBUF(NN)=0
	IF(NN.LT.LOCHR.OR.NN.GT.LHICHR)GOTO 4910
	MBUF(N)=LBUF(NN)
	N=N+1
C COPY DESIRED PART OF FORMULA TO MBUF WITH THE REST ZEROED.
4910	CONTINUE
	DO 4911 NN=111,128
4911	MBUF(NN)=LBUF(NN)
	CALL WRKFIL(IRXH,MBUF,1)
C WRITE BUFFER BACK TO CELL AS TRIMMED NOW, GOING TO OUT CELL
C RATHER THAN INPUT CELL (TO ALLOW REPEATED CALCS TO BE STABLE.)
	GOTO 9999
5000	CONTINUE
	GOTO 9999
9990	RETCD=3
C ERROR RETURN
9999	RETURN
	END