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.
	SUBROUTINE USRCMD(CMDLIN,ICODE,IGOTIT)
	CHARACTER*80 CMDSTR
	BYTE CMLN(80)
	EQUIVALENCE(CMLN,CMDSTR)
C DUMMY PLACE FOR USER COMMANDS TO PARSE CMDLIN AND HANDLE
C ADDITIONAL COMMANDS FOR VMS PORTACALC.
	INCLUDE 'VKLUGPRM.FTN'
C DEFINE VALUE AREA FOR SPREAD SHEET. MORE WILL BE NEEDED GENERALLY
C OUT OF COMMONS, BUT AT A MINIMUM, THIS WILL ALLOW SOME ACCESS TO
C USEFUL NUMBERS. LOOK IN XQTCMD FOR MORE...
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	INTEGER*2 IOLVL,FOOBAR
	COMMON/FOOBAR/FOOBAR
	COMMON/IOLVL/IOLVL
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	REAL*8 TAC,UAC,VAC
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	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
c available parsing aid:
c call varscn(line,ibgn,lend,lstchr,id1,id2,ivalid)
c where line(ibgn... lend) is scanned. If variable found
c ivalid=1 else ivalid=0. id1,id2 are dims in xvbls for
c variable found if any. lstchr is last char found+1...
C OTHER USEFUL ROUTINES IN THE SHEET:
C GN(LAST,LEND,NUMBER,LINE)
C  LOOKS FROM LINE(LAST) THRU LINE(LEND) FOR A NUMBER AND
C  RETURNS ANY NUMBER IN "NUMBER" ARG. ASSUMES "LINE" IS A
C  BYTE ARRAY. (NO INDICATION OF WHERE THE NUMBER WAS FOUND
C  HOWEVER). THROWS OUT LEADING SPACES, TERMINATES ON A NON
C  NUMERIC.
C INDEX(LINE,CHAR)
C  EXPECTS LINE TO BE NULL TERMINATED AND RETURNS EITHER
C  THE SUBSCRIPT (COUNTING FROM 1) OF CHAR IN LINE OR THE
C  MAX SUBSCRIPT IN LINE (I.E., WHERE IT HIT THE NULL TERMINATOR).
C  NOTE THIS DIFFERS FROM THE "STANDARD" VERSION OF INDEX WHICH
C  RETURNS 0 FOR "NOT FOUND" -- THIS VERSION RETURNS MAX LENGTH
C  FOR "NOT FOUND". STOPS AT 512 BYTES HOWEVER...
C  PARSING IS UP TO USER. NOTE VARSCN MAY BE CALLED TO PARSE
	LOGICAL*1 CMDLIN(132)
	INTEGER*4 ISTTS
C
C INSERT CODE FOR ADDING A LIB$SPAWN CALL HERE TO PASS COMMANDS TO
C DCL IF THEY BEGIN WITH A $ CHARACTER.
	IGOTIT=0
	IF(CMDLIN(1).NE.'$'.AND.CMDLIN(1).NE.'}')GOTO 8000
C
C HERE CALL THE LIB$SPAWN WITH THE COMMAND LINE AS AN ARGUMENT...
	DO 1000 NN=1,80
1000	CMLN(NN)=CMDLIN(NN+1)
	CMLN(80)=13 ! ADD C.R. AFTER LINE
C ABOVE, INSERT A CR AFTER CMD LINE
	ISTTS=LIB$SPAWN(CMDSTR)
C ASSUME WE NEED A REDRAW AFTER THE SPAWN FINISHES
	IF(CMDLIN(1).NE.'}')GOTO 750
	WRITE(6,760)
760	FORMAT(' PRESS RETURN TO REDRAW SPREADSHEET>')
	READ(IOLVL,761,END=800,ERR=800)N
761	FORMAT(4A1)
750	continue
950	CONTINUE
	ICODE=2
C FLAG THE MAIN COMMAND PARSER WE HANDLED THE COMMAND
	IGOTIT=1
	GOTO 9990
8000	CONTINUE
	IF(CMDLIN(1).NE.'D'.OR.CMDLIN(2).NE.'T'.OR.CMDLIN(3).NE.'R')
     1  GOTO 8990
	IGOTIT=1
	ICODE=2
	CALL DTRCMD(CMDLIN(4))
C ISSUE DATATRIEVE COMMAND...
8990	CONTINUE
	IF(CMDLIN(1).NE.'F'.OR.CMDLIN(2).NE.'I'.OR.CMDLIN(3).NE.'L')
     1  GOTO 9990
	IGOTIT=1
C FLAG FOR RECALCULATION BUT NOT TOTAL REDISPLAY IF PREFIX IS
C 'FIL' RATHER THAN 'DTR'...
	ICODE=3
	CALL DTRCMD(CMDLIN(4))
C ISSUE DATATRIEVE COMMAND...
C
9990	CONTINUE
	RETURN
800	CONTINUE
	CLOSE(UNIT=IOLVL)
C RESET TO NORMAL I/O OFF CONSOLE.
	FOOBAR=0
	IOLVL=5
	CLOSE(UNIT=5)
	OPEN(UNIT=5,FILE='SYS$COMMAND:',CARRIAGECONTROL='NONE')
C REOPEN CONSOLE IN CASE OF INITIALIZER FILES...
	GOTO 750
	END
