!
!  NTPREPed on: SUN, OCT  3, 2010,  2:27 PM
!
!RANGE ON
      SUBROUTINE FDTAB02(BEAT,COMMAREA,UNITS,FILEPTRS,RS)
!DEC$ INTEGER:2
!DEC$ REAL:4
      IMPLICIT INTEGER (A-Z)
!DEC$ PACK:2
!DEC$ ATTRIBUTES C,ALIAS : '_FDTAB02' :: FDTAB02
!DEC$ ATTRIBUTES DLLEXPORT :: FDTAB02
!DEC$ ATTRIBUTES REFERENCE :: BEAT
!DEC$ ATTRIBUTES REFERENCE :: COMMAREA
!DEC$ ATTRIBUTES REFERENCE :: UNITS
!DEC$ ATTRIBUTES REFERENCE :: FILEPTRS
!DEC$ ATTRIBUTES REFERENCE :: RS
!
!  'FDTAB02' A SUBROUTINE TO FIND COMMAND AREA AND UNITS
!            BASED ON A GIVEN BEAT.
!
!************************************************************
!  COPYRIGHT 1996 BY PUBLIC SAFETY SYSTEMS, INC.
!************************************************************
!  05/12/86  JOHN D. GOODSPEED / PSSI
!  05/13/86  11:30
!  05/05/92  MAJOR MODS FOR V8.0 - BOTH TABLE01 & TABLE02 ACCESS
!            IS VIA DMI32/DMO32.
!            MAX RDS PER CA INCREASED TO 400.
!            INDICES FOR TABLE01 & TABLE02 ARE STILL COMPRISED
!            OF 16 BIT WORDS ACCEESED AS A CHUNK OF 8 32-BIT WORDS
!  03/25/93  ELK - INCREASE NUMBER OF CA'S -> 32.
!  03/30/93  ELK - FIX PROB WHEN BEAT NOT FOUND AND 48 BEATS LOADED.
!  05/25/93  EWT - SEARCH FOR ALL BEATS ASSOCIATED WITH SUPPLIED UNIT
!  07/22/96  RAR - REMOVED PHASE 1 INTRINSICS
!  09/09/96  RAR - REMOVED CCODE CHECK FROM DMI/DMO ROUTINES
!
!  BEAT      := BEAT  << SEARCH BY BEAT >>
!  COMMAREA  := COMMAND AREA
!  UNITS     := THE UNITS ASSIGNED TO A GIVEN BEAT.  THE FIRST 16
!               UNITS ARE PATROL (DEFINED AS TYPE 'PATx') UNITS, THE
!               SECOND 16 UNITS ARE NON-PATROL (CATS & DOGS).
!               EACH UNIT-ID IS 6 BYTES LONG FOLLOWED BY A ONE BYTE
!               INDICATOR FOR PRIMARY ('P') OR SECONDARY ('S').
!  RS        := ON CALL, INDICATES THE TYPE OF SEARCH
!               0 = SEARCH BY BEAT
!               1 = SEARCH BY UNIT
!               2 = SEQUENTIAL WALKTHRU BY CA+BEAT
!               3 = RETURN ALL BEATS ASSOCIATED WITH UNIT
!  RS        := ON RETURN, ERROR CONDITIONS:
!               0 = BEAT FOUND, COMMAND AREA AND UNITS RETURNED
!               1 = BEAT OR UNIT NOT FOUND
!               6 = 'DMOVIN' FAILURE, BOUNDS CHECK
!               7 = 'DMOVIN' FAILURE, INDEX/NUMBER INVALID
!               60= -60 == THE 'TABLE', 'DSID' AND 'SEGRIN' AT FAULT
!
!     IMPLICIT INTEGER (A-Z)
      INTEGER*2 DUMMY(8)
      INCLUDE 'DMI32.FD'
      INCLUDE 'LOCKRIN.FD'
      INCLUDE 'UNLOCKRIN.FD'
      REAL*8 FILEPTRS(82,2), DSINDEX
      INTEGER*4 UNCONDLOCK, DRS, SEGRIN
      INTEGER*2 BEATCAUL(5520), CASTATL(64)
      INTEGER*2 CASTATI(64)
      INTEGER*4 BEATCAUL32(2760), CASTATL32(32)
      INTEGER*4 NWDS, CURRLOC, CASIZE, CBASADR
      CHARACTER BEAT*4, UNITS*224, CAS(32)*2, CALIST*64, UNITX*6
      CHARACTER COMMAREA*2, SEARCHARG*4, BEATCAUS(49)*230
      EQUIVALENCE (CAS(1), CALIST)
      EQUIVALENCE (BEATCAUL(1), BEATCAUS(1))
      EQUIVALENCE (CASTATL(1), CASTATI(1)), (CASTATL(1), CASTATL32(1))
      EQUIVALENCE (BEATCAUL(1), BEATCAUL32(1))
