c Response.For
c 25 April 85, add automatic termination if no response
c 19 April 85, add "category"
c v1 Dan Smith 6 March 85
c
c Will replace old "Units.for"
c
c This is a concatenation of two former programs.
c	response does the response-time query
c	units generates the units message
c
c RESPONSE USES NUSERS WHICH REQUIRES WORLD PRIVILEGE
c
	call response
c	call units
	end
	subroutine response
c Reponse.for v1 Dan Smith
c
c 11 March, re-write nusers, combine with "units"
c 6 March 85
c
c Purpose
c
c	To be included as part of standard logout procedures
c	Keeps a record of system response as measured by
c		users' subjective impression
c
c Files
c
c	Each logout appends a one-line entry to the file
c
c		SYS$RESPONSE:RESPONSE.LOG
c
c	Each logout ALSO creates, then deletes the file
c
c		SYS$RESPONSE:NUSERS.TMP
c
	implicit integer(a-z)
	character grade*1,line*75,user*12,datetime*24,graderep*3
	character jpistr*12
	character category*12
	logical status
	include '($ssdef)'
	include '($jpidef)'
c
c Unit=1 was used in a previous version to store the prompting text
c	so that it would be separate from the program.  (I'd been
c	reading too much about Macintosh resource files).  I had
c	problems getting it to work cleanly and figured we could do
c	without the extra file I/O so I canned it. That's why unit
c	numbers now start at 2.
c
c Need to use an explicit open rather than using "*" because this
c	gets executed from within a command procedure and sys$input
c	isn't the TT:
c
c****************************************************************
c								*
c	Edit 2 and 5 to change user prompt and explanation	*
c								*
c****************************************************************
c
	call keywait(10)		!Defines waiting time for response
	retry=0
	open(unit=2,status='unknown',file='sys$command')
2	format(' How good was system response? Type question mark or'
	1	' A, B, C, D, F:',$)
c
5	format(//' During this session, how fast did the system '
	1	'respond to your commands?'/
	2	' Please give a letter grade:'/
	3	/
	4	'     A -- Good'/
	5	'     B -- Satisfactory, but slower than usual'/
	6	'     C -- Slow enough to be a problem at times'/
	7	'     D -- Interfered with getting my work done'/
	8	'     F -- Logging off because system is unusable'/
	9	)
c
c Get the grade
c
c 	character grade*1	letter, A B C D F (or char(0) if no resp)
c	integer igrade		translation to 4 3 2 1 0, respectively
c	character graderep*3	How it will appear in log;
c				"B=3" if a grade was supplied,
c				blank if no grade was supplied
c
10	continue
	write(2,2)
	call keystroke(grade)
	if(grade.eq.char(0))then
		if (retry.lt.2)then
			retry=retry+1
			write(*,*)char(7)
			go to 10
		else
			write(*,*)'No grade recorded'
			graderep='---'
			go to 100
		endif
	endif
c
c These translate abcdf to ABCDF, convert ABCDF to 43210,
c	and (since index returns -1 if not found) detects
c	anything other than A, B, C, D, or F
c
	call str$upcase(grade,grade)
	igrade=index('FDCBA',grade)-1
c
c Although we suggest using question mark, any input other than
c	ABCDF is handled identically: explain and re-prompt.
c
	if (igrade.lt.0) then
		write(2,5)
		go to 10
	end if
	write(graderep,40)grade,igrade
40	format(a1,'=',i1)
c
c Get associated information to be logged along with the grade:
c
c grp and mem are the two parts of the UIC, respectively.
c	I used to log them, I don't any more, but I left them in
c	in case we decide we need them again.
c
c user is the username
c
c "nusers" is a kludge, but it returns the number of users.
c
100	continue
	grp=jpival(jpi$_grp)
	mem=jpival(jpi$_mem)
	user=jpistr(jpi$_username)
	call nusers(nuse)
	call lib$date_time(datetime)
	istat=lib$sys_trnlog('SYS$USER_CATEGORY',l,category)
	if(istat.eq.ss$_notran)category='UNDEFINED'
c
c****************************************************************
c								*
c	Edit here to change format and contents of the		*
c	log entries						*
c****************************************************************
c
	open(unit=1,access='append',status='unknown',
	1	file='sys$response:response.log')
	write(1,200)datetime,nuse,graderep,user,category
200	format(1x,a24,1x,i3,1hu,1x,a3,' ',a12,1x,a12)
	return
	end
c
	subroutine nusers(n)
	implicit integer(a-z)
	include '($SSDEF)/nolist'
	include '($JPIDEF)/nolist'
	dimension itemlist(7)
	character terminal*8,username*12
c
c Item list per $getjpi description, p. 126, system services reference manual
c
	itemlist(1)=ishft(jpi$_terminal,16)+8
	itemlist(2)=%loc(terminal)
	itemlist(3)=%loc(lterminal)
	itemlist(4)=ishft(jpi$_username,16)+12
	itemlist(5)=%loc(username)
	itemlist(6)=%loc(lusername)
	itemlist(7)=0
c
c "wild card"
c
	pidadr=-1
	n=0
c
c Itemlist is a list of JPI items to be returned.
c	Wait for event flag is necessary because according to
c	manual stuff outside your own group is asynchronous and
c	you need to do it.
c
c pidadr=-1 is a "wildcard" value according to manual.
c
c expect only 2 conditions:
c	ss$normal
c	ss$nomoreproc
c anything else, pass to "check" for translation.
c
c Needs world privilege to run!!!!
c
	go to 200
