SUBROUTINE DALADT
C
C
C  COMPONENT:	DALADT -- AUDIT VOLUME ALLOCATION FILE
C
C  DATE:	27-NOV-79
C
C  AUTHOR:	GR JOHNSON
C		BATTELLE NORTHWEST
C		P O BOX 999
C		RICHLAND WA 99352
C
C  SOURCE:	FORTRAN IV-PLUS
C
C  DESCRIPTION:
C
C	ROUTINE "DALADT" MONITORS STORAGE UTILIZATION FOR USER DIRECTORIES
C  ENTERED IN THE VOLUME ALLOCATION FILE (VAF).  VOLUME UTILIZATION IS
C  REPORTED FOR EACH USER DIRECTORY AND ACCOUNTS WITH EXCESSIVE STORAGE ARE
C  LOCKED FROM FURTHER PROCESSING.  PREVIOUSLY LOCKED ACCOUNTS ARE UNLOCKED.
C
C	THE VOLUME TO BE AUDITED IS SPECIFIED BY INITIALIZING VARIABLES
C  "VAFDEV" AND "VAFUNT" IN THE COMMON BLOCK "VAFILE".  A SPECIFIC USER
C  DIRECTORY MAY BE SPECIFIED BY INITIALIZING THE VARIABLE "VAFUIC".
C  IF THE USER DIRECTORY ARGUMENT IS NOT INITIALIZED, STORAGE UTILIZATION
C  WILL BE MONITORED FOR ALL ENTRIES IN THE VOLUME ALLOCATION FILE.
C
C	A "BRIEF" AUDIT REPORT MAY BE GENERATED FOR ALL DIRECTORY ENTRIES
C  BY INITIATING THE ROUTINE VIA THE "DALADB" ENTRY POINT.
C
C	REPORT OUTPUT IS GENERATED ON LOGICAL UNIT 6, WHICH MAY BE ASSIGNED
C  TO AN APPROPRIATE DEVICE AND/OR FILE PRIOR TO CALLING THE ROUTINE.
C
C

C	 G L O B A L   P A R A M E T E R S   A N D   V A R I A B L E S
C
C
C
	INCLUDE 'VAFILE.COM/NOLIST'	! VOLUME ALLOCATION FILE
	INCLUDE 'PDSUPF.COM/NOLIST'	! USER PROFILE/DIRECTORY FILE
C
	INCLUDE 'USNPAR.COM/NOLIST'	! USERNAME AUTHORIZATION
C
C

C	 L O C A L   P A R A M E T E R S   A N D   V A R I A B L E S
C
C
C
	PARAMETER	VAFLUN = 1	! VAFILE LUN
	PARAMETER	UFDLUN = 2	! GETSIZ LUN
	PARAMETER	UPFLUN = 3	! PDSUPF LUN
	PARAMETER	UDFLUN = 4	! PDSUDF LUN
	PARAMETER	TTYLUN = 5	! TERMINAL I/O LUN
	PARAMETER	RPTLUN = 6	! REPORT OUTPUT LUN
C
	PARAMETER	EOS = 0		! END-OF-STRING
C
	LOGICAL	  ALL			! AUDIT ALL UFD'S
	LOGICAL	  BRIEF			! GENERATE BRIEF AUDIT SUMMARY
	LOGICAL	  LOCK			! LOCK USERNAME
	LOGICAL	  UNLOCK		! UNLOCK USERNAME
	LOGICAL	  FOUND			! USERNAME FOUND
	LOGICAL	  CHGABL		! USERNAME CHARGEABLE
C
	INTEGER	  LUNBUF(6)		! GETLUN DIRECTIVE BUFFER
C
	BYTE	  ADEV(4)		! ASCII DEVICE NAME
	BYTE	  AVOL(6)		! ASCII VOLUME NAME
C
	BYTE	  ADAT(9)		! DATE BUFFER
	BYTE	  ATIM(8)		! TIME BUFFER
C
	INTEGER	  DALUIC		! SPECIFIED USER DIRECTORY
C
	INTEGER*4 GETSIZ		! GETSIZ FUNCTION (I*4)
	INTEGER*4 UFDSIZ		! DIRECTORY SIZE (BLOCKS)