!
!     MAXBEATCA     = 48
!     ITEMLENGTH    = 115
!     CASIZE        = (MAXBEATCA * ITEMLENGTH) / 2
!  START OF NTPREP VARIABLE INIT
      CHARACTER NTPNULLS*4000
      DO NTPI = 1,4000,1
        NTPNULLS(NTPI:NTPI) = CHAR(0)
      END DO
      BEATCAUS          = NTPNULLS
      CAS               = NTPNULLS
      CASIZE            = 0
      CASTATI           = 0
      CBASADR           = 0
      COUNT             = 0
      COUNTER           = 0
      CURRLOC           = 0
      DSINDEX           = 0
      I                 = 0
      ICA               = 0
      K                 = 0
      KK                = 0
      MAXCA             = 0
      NWDS              = 0
      SEARCHARG         = NTPNULLS
      SEGRIN            = 0
      TABLE02           = 0
      UNCONDLOCK        = 0
      UNITX             = NTPNULLS
!  END OF NTPREP VARIABLE INIT
      CASIZE        = 2760
      MAXCA         = 32
      TABLE02       = 2
      SEGRIN        = TABLE02
      CALIST(1:32)  = "01020304050607080910111213141516"
      CALIST(33:64) = "17181920212223242526272829303132"
!
!  LOCK THE SEGMENT ASSOCIATED RIN, WE DON'T WANT ANY MODS TO
!  THE DSEG WHILE WE ARE READING IT ONTO OUR STACK.
!
!     GOTO 1225
      UNCONDLOCK = 1
      CALL LOCKRIN(SEGRIN,UNCONDLOCK,FILEPTRS,DRS)
      IF (DRS) 1200,1225,1225
 1200 DUMMY = 0
      RS = 60 + TABLE02
      GOTO 9990
 1225 DSINDEX = FILEPTRS(TABLE02,1)
!
!  GET THE STATUS WORDS FOR THIS DATA SEGMENT, THEY CONTAIN THE
!  NUMBER OF LOGICAL RECORDS CONTAINED IN EACH COMMAND AREA.
!
 1300 CURRLOC = 1
      NWDS  = 32
      CALL DMI32(DSINDEX,CURRLOC,NWDS,CASTATL32,DRS)
      IF (DRS) 9950,1400,9960
 1400 DO 1700 ICA=1,MAXCA,1
        IF (RS .NE. 2) GOTO 1425
        IF (CAS(ICA) .NE. COMMAREA) GOTO 1700
 1425   PT = (ICA - 1) * 2 + 1
        COUNT  = CASTATI(PT)
        CBASADR = ((ICA - 1) * CASIZE) + 33
        CALL DMI32(DSINDEX,CBASADR,CASIZE,BEATCAUL32,DRS)
        IF (DRS) 9950,1460,9960
 1460   IF (RS .EQ. 1) GOTO 1650
        IF (RS .EQ. 2) GOTO 1675
        IF (RS .EQ. 3) GOTO 4000
!
!  FIND THE BEAT, RETURN THE ASSOCIATED COMMAND AREA AND UNITS.
!
        SEARCHARG(1:4) = BEAT
!       DISPLAY "FIND THE BEAT; SEARCHARG, COUNT :=",SEARCHARG,COUNT
        DO 1625 I=1,COUNT,1
          IF (BEATCAUS(I)(1:4) .EQ. SEARCHARG) GOTO 1750
 1625   CONTINUE
!
!  BEAT NOT FOUND IN THIS CA, TRY NEXT CA.
!
        GOTO 1700
!
!  PERFORM A SEARCH BY PRIMARY UNIT, RETURN BACKUP UNITS.
!  CHECK BOTH PATROL AND NON-PATROL.
!
 1650   DO 1665 I=1,COUNT,1
          IF (BEATCAUS(I)(7:12) .EQ. UNITS(1:6)) GOTO 1750
          IF (BEATCAUS(I)(119:125) .EQ. UNITS(1:6)) GOTO 1750
 1665   CONTINUE
        GOTO 1700
