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-18406 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACFDA - ROUTINE TO FIND A USER'S OR GROUP'S ACCOUNT LOCATION
C 
C     CALLING SEQUENCE:  CALL ACFDA(IUSER,IGRP,IDIRN,IRECU,IRECG,JERR)
C                WHERE
C                        IUSER = 5-WD BUFFER CONTAINING USER NAME,
C                                PADDED WITH BLANKS 
C                                IF GROUP, IUSER(1)=0 
C                        IGRP  = 5-WD BUFFER CONTAINING GROUP NAME, 
C                                PADDED WITH BLANKS 
C                        IDIRN = DIRECTORY ENTRY NUMBER OF ACCOUNT
C                                (RETURNED) 
C                        IRECU = 2-WD ARRAY, WORD 1 IS RETURNED AS
C                                RECORD NBR OF USER ACCT, 
C                                WORD 2 IS RETURNED AS OFFSET (0 OR 64) 
C                        IRECG = 2-WD ARRAY, WORD 1 IS RETURNED AS
C                                RECORD NBR OF GROUP ACCT,
C                                WORD 2 IS RETURNED AS OFFSET (0 OR 64) 
C                        JERR  = ACERR RETURN WORD
C 
C     ACERRS:             -200 = ACCOUNT NOT FOUND
C                          FMP ACERR (READF)
C 
C 
      SUBROUTINE ACFDA(IUSER,IGRP,IDIRN,IRECU,IRECG,JERR) 
     1 ,92067-16361 REV.1940 781024 
      LOGICAL ISRCH 
      DIMENSION IUSER(5),IGRP(5),IRECU(2),IRECG(2)
      COMMON /ACOM6 /LOC(5) 
      COMMON /ACOM1/NDCB(272),NBUF(128) 
      COMMON /ACOMA  /ISRCH,IUR,IU,IGR,IG 
C 
      DATA IAT/2H@  / 
C 
C 
C     GET RECORD NUMBER OF START OF DIRECTORY 
C     INITIALIZE DIRECTORY ENTRY NBR, OFFSET, INDEX TO DIRECTORY
C 
      IRECU(2)=0
      IRECG(2)=0
      IF(ISRCH) GO TO 550 
      IREC=LOC(5) 
      IF(IUSER(1).EQ.0) GO TO 50
      IUR=IREC
      IU=1
      GO TO 100 
   50 IGR=IREC
      IG=1
  100 I=1 
C 
C     READ THE NEXT RECORD OF DIRECTORY 
C 
  150 CALL READF(NDCB,JERR,NBUF,128,LEN,IREC) 
      IF(JERR.LT.0)RETURN 
C 
C     CHECK FOR END OF DIRECTORY
C 
  200 IF(NBUF(I).EQ.0) GO TO 600
C 
C     CHECK IF DIRECTORY ENTRY POINTS TO A FREE ACCOUNT ENTRY (-1)
C     OR TO AN EXTENDED ACCOUNT ENTRY (-2)
C 
      IF(NBUF(I).LT.0) GO TO 500
C 
C     CHECK IF DIRECTORY ENTRY POINTS TO A GROUP ACCOUNT OR USER
C     ACCOUNT. (GROUP IF NUMBER OF CHARACTERS IN USER NAME = 0) 
C 
      IWD1=IAND(NBUF(I),177400B)
      IF((IWD1.EQ.0).AND.(IUSER(1).EQ.0)) GO TO 350 
      IF((IWD1.NE.0).AND.(IUSER(1).NE.0)) GO TO 250 
      GO TO 500 
C 
C     FOUND A USER ACCOUNT.  SEE IF USER NAME MATCHES.
C 
  250 IF(IUSER(1).EQ.IAT.AND.NBUF(I+1).GE.0) GO TO 350
      DO 300 J=1,5
      IF(IUSER(J).NE.NBUF(I+J)) GO TO 500 
  300 CONTINUE
C 
C     SEE IF GROUP NAME MATCHES 
C 
  350 IF(IGRP(1).EQ.IAT) GO TO 410
      DO 400 J=1,5
      IF(IGRP(J).NE.NBUF(I+J+5)) GO TO 500
  400 CONTINUE
C 
C     SAVE USER OR GROUP POSITION 
C 
  410 IF(IUSER(1).EQ.0) GO TO 415 
      IU=I
      IUR=IREC
      GO TO 420 
  415 IG=I
      IGR=IREC
C 
C     PUT USER NAME IN IUSER
C     AND PUT GROUP IN IGRP 
C 
  420 DO 425 J=1,5
      IUSER(J)=NBUF(I+J)
 425  IGRP(J)=NBUF(I+J+5) 
C 
C     FOUND THE MATCHING DIRECTORY ENTRY
C     RETURN THE ACCOUNT RECORD NUMBER AND THE OFFSET 
C     AND COMPUTE DIRECTORY NUMBER
C 
      IDIRN=8*(IREC-LOC(5))+1+((I-1)/16)
      JERR=0
      J=NBUF(I+13)
      IRECG(1)=IAND(J,77777B) 
      IF(J.LT.0) IRECG(2)=64
      J=NBUF(I+14)
      IF(IUSER(1).EQ.0) GO TO 450 
      IRECU(1)=IAND(J,77777B) 
      IF(J.LT.0) IRECU(2)=64
      RETURN
  450 IRECU(1)=J
      RETURN
C 
C     GET THE NEXT DIRECTORY ENTRY
C 
  500 I=I+16
      IF(I.LT.129) GO TO 200
      IREC=IREC+1 
      GO TO 100 
C 
C     RESTORE USER OR GROUP POSITION
C 
  550 I=IG
      IREC=IGR
      IF(IUSER(1).EQ.0) GO TO 575 
      I=IU
      IREC=IUR
C 
C     REREAD TO GET NEXT DIRECTORY ENTRY
C 
  575 I=I+16
      IF(I.LT.129) GO TO 150
      IREC=IREC+1 
      GO TO 100 
C 
C     RETURN ACCOUNT NOT FOUND
C 
  600 JERR=-200 
      RETURN
      END 
                