C
	INTEGER	  TOTUFD		! TOTAL UFD'S ASSIGNED
	INTEGER*4 TOTFIL		! TOTAL FILES
	INTEGER*4 TOTBLK		! TOTAL BLOCKS
	INTEGER*4 TOTLIM		! TOTAL ALLOCATION LIMIT
	INTEGER	  TOTLOK		! TOTAL UFD'S LOCKED
	INTEGER	  TOTUNL		! TOTAL UFD'S UNLOCKED
C
	EQUIVALENCE (ADEV,LUNBUF)
C
C

C	P R E L I M I N A R Y
C
C
C
C  SET "ALL" FLAG IF SPECIFIC UFD NOT REQUESTED
C
 10	DALUIC=VAFUIC
	ALL=DALUIC.EQ.0
C
C
C
C  "BRIEF" AUDIT ENTRY POINT -- SET FLAG
C
	BRIEF=.FALSE.
	GO TO 1002
C
C
	ENTRY DALADB
	ALL=.TRUE.
	BRIEF=.TRUE.
C
C
 1002	CONTINUE
C
C
C
C  RESET ACCUMMULATED TOTALS
C
	TOTUFD=0
	TOTFIL=0
	TOTBLK=0
	TOTLIM=0
	TOTLOK=0
	TOTUNL=0
C
C
C
C  ASSIGN LOGICAL UNITS
C
	CALL ASNLUN(VAFLUN,VAFDEV,VAFUNT)
	CALL ASNLUN(UFDLUN,VAFDEV,VAFUNT)
C
C
C
C  FETCH DEVICE PARAMETERS -- ENCODE ASCII DEVICE NAME
C
	CALL GETLUN(VAFLUN,LUNBUF)
C
	ADEV(3)=ADEV(3)+"060
	ADEV(4)=':'
C
C
C
C  FETCH VOLUME NAME
C
C**
C**
C
C
C
C  OUTPUT REPORT HEADER
C
	CALL DAYTIM(ADAT,IDOW,ATIM)
C
	WRITE(RPTLUN,1004) ADEV,AVOL,ATIM,ADAT
 1004	FORMAT(/' Volume allocation audit ',4A1,6A1,2X,8A1,1X,9A1/)
C
C

C	A U D I T   U S E R   D I R E C T O R Y   A L L O C A T I O N
C
C
C
C  OPEN VOLUME ALLOCATION FILE
C
 20	CALL NOLOCK(VAFLUN)