c
100	continue
c
	call sys$waitfr(%val(0))
c	write(*,*)username,' ',terminal
	if(lterminal.ne.0)n=n+1
200	istat=sys$getjpi(%val(0),pidadr,,itemlist,,,)
	if(istat.eq.ss$_normal)go to 100
	if(istat.ne.ss$_nomoreproc)call check(istat)
	return
	end

c*******************************************************************
	subroutine units
c
c UNITS.FOR v1 Dan Smith, 2 March 1984
c 6 Mar 84--Truncate money values to avoid "errors" in total.
c
c
	parameter conrate = 3.00	!Connect time charge, "units" per hour
	parameter cpurate =40.00	!CPU time charge, "units" per hour
c
c
c This program is intended for execution just before logout.
c It obtains CPU and connect time from the operating system,
c converts them to "units" (nominal dollar), and displays them.
c
c To change rates, edit CONRATE and CPURATE above and
c
c	FORT UNITS
c	LINK UNITS
c
c Active copy is normally SYS$MANAGER:UNITS.EXE, but check
c SYS$MANAGER:LOGOUT.COM to be sure.
c
	include '($jpidef)'
	character*8 conasc,cpuasc
c
c logtime = login time, system format
c nowtime = present time, system format
c timedif = computed difference.  Computed as negative, so
c		becomes delta-time in system format.
c cputime = elapsed cpu time in system format.
c		Computed by multiplying returned CPU time
c		(in hundredths of a second) by -100000.
c		Negative, so delta time in system format.
	integer*4 logtime(2),nowtime(2),timedif(2),cputime(2)
c
c
	cents(v)=nint(100.0*v)
c
	icpu=jpival(jpi$_cputim)
c
c
c Get login time and present time
c
	call jpi(jpi$_logintim,logtime,8)
	call check(sys$gettim(nowtime))
c
c Form difference in TIMEDIF, then
c	divide by 10000000 to get seconds
c
	call check(lib$subx(logtime,nowtime,timedif))
	call check(lib$ediv(10000000,timedif,iquot,irem))
	connect=-iquot/3600.0
	conunits=cents(connect*conrate)
	cpuhr=icpu/360000.0
	cpuunits=cents(cpuhr*cpurate)
	totalunits=conunits+cpuunits
c
c Use ASCTIM to format elapsed times for output;
c EMUL converts CPU time to system format.
c TIMEDIF and CPUTIME are negative (so represent delta-time)
c
	call check(lib$emul(icpu,-100000,0,cputime))
	call check(lib$sys_asctim(,conasc,timedif,1))
	call check(lib$sys_asctim(,cpuasc,cputime,1))
	type 100,conasc,conunits,cpuasc,cpuunits,totalunits
100	format(1x,a8,' connect',-2pf6.2,' units',
	1 3x,a8,' CPU',f6.2,' units',
	1 f6.2,' total units')
	return
	end
	function jpival(jpicode)
c
c Returns a single JPI value.
c Works for any code for which the value returned
c	is a single longword.
c
c Calling program should
c	include '($jpidef)'
c
	call jpi(jpicode,jpival,4)
	return
	end
	subroutine jpi(jpicode,buffer,buflen)
c
c Gets a single piece of JPI information.
c
	implicit integer*4(a-z)
	dimension list(4)
	call mvbits(buflen,0,16,list(1),0)
	call mvbits(jpicode,0,16,list(1),16)
	list(2)=%loc(buffer)
	list(3)=%loc(lenout)
	list(4)=0
	call check(sys$getjpi(,,,list,,,))
	return
	end
	character*(*) function jpistr(jpicode)
c
c Returns a single piece of JPI information.
c Works for those JPI codes that return strings.
c
	dimension list(4)
	maxlen=len(jpistr)
	call mvbits(maxlen,0,16,list(1),0)
	call mvbits(jpicode,0,16,list(1),16)
	list(2)=%loc(jpistr)
	list(3)=%loc(length)
	list(4)=0
	call check(sys$getjpi(,,,list,,,))
c	type *,length,jpistr
	return
	end
	subroutine check(stat)
c
c "stat" is an integer*4 VAX-11 procedure status word
c	such as those returned by LIB$ and SYS$ procedures
c	when called as FORTRAN functions.
c
c stat=sys$xxx(arg1, . . .)
c call check(stat)
c
c	or
c call check(sys$xxx(arg1 . . . ))
c
c checks status for success and aborts program with lib$stop
c	(issuing full error message) on failure
c
	implicit integer*4(a-z)
	if(.not.stat)call lib$stop(%val(stat))
	return
	end
	subroutine keywait(i)
c
c Call keystroke(-1,char) to initialize "keystroke"
c
	common /keywait/iwait,ichan
	iwait=i
	call check(sys$assign('sys$command',ichan,,))
	return
	end
	subroutine keystroke(c)	
c
c Waits up to IWAIT seconds, returns char(0) if no character
c 	received
c
	implicit integer*4 (a-z)
	include '($iodef)'
	include '($ssdef)'
	character c
	logical*1 key(80)
	integer*2 iosb(4)
	common /keywait/iwait,ichan
100	continue
	istat=sys$qiow(,%val(ichan),
	2	%val(	io$_readvblk
	3	.or.	io$m_timed
	4	.or.	io$m_purge
	5	.or.	io$m_cvtlow
	8	),iosb,,,
	9	key,%val(80),%val(iwait),,,)
c
	if (iosb(1) .eq. ss$_timeout) then
		c=char(0)
	else
		c=char(key(1))
	end if
	return
	end