!
!  PERFORM A SEQUENTIAL WALKTHRU OF THE GIVEN COMMAND AREA.
!  RETURN EACH BEAT AND ASSOCIATED UNITS (BOTH PATROL AND NON PATROL)
!  IN BEAT ALPHABETICAL ORDER.  ON FIRST CALL THE COMMAND AREA IS
!  SET AS DESIRED WITH THE BEAT SET TO BLANKS, SUBSEQUENT CALLS ARE
!  MADE WITH THE BEAT RETURNED IN THE PREVIOUS CALL.
!
 1675 DO 1680 I=1,COUNT,1
        IF (RS .EQ. 2) THEN
!C        PRINT *,"BEATCAUS(I)(1:4),BEAT: ",BEATCAUS(I)(1:4)," ",BEAT
        ENDIF
        IF (BEATCAUS(I)(1:4) .GT. BEAT) GOTO 1750
 1680 CONTINUE
      RS = 1
      GOTO 9980
!
!  PRIMARY UNIT NOT FOUND IN THIS CA, TRY NEXT CA.
!
 1700 CONTINUE
      RS = 1
      BEATCAUS(I) = " "
      GOTO 1855
 1750 RS = 0
 1855 COMMAREA = BEATCAUS(I)(5:6)
      BEAT     = BEATCAUS(I)(1:4)
      UNITS(1:224) = BEATCAUS(I)(7:230)
!C    PRINT *,"***FDTAB02: UNITS=",UNITS(1:224)
      GOTO 9980
!
!  FIND ALL BEATS ASSOCIATED WITH UNIT CONTAINED IN FIRST
!  SIX CHARACTERS OF 'UNITS' ARRAY. RETURN BEATS IN 'UNITS' ARRAY.
!  WE WILL RETURN UP TO 42 BEATS PER UNIT.
!
 4000 UNITX = UNITS(1:6)
      UNITS(1:224) = " "
!C    PRINT *, "FDTAB02: SEARCHING FOR ", UNITX, " BEATS"
      COUNTER = 1
      DO 4180 ICA=1,MAXCA,1
        PT = (ICA - 1) * 2 + 1
        COUNT  = CASTATI(PT)
        CBASADR = ((ICA - 1) * CASIZE) + 33
        CALL DMI32(DSINDEX,CBASADR,CASIZE,BEATCAUL32,DRS)
        IF (DRS) 9950,4060,9960
!
!  FOR EACH BEAT, FIND OCCURANCE OF 'UNITX'
!
 4060   DO 4125 I=1,COUNT,1
          KK = 7
          DO 4080 K=7,112,7
            IF (BEATCAUS(I)(K:K+5) .EQ. UNITX) THEN
              UNITS(COUNTER:COUNTER+3) = BEATCAUS(I)(1:4)
              COUNTER = COUNTER + 5
              GOTO 4120
            ENDIF
 4080     CONTINUE
          KK = 119
          DO 4100 K=119,224,7
            IF (BEATCAUS(I)(K:K+5) .EQ. UNITX) THEN
              UNITS(COUNTER:COUNTER+3) = BEATCAUS(I)(1:4)
              COUNTER = COUNTER + 5
              GOTO 4120
            ENDIF
 4100     CONTINUE
 4120     IF (COUNTER .GT. 210) GOTO 4190
 4125   CONTINUE
 4180 CONTINUE
 4190 RS = 0
      IF (COUNTER .EQ. 1) RS = 1
      GOTO 9980
 9950 DUMMY = 0
!     DISPLAY "FDTAB02 - 'DMOVIN' ILLEGAL INDEX/NUMBER"
      RS = 7
      GOTO 9980
 9960 DUMMY = 0
!     DISPLAY "FDTAB02 - 'DMOVIN' BOUNDS CHECK."
      RS = 6
      GOTO 9980
!
!  UNLOCK TABLE 2 RIN.
!
 9980 DUMMY = 0
!     GOTO 9990
      CALL UNLOCKRIN(SEGRIN,FILEPTRS,DRS)
      IF (DRS) 9984,9990,9986
 9984 DUMMY = 0
!     DISPLAY "FDTAB02 - 'UNLOCKRIN' SEGRIN NOT ALLOCATED",SEGRIN
      RS = 60 + SEGRIN
      GOTO 9990
 9986 DUMMY = 0
!     DISPLAY "FDTAB02 - 'UNLOCKRIN' SEGRIN NOT LOCKED",SEGRIN
      RS = 60 + SEGRIN
      GOTO 9990
 9990 RETURN
      END