FTN4,L
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C     SOURCE PART NUMBER :92067-18390 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACGID - ROUTINE TO GET A FREE USER OR GROUP ID
C 
C     CALLING SEQUENCE:  CALL ACGID(ITYPE,ID,IERR)
C                WHERE
C                        ITYPE =  1 FOR USER ID 
C                              = -1 FOR GROUP ID
C                        ID    =  ID NUMBER (1-4095), RETURNED
C                        IERR  =  ACERR RETURN WORD 
C 
C     ACERRS:              -1  =  INVALID PARAMETER 
C                          -2  =  NO ID AVAILABLE 
C                          FMP ACERR (READF,WRITF)
C 
C 
      SUBROUTINE ACGID(ITYPE,ID,IERR)  ,92067-16361 REV.1940 781024 
      COMMON /ACOM5/LOWUS,IHIGR 
      COMMON /ACOM6 /LOC(6),IRN 
      COMMON /ACOM1/NDCB(272),NBUF(256) 
C 
C     CHECK TYPE PARAMETER
C 
      IF(IABS(ITYPE).NE.1) GO TO 70 
C 
C     READ USER/GROUP ID MAP FROM ACCOUNT FILE
C 
      CALL RNRQ(1,IRN,ISTAT)
      CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(4)) 
      IF(IERR.LT.0) RETURN
C 
C     SEARCH FOR USER OR GROUP ID?
C 
      IF(ITYPE.EQ.1) GO TO 40 
C 
C     SEARCHING FOR GROUP ID.  SCAN ID MAP FROM 0 THROUGH 
C     LOWEST USER ID
C 
      MAPWD=0 
      ID=0
   10 IF(ID.GE.LOWUS) GO TO 80
      MAPWD=MAPWD-ITYPE 
      CALL ACGBT(NBUF(MAPWD),ITYPE,IBIT)
      IF(IBIT.NE.-1) GO TO 20 
      ID=ID+16
      GO TO 10
   20 ID=ID+IBIT
C 
C     UPDATE THE ID MAP 
C 
      CALL WRITF(NDCB,IERR,NBUF,256,LOC(4)) 
      IF(IERR.LT.0) RETURN
C 
C     UPDATE THE "USE" WORD (HIGHEST GROUP ID USED OR LOWEST
C     USER ID USED) 
C 
      IF(ID.LE.IHIGR) RETURN
      IHIGR=ID
      IOFST=24
C 
C     UPDATE THE WORD IN THE ACCOUNT FILE HEADER
C 
   30 CALL READF(NDCB,IERR,NBUF,128,LEN,1)
      NBUF(IOFST)=ID
      CALL WRITF(NDCB,IERR,NBUF,128,1)
   35 CALL RNRQ(4,IRN,ISTAT)
      RETURN
C 
C     SEARCHING FOR USER ID.  SCAN ID MAP FROM 4095 THROUGH 
C     HIGHEST GROUP ID
C 
   40 MAPWD=257 
      ID=4095 
   50 IF(ID.LE.IHIGR) GO TO 80
      MAPWD=MAPWD-ITYPE 
      CALL ACGBT(NBUF(MAPWD),ITYPE,IBIT)
      IF(IBIT.NE.-1) GO TO 60 
      ID=ID-16
      GO TO 50
   60 ID=ID-(15-IBIT) 
C 
C     UPDATE THE ID MAP 
C 
      CALL WRITF(NDCB,IERR,NBUF,256,LOC(4)) 
      IF(IERR.LT.0) RETURN
      IF(ID.GE.LOWUS) RETURN
      LOWUS=ID
      IOFST=23
      GO TO 30
C 
C     ACERR - INVALID PARAMETER 
C 
   70 IERR=-1 
      RETURN
C 
C     ACERR - NO ID AVAILABLE 
C 
   80 IERR=-2 
      GO TO 35
      END 
                                                                  