*CMZU:          11/02/2000  11.43.09  by  Thomas Naumann
*-- Author :   Thomas Naumann   29/11/99
      SUBROUTINE FSTMAP (IH,IUV,IX,IP,IZ,X,Z,CH,ASY)

**********************************************************************
*     FST mapping function
**********************************************************************
*
*     INPUT:  IH    packed FST channel nr from FRSE bank
*             IUV   0,1,2   u,v,r detector
*
*     OUTPUT: X       coordinate
*             Z     z coordinate
*             IX    strip number      0-639
*             IP    sector number     0- 15
*             IZ    z disk number     0-7
*             CH    signal/noise
*             ASY   hit asymmetry
*
**********************************************************************

*KEEP,BCS.
      INTEGER      NHROW,NHCOL,NHLEN
      PARAMETER   (NHROW = 2, NHCOL = 1, NHLEN=2)
      INTEGER      NBOSIW
      PARAMETER   (NBOSIW=1000)
      INTEGER      IW(NBOSIW)
      REAL         RW(NBOSIW)
      COMMON /BCS/ IW
      EQUIVALENCE (RW(1),IW(1))
      SAVE   /BCS/
*KEEP,BOSMDL.
C     ------BOSMDL
      LOGICAL       BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
      COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
     +              LCCRUN,NCCRUN,NEVENT,
     +              IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
      SAVE  /BOSMDL/
C     ------
*KEND.

      PARAMETER (SCL=1./32.)
      REAL      DIVI(0:2), XMIN(0:2), PITCH(0:2)
      REAL      ZN(0:6), ALI(0:4,0:11,0:2)

      LOGICAL   BTEST
      DATA      NRUNOLD /-1/
      SAVE

* get FST geometry
      IF (NCCRUN.NE.NRUNOLD) THEN
        NRUNOLD = NCCRUN

        IND = IABS(NDB('FGAS'))
        IF (IND.EQ.0) THEN
          CALL ERRLOG (99,'F: FSTMAP. No FGAS bank')
        ELSE
          NSEC    = IW(IND+ 1)
          XMIN(2) = RW(IND+ 2)
          DZUV    = RW(IND+ 7)
          DZUV    = RW(IND+ 7)
          STAG    = RW(IND+ 8)
          NST     = IW(IND+ 9)
          NDIV    = IW(IND+10)
          PITCH(0)= RW(IND+11)
          PITCH(1)= RW(IND+11)
          XMIN(0) = RW(IND+12)
          XMIN(1) = RW(IND+12)
          NZU     = IW(IND+13)
          PITCH(2)= RW(IND+19)
          NZR     = IW(IND+20)
          DO 1 I=0,NZU-1
1         ZN(I    ) = RW(IND+14+I)
          DO 2 I=0,NZR-1
2         ZN(I+NZU) = RW(IND+21+I)
          DO 4 I=0,2
4         DIVI(I) = PITCH(I)/NDIV
        ENDIF

* alignment
        CALL UGTBNK ('FSTA',IND)
        IF (IND.EQ.0) THEN
          CALL ERRLOG (1,'W: FSTMAP. No FSTA bank')
          DO 3 K=0,2
          DO 3 J=0,NSEC-1
          DO 3 I=0,NZU-1
3         ALI(I,J,K) = 0.
        ELSE
          IND = IND+6
          A0=0.
          A1=0.
          A2=0.
          DO 5 K=0,2
          DO 5 J=0,NSEC-1
          DO 5 I=0,NZU-1
          A = RW(IND)
          ALI(I,J,K) = A/10000.
          IF (A.EQ.0.) GOTO 5
          A0 = A0+1.
          A1 = A1+A
          A2 = A2+A**2
5         IND=IND+1
          IF (A0.GT.0.) THEN
            A1 = A1/A0
            A2 = A2/A0
            A2 = SQRT(A2-A1**2)
          ENDIF
          IF (IDB.GT.1) THEN
            PRINT*,' '
            PRINT '('' FST alignment '',I4,'' um'')' ,INT(A2)
          ENDIF
6         IND=IND+1
        ENDIF
      ENDIF

* unpack
      IP = IBITS (IH, 0, 4)
      IZ = IBITS (IH, 4, 3)
      IX = IBITS (IH, 7,10)
      IN = IBITS (IH,17, 4)
      IA = IBITS (IH,21, 5)
      IC = IBITS (IH,26, 5)
      IUV= IBITS (IH,31, 1)
      IC = ISHFT (IC,1)

      Z = ZN(IZ)
      IF (BTEST(IP,0)) Z = Z + STAG
      IF (IUV.EQ.1)    Z = Z + DZUV
      IF (IZ.GE.NZU) THEN
        IZ = IZ-NZU
        IUV = 2
      ENDIF

* internal alignment
      X = XMIN(IUV) + IX*PITCH(IUV) + IN*DIVI(IUV)
      X = X + ALI(IZ,IP,IUV)

* charge + asymmetry
      CH = IC
      ASY= IA*SCL

      IF (IDB.GT.3) PRINT '(''FSTMAP. RUN EVT'',2I7,'' IUV,IP,IZ,IX''
     +  ,3I3,I4,'' S/N'',I3,'' Asy'',F6.3,'' X,Z'',F8.4,F6.2)'
     +  ,NCCRUN,NEVENT,IUV,IP,IZ,IX,IC,ASY,X,Z

      RETURN


      ENTRY FSTPAM (IUV,IP,IZ,X,CH,ASY,IX,Z,IH)

**********************************************************************
*     FST mapping function
**********************************************************************
*
*     INPUT:  IUV   0,1  u,v detector
*             IP    sector number   0- 15
*             IZ    z disk number     0-4 = u  5-6 = r detectors
*              X    coordinate
*             CH    signal/noise
*             ASY   hit asymmetry
*     OUTPUT: IX    strip number    0-639
*              Z    z of hit
*             IH    packed FST strip channel nr for FRSE bank
*
**********************************************************************

*   bad input
      IF (IZ.LT.0.OR.IZ.GE.NZ.OR.IP.LT.0.OR.IP.GE.NSEC) THEN
99      IX=-1
        Z=0.
        IH=0
        RETURN
      ENDIF

      Z = ZN(IZ)
      IF (BTEST(IP,0)) Z = Z + STAG
      IF (IUV.EQ.1)    Z = Z + DZUV

* internal alignment
        XB = X - ALI(IZ,IP,IUV)
        IX = (XB-XMIN(IUV))   / PITCH(IUV)
        IN = (XB-XMIN(IUV) - IX*PITCH(IUV)) / DIVI(IUV)
      IF (IX.LT.0.OR.IX.GE.NST)   GOTO 99
* charge + asymmetry
      IA = ASY*32.
      IC = CH
      IC = MIN (31,ISHFT(IC,-1))

      IF (IUV.EQ.2) THEN
        IZ = IZ+NZU
        IUV = 0
      ENDIF

* pack hit
      IH = IP+ISHFT(IZ, 4)+ISHFT(IX, 7)+ISHFT(IN,17)
     +       +ISHFT(IA,21)+ISHFT(IC,26)+ISHFT(IUV,31)

      IF (IDB.GT.3) PRINT '(''FSTPAM. RUN EVT'',2I7,'' IUV,IP,IZ,X''
     +  ,3I3,F8.4,'' S/N'',I3,'' Asy'',F6.3,'' IX'',I4,'' z'',F8.3)'
     +  ,NCCRUN,NEVENT,IUV,IP,IZ,XB,IC,ASY,IX,Z

      END
