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-18386 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACFDF - ROUTINE TO FIND A FREE ACCOUNT ENTRY
C 
C     CALLING SEQUENCE:  CALL ACFDF(IDIRN,IRECN,IOFST,JERR,K) 
C                WHERE
C                        IDIRN = DIRECTORY ENTRY NUMBER OF FREE 
C                                ACCOUNT (RETURNED) 
C                        IRECN = RECORD NBR OF FREE ACCOUNT (RETURNED)
C                        IOFST = 0 IF FREE ACCOUNT STARTS IN 1ST WORD,
C                                64 IF STARTS IN 65TH WORD (RETURNED) 
C                        JERR  = ACERR RETURN WORD
C                        K     = 1 FOR NORMAL REQUEST 
C                        K     = 2 FOR EXTENTION REQUEST
C                                  (STARTS ON SECTOR BOUNDARY)
C 
C     ACERRS:             -201 = NO FREE ACCOUNTS OF THIS SIZE
C                          FMP ACERR (READF)
C 
C 
      SUBROUTINE ACFDF(IDIRN,IRECN,IOFST,JERR,K)
     1 ,92067-16361 REV.1940 781211 
      COMMON /ACOM6 /LOC(6) 
      COMMON /ACOM1/NDCB(272),NBUF(128) 
C 
C 
C     GET RECORD NUMBER OF START OF DIRECTORY 
C     INITIALIZE DIRECTORY ENTRY NBR, INDEX TO DIRECTORY
C 
      IREC=LOC(5) 
      IDIRN=1-K 
  100 I=1 
C 
C     READ THE NEXT RECORD OF DIRECTORY 
C 
      CALL READF(NDCB,JERR,NBUF,128,LEN,IREC) 
      IF(JERR.LT.0)RETURN 
C 
C     CHECK FOR END OF DIRECTORY
C 
  200 IDIRN=IDIRN+K 
  201 IWD1=NBUF(I)
      IF(IWD1.EQ.0) GO TO 500 
C 
C     CHECK IF DIRECTORY ENTRY POINTS TO A FREE ACCOUNT ENTRY (-1)
C     OR TO AN EXTENDED ACCOUNT ENTRY (-2)
C 
      IF(IWD1.GE.0.OR.IWD1.EQ.-2) GO TO 400 
C 
C     FOUND A FREE ACCOUNT
C     RETURN THE ACCOUNT RECORD NUMBER AND OFFSET 
C 
  300 IRECN=LOC(6)+(IDIRN-1)/ 2 
      IOFST=64*MOD(IDIRN-1,2) 
      JERR=0
      RETURN
C 
C     GET THE NEXT DIRECTORY ENTRY
C     IF SEARCHING FOR >64 WORDS, SEARCH ONLY THE ODD-NUMBERED
C     DIRECTORY ENTRIES 
C 
  400 I=I+(K*16)
      IF(I.LT.129) GO TO 200
      IREC=IREC+1 
      GO TO 100 
C 
C     RETURN NO FREE ACCOUNTS OF THIS SIZE
C 
  500 JERR=-201 
      RETURN
      END 
                                                                                                                                                                                            