C
C	This is a subroutine to get a unique Username for a
C	given class and name.  This uses an array of names and
C	a pointer into that stack to store redundant names.
C

	Subroutine GetUser(ptrInStack,NameStack,class,name)

	Parameter	Rec_len=184
	Parameter	screen=1
	Parameter	Uaf=5            

	Character*1	Record(Rec_len)
	Character*30	name
	Character*12	class
	Character*12	Username
	Character*12	OldUsername
	Character*12	NameStack(1000)
	Integer*2	ptrInstack
	Integer*2	IO_err
	Integer*2	extension
	Integer*2	j
	Integer*2	length

	extension=1

	call str$upcase (name,name)
	call str$upcase (class,class)

C	Get to the actual characters
	length=LEN(class)
	Do while (class(length:length) .eq. ' ')
		length=length-1
	end do

C	Build the user name and check it to see if it is in the Uaf
	Username='            '
	j=1
	if (length .gt. len(Username)) length=len(Username)
	Username(1:length)=class(1:length)
	length=length+1
	Do while ((length .le. len (Username)).AND.(name(j:j) .ne. ' '))
		Username(length:length)=name(j:j)
		j=j+1
		length=length+1
	end do

	Open(	unit=Uaf, File='sys$system:sysuaf.dat', readonly,
     +		status='old', shared, organization='indexed',
     +		access='keyed', recordtype='variable',
     +		form='unformatted')

50	Read(Uaf, key=Username, IOstat=IO_err) Record

C	Check to see if the prof account exists
	if (IO_err .eq. 36) goto 500	! Good name from UAF but check NameStack
	if (IO_err .gt. 0) then		! There was an error in accessing 
		close (Uaf)		! the Uaf
		write (screen,100)	
100		format (1x,'%%%%% Problem with the UAF access !!!')
		call exit(IO_err)
	end if

C	Change the User name so that it is unique
	OldUsername=Username
200	length=len(Username)
	Do while ((Username(length:length) .eq. ' ') .OR. 
     +		  (Username(length:length) .le. '9' .AND.
     +		   Username(length:length) .ge. '0'))
		length=length-1
	end do
C	Check for offset adjustment
	if (length .lt. len(Username)) length=length+1
	if (extension .ge. 10) then
		if (length .ge. len(Username)) length=length-1
		write (unit=Username(length:length+1),
     +		       fmt='(1I2)') extension
		else
		write (unit=Username(length:length),
     +		       fmt='(1I1)') extension
	end if
	extension=extension+1
	write (screen,201) OldUsername,Username
201	format (' %%%%% Warning ',1A12,' is NOT unique changing name to',
     +		1x,1A12)
	goto 50

C	Check the NameStack for duplicates
500	if (ptrInStack .le. 0) goto 1000
	Do j=1,ptrInStack
		if (Username .eq. NameStack(j)) goto 200
	end do

C	No account therefore it is unique.    Goood!!!!!
1000	close (Uaf)

C	Add the unique account to the username stack
	NameStack(ptrInStack+1)=Username

C	All done
	End