C
 2002	OPEN(UNIT=VAFLUN,NAME=VAFFIL,TYPE='OLD',ACCESS='DIRECT',
	2    RECORDSIZE=2,ERR=2004)
	READ(VAFLUN'1,ERR=90200) VAFDEF
	GO TO 2006
C
 2004	CALL ERRSNS(ISW,IFCS)
	IF(ISW.EQ.29) GO TO 90000
	IF(ISW.NE.30) GO TO 90100
	IF(IFCS.NE.-27.AND.IFCS.NE.-29) GO TO 90100
	CALL WAIT(1,2,ISW)
	GO TO 2002
C
C
C
C  REPORT VOLUME DEFAULT ALLOCATION -- (IF REQUESTED)
C
 2006	IF(.NOT.ALL) GO TO 2012
C
	IF(DEFLIM.LT.0) WRITE(RPTLUN,2008)
 2008	FORMAT(' [DEFAULT]'/)
C
	IF(DEFLIM.GE.0) WRITE(RPTLUN,2010) DEFLIM
 2010	FORMAT(' [DEFAULT]',12X,I11,'.'/)
C
C
C
C  SCAN VOLUME ALLOCATION FILE
C
 2012	DO 2018 VAFPNT=VAFFAR,VAFLAR
	READ(VAFLUN'VAFPNT,ERR=90200) VAFREC
C
	IF(VAFUIC.EQ.0) GO TO 2018
C
C
C
C  TEST FOR SPECIFIED UFD -- (IF REQUESTED)
C
	IF((.NOT.ALL).AND.(VAFUIC.NE.DALUIC)) GO TO 2018
C
C
C
C  FETCH DIRECTORY ALLOCATION FOR UFD
C
	CALL CVTUIC(VAFUFD,VAFUIC,1,ISW)
	IF(ISW.LT.0) GO TO 90400
C
	UFDSIZ=GETSIZ(UFDLUN,VAFUFD,ISW)
	IF(ISW.EQ.-26) GO TO 4024
	IF(ISW.LT.0)   GO TO 90500
C
C
C
C  ACCUMMULATE TOTALS
C
	TOTUFD=TOTUFD+1
C
	TOTFIL=TOTFIL+ISW
	TOTBLK=TOTBLK+UFDSIZ
C
	IF(VAFLIM.GT.0) TOTLIM=TOTLIM+VAFLIM
C
C
C
C  RESET LOCAL FLAGS
C
	LOCK=.FALSE.
	UNLOCK=.FALSE.
C
C
C
C  UPDATE VAF AND USER PROFILE IF ALLOCATION EXCEEDED -- (LOCK DIRECTORY)
C
	IF(VAFLIM.LT.0)	     GO TO 2014
	IF(UFDSIZ.LE.VAFLIM) GO TO 2014
C
	LOCK=.TRUE.
	TOTLOK=TOTLOK+1
C
	VAFISW=VAFLOK
C
	WRITE(VAFLUN'VAFPNT,ERR=90300) VAFREC
	GO TO 30
C
C
C
C  UPDATE VAF AND USER PROFILE IF ALLOCATION NOT-EXCEEDED -- (UNLOCK DIRECTORY)
C
 2014	IF(VAFISW.NE.VAFLOK) GO TO 40
C
	UNLOCK=.TRUE.
	TOTUNL=TOTUNL+1
C
	VAFISW=VAFUNL
C
	WRITE(VAFLUN'VAFPNT,ERR=90300) VAFREC
C
	GO TO 30
C
C
C
C  CONTINUE TO SCAN VOLUME ALLOCATION FILE
C
 2016	IF(.NOT.ALL) GO TO 2020
C
 2018	CONTINUE
C
C
C
C  CLOSE FILES
C
 2020	CLOSE(UNIT=VAFLUN)
C
C
C
C  OUTPUT VAF AUDIT SUMMARY (IF NECCESSARY) AND RETURN
C
	IF(ALL) GO TO 2024
C
	IF(TOTUFD.EQ.0) WRITE(TTYLUN,2022)
 2022	FORMAT(' Specified UFD not found'/)
	CLOSE(UNIT=RPTLUN,DISPOSE='DELETE')
	RETURN
C
 2024	IF(BRIEF) RETURN
C
C
	IF(TOTUFD.NE.0) WRITE(RPTLUN,2026) TOTUFD,TOTBLK
 2026	FORMAT(' ---------   ---------'/I9,'.',I11,'.'//)
C
C
	RETURN
C
C

C	U P D A T E   U S E R   P R O F I L E   F I L E
C
C
C
C  OPEN USER PROFILE FILE -- FETCH DEFAULT PROFILE RECORD
C
 30	CALL NOLOCK(UPFLUN)
C
 3002	OPEN(UNIT=UPFLUN,NAME=UPFFIL,TYPE='OLD',ACCESS='DIRECT',
	2    RECORDSIZE=16,ERR=3004)
	READ(UPFLUN'1,ERR=90700) UPFDEF
	GO TO 3006
C
 3004	CALL ERRSNS(ISW,IFCS)
	IF(ISW.NE.30) GO TO 90600
	IF(IFCS.NE.-27.AND.IFCS.NE.-29) GO TO 90600
	CALL WAIT(1,2,ISW)
	GO TO 3002
C
C
C
C  OPEN USER DIRECTORY FILE -- (IF UDF IS "TRUE")
C
 3006	IF(.NOT.UDF) GO TO 3012
C
	CALL NOLOCK(UDFLUN)
C
 3008	OPEN(UNIT=UDFLUN,NAME=UDFFIL,TYPE='OLD',ACCESS='DIRECT',
	2    RECORDSIZE=16,ERR=3010)
	READ(UDFLUN'1,ERR=91000) UDFDEF
	GO TO 3012
C
 3010	CALL ERRSNS(ISW,IFCS)
	IF(ISW.NE.30) GO TO 90900
	IF(IFCS.NE.-27.AND.IFCS.NE.-29) GO TO 90900
	CALL WAIT(1,2,ISW)
	GO TO 3008
C
C
C
C  SCAN USER PROFILE FILE
C
 3012	FOUND=.FALSE.
C
	DO 3036 UPFPNT=UPFFPR,UPFLPR
	READ(UPFLUN'UPFPNT,ERR=90700) UPFREC
C
C
C
C  TEST USER-ID
C
	IF(UPFUIC.NE.VAFUIC) GO TO 3036
C
	IF(FOUND) GO TO 3020
C
	FOUND=.TRUE.
C
	USRUSN(1)=UPFUSN(1)
	USRUSN(2)=UPFUSN(2)
	USRUSN(3)=UPFUSN(3)
	USRUSN(4)=UPFUSN(4)
C
C
C
C  CONVERT USERNAME TO ASCII
C
	CALL R50ASC(12,USRUSN,USRNAM)
C
	DO 3014 IPNT=1,12
	IF(USRNAM(IPNT).EQ.' ') USRNAM(IPNT)=EOS
 3014	CONTINUE
C
C
C
C  VALIDATE USERNAME -- (CLEAR SUFFIX IF "CHARGEABLE")
C
	CHGABL=.FALSE.
C
	DO 3016 IPNT=1,4
	IF(USRNAM(IPNT).LT.'A') GO TO 3020
	IF(USRNAM(IPNT).GT.'Z') GO TO 3020
 3016	CONTINUE
C
	IF(USRNAM(IPNT).EQ.EOS) GO TO 3020
C
	DO 3018 IPNT=6,9
	IF(USRNAM(IPNT).LT.'0') GO TO 3020
	IF(USRNAM(IPNT).GT.'9') GO TO 3020
 3018	CONTINUE
C
	CHGABL=.TRUE.
C
	USRNAM(10)=EOS
	USRNAM(11)=EOS
	USRNAM(12)=EOS
C
	USRUSN(4)=0
C
C
C
C  TEST USERNAME SUFFIX --  (IF "CHARGEABLE")
C
 3020	JSUF=1
C
	IF(.NOT.CHGABL) GO TO 3024
C
	DO 3022 JSUF=1,NSUF
	IF(UPFSUF.EQ.USNSUF(JSUF)) GO TO 3024
 3022	CONTINUE
	GO TO 91100
C
C
C
C  FETCH DEFAULT PRIVILEGES FROM USER DIRECTORY -- (IF UDF IS "TRUE")
C
 3024	UDFPRI=DEFPRI
	UDFBPR=DEFBPR
C
	IF(UDF) READ(UDFLUN'(UPFPNT-UPFFPR+UDFFDR),ERR=91000) UDFREC
C
C
C
C  MODIFY USERNAME AUTHORIZATION FLAG AND USERNAME PRIVILEGES
C
	IF(LOCK)   GO TO 3026
	IF(UNLOCK) GO TO 3028
	           GO TO 3036
C
C
C >>> LOCK USERNAME
C
 3026	UPFUNA=UPFUNA.OR.UNADAL			! SET DAL BIT
C
	UPFPRI=0
	UPFBPR=0
	GO TO 3034
C
C
C >>> UNLOCK USERNAME 
C
 3028	UPFUNA=UPFUNA.AND.(.NOT.UNADAL)		! CLEAR DAL BIT
C
	IF(UPFUNA.EQ.0)      GO TO 3030
	IF(UPFUNA.EQ.UNANTU) GO TO 3032
	                     GO TO 3034
C
C
C >>> PRIME-TIME PROCESSING
C
 3030	UPFPRI=UDFPRI.AND.USNPRI(JSUF).AND.USNDPR(JSUF)
	UPFBPR=UDFBPR.AND.USNBPR(JSUF).AND.USNDPR(JSUF)
	GO TO 3034
C
C
C >>> OFF-HOUR PROCESSING
C
 3032	UPFPRI=UDFPRI.AND.USNPRI(JSUF).AND.USNNPR(JSUF)
	UPFBPR=UDFBPR.AND.USNBPR(JSUF).AND.USNNPR(JSUF)
C
C
C
C  UPDATE USER PROFILE AND CONTINUE SCAN
C
 3034	WRITE(UPFLUN'UPFPNT,ERR=90800) UPFREC
C
 3036	CONTINUE
C
C
C
C  CLOSE FILES
C
	CLOSE(UNIT=UPFLUN)
	IF(UDF) CLOSE(UNIT=UDFLUN)
C
C

C	O U T P U T   V A F   A U D I T   R E P O R T
C
C
C
 40	IF(LOCK)   GO TO 4006
	IF(UNLOCK) GO TO 4012
	IF(BRIEF)  GO TO 4028
C
C
C >>> FORMAT 1 -- REPORT DIRECTORY ALLOCATION
C
	IF(VAFLIM.LT.0) WRITE(RPTLUN,4002) VAFUFD,UFDSIZ
 4002	FORMAT(1X,10A1,I11,'.')
C
	IF(VAFLIM.GE.0) WRITE(RPTLUN,4004) VAFUFD,UFDSIZ,VAFLIM
 4004	FORMAT(1X,10A1,I11,'.',I11,'.')
C
	GO TO 4028
C
C
C >>> FORMAT 2 -- REPORT DIRECTORY LOCKED
C
 4006	IF(FOUND) WRITE(RPTLUN,4008) VAFUFD,UFDSIZ,VAFLIM,USRNAM
 4008	FORMAT(1X,10A1,I11,'.',I11,'.',7X,'User ',12A1,' locked')
C
	IF(.NOT.FOUND) WRITE(RPTLUN,4010) VAFUFD,UFDSIZ,VAFLIM
 4010	FORMAT(1X,10A1,I11,'.',I11,'.',7X,'UFD locked')
C
	GO TO 4028
C
C
C >>> FORMAT 3A -- REPORT DIRECTORY UNLOCKED (LIMITED STORAGE)
C
 4012	IF(VAFLIM.LT.0) GO TO 4018
C
	IF(FOUND) WRITE(RPTLUN,4014) VAFUFD,UFDSIZ,VAFLIM,USRNAM
 4014	FORMAT(1X,10A1,I11,'.',I11,'.',7X,'User ',12A1,' unlocked')
C
	IF(.NOT.FOUND) WRITE(RPTLUN,4016) VAFUFD,UFDSIZ,VAFLIM
 4016	FORMAT(1X,10A1,I11,'.',I11,'.',7X,'UFD unlocked')
C
	GO TO 4028
C
C
C >>> FORMAT 3B -- REPORT DIRECTORY UNLOCKED (UNLIMITED STORAGE)
C
 4018	IF(FOUND) WRITE(RPTLUN,4020) VAFUFD,UFDSIZ,USRNAM
 4020	FORMAT(1X,10A1,I11,'.',19X,'User ',12A1,' unlocked')
C
	IF(.NOT.FOUND) WRITE(RPTLUN,4022) VAFUFD,UFDSIZ
 4022	FORMAT(1X,10A1,I11,'.',19X,'UFD unlocked')
C
	GO TO 4028
C
C
C >>> FORMAT 4 -- REPORT NO UFD FOUND
C
 4024	WRITE(RPTLUN,4026) VAFUFD,VAFLIM
 4026	FORMAT(1X,10A1,12X,I11,'.',7X,'UFD not found')
C
C
C
C  RETURN TO ALLOCATION AUDIT MAJOR LOOP
C
 4028	GO TO 2016
C
C

C	P R O C E S S   F A T A L   E R R O R S
C
C
C
90000	WRITE(TTYLUN,90001)
90001	FORMAT(' Volume not initialized for directory allocation'/)
	CALL EXIT
C
90100	WRITE(TTYLUN,90101)
90101	FORMAT(' DAL -- VAF open error'/)
	CALL EXIT
C
90200	WRITE(TTYLUN,90201)
90201	FORMAT(' DAL -- VAF read error'/)
	CALL EXIT
C
90300	WRITE(TTYLUN,90301)
90301	FORMAT(' DAL -- VAF write error'/)
	CALL EXIT
C
90400	WRITE(TTYLUN,90401)
90401	FORMAT(' DAL -- Invalid UFD encountered'/)
	CALL EXIT
C
90500	WRITE(TTYLUN,90501)
90501	FORMAT(' DAL -- Fatal directory error'/)
	CALL EXIT
C
90600	WRITE(TTYLUN,90601)
90601	FORMAT(' DAL -- UPF open error'/)
	CALL EXIT
C
90700	WRITE(TTYLUN,90701)
90701	FORMAT(' DAL -- UPF read error'/)
	CALL EXIT
C
90800	WRITE(TTYLUN,90801)
90801	FORMAT(' DAL -- UPF write error'/)
	CALL EXIT
C
90900	WRITE(TTYLUN,90901)
90901	FORMAT(' DAL -- UDF open error'/)
	CALL EXIT
C
91000	WRITE(TTYLUN,91001)
91001	FORMAT(' DAL -- UDF read error'/)
	CALL EXIT
C
91100	WRITE(TTYLUN,91101)
91101	FORMAT(' DAL -- Unknown USN suffix encountered'/)
	CALL EXIT
C
C
	END