C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
C USER FUNCTION ROUTINE
C GENERATES PARSING AND EXECUTION OF ROUTINE CALLS OF FORM
C  *U FNAME (ARGUMENTS)
C WHERE LINE (80 BYTES) CONTAINS COMMAND LINE AND ALL
C ARGUMENTS MAY BE PARSED.
C CALLED FROM CMND
C  PARSING IS UP TO USER. NOTE VARSCN MAY BE CALLED TO PARSE
C VARIABLE NAMES. SUPPLIED VERSION CALLS IDATE WHICH RETURNS
C SYSTEM DATE IN RSX OR VMS AS INTEGER DAY, MONTH, AND YEAR.
C  THIS RETURNS HERE IN AC T, U, AND V
	SUBROUTINE USRFCT(LINE,RETCD)
	INCLUDE 'VKLUGPRM.FTN'
	BYTE LINE(80)
	INTEGER RETCD
	LOGICAL*1 AVBLS(100,27),WRK(128),VBLS(8,RRW,RCL)
	INTEGER*2 TYPE(RRW,RCL),VLEN(9)
	REAL*8 XAC,XVBLS(RRW,RCL)
	REAL*8 TAC,UAC,VAC
	INTEGER*4 JVBLS(2,RRW,RCL)
	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 ARGUMENTS COME IN IN ARGUMENTS IN LINE
C RESULTS GO INTO PERCENT (XAC) AND WHEREVER ELSE DESIRED...
	LOGICAL*1 FNAMS(6,1)
C FNAMS IS NAME OF FUNCTION CALLED.
	DATA FNAMS /'I','D','A','T','E',0/
C NULL TERMINATE ANY NAMES (ALLOWS 5 CHARACTERS)
C START LOOKING PAST THE *U
C  GET FUNCTION NAME AND GO TO PROCESS EACH FUNCTION SEPARATELY
C GET NONBLANK CHAR FOR FUNCTION NAME START
	K=3
30	IF(LINE(K).NE.' ')GOTO 40
	K=K+1
	IF(K.LT.60)GOTO 30
40	CONTINUE
C UNCOMMENT THE DO 100 STMT IF DIM 2 OF FNAMS > 1
	N=1
C	DO 100 N=1,1
	KF=N
	DO 110 NN=1,6
	IF(LINE(K+NN-1).NE.FNAMS(NN,N).AND.FNAMS(NN,N).GT.0)
     1  GOTO 100
110	CONTINUE
	GOTO 200
100	CONTINUE
C UNRECOGNIZED FUNCTION... IGNORE
300	RETCD=3
	RETURN
200	CONTINUE
C NOW HAVE FOUND FUNCTION IDENTIFIED BY KF. CALL IT AND ALLOW TO WORK
	GOTO (1100),KF
	GOTO 300
1100	CONTINUE
C IDATE FUNCTION
C RETURNS MONTH, DAY, YEAR IN AC'S T,U,V
	CALL IDATE(IMO,IDA,IYR)
	TAC=IMO
	UAC=IDA
	VAC=IYR
C RETURN A FLOATING VALUE OF DATE FORM AS YYMMDD SO IT CAN BE
C USED FOR SORTING AND SIMILAR APPLICATIONS. COULD BE USED ALSO
C FOR INTERVALS IF A JULIAN DATE WERE RETURNED, BUT THIS WILL DO
C FOR COMPARISONS AND ORDERING.
	XAC=VAC*10000.+TAC*100.+UAC
	RETURN
	END