*CMZU:          30/03/2000  10.05.36  by  Thomas Naumann
*-- Author :   Thomas Naumann   03/12/99

      SUBROUTINE BSTMAPU (IH,IU,IP,IZ,U,Z,CH,ASY)

**********************************************************************
*     BST u mapping function
**********************************************************************
*
*     INPUT:  IH    packed BST u strip channel nr from BRUE bank
*
*     OUTPUT: U,Z   u and z of hit
*             IU    u  strip number   0-639
*             IP  phi 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      ZN(0:7) , UALI(0:7,0:15)

      LOGICAL   FIRST , BTEST
      DATA      FIRST /.TRUE./
      SAVE

* get BST geometry
      IF (BEGRUN.OR.FIRST) THEN
        FIRST=.FALSE.

*   MC UGTRUN
        IDTYPE = JRDATA('RUNTYPE',IRET)
        IF (IRET.EQ.0.AND.IDTYPE.EQ.1) THEN
          LCONFG = JRDATA('VERSION',IRET) - 1
          IF (IRET.EQ.0) THEN
*   BST1 1997
            IF     (LCONFG.LE.4) THEN
              IND = NDB('DBPAR =GET "BGAS" DP0 VLE 210000')
*   BST2 1998-2000
            ELSEIF (LCONFG.LE.9) THEN
              IND = NDB('DBPAR =GET "BGAS" DP0 VLE 300000')
*   BST3 2000
            ELSE
              IND = NDB('DBPAR =GET "BGAS" DP0 VMX 999999')
            ENDIF
          ENDIF
        ENDIF

        IND = IABS(NDB('BGAS'))
        IF (IND.EQ.0) THEN
          CALL ERRLOG (1,'F: BSTMAPU No BGAS bank')
        ELSE
          NSEC  = IW(IND+4)
          NZ    = IW(IND+12)
*   BST1,3   4,5 planes
          IF (NZ.LT.8) THEN
            DO 1 I=0,3
1           ZN(I) = RW(IND+19) + RW(IND+13+I)
            DO 7 I=4,NZ-1
7           ZN(I) = RW(IND+19) + RW(IND+26+I)
*   BST2     8 planes
          ELSE
            DO 2 I=0,3
2           ZN(I) = RW(IND+19) + RW(IND+30+I)
            DO 3 I=4,NZ-1
3           ZN(I) = RW(IND+19) + RW(IND+ 9+I)
          ENDIF
          UMIN  = RW(IND+29)
          STAG  = RW(IND+22)
          NSTU  = IW(IND+24)
          PITCH = RW(IND+27)
          DIVI  = PITCH/FLOAT(IW(IND+28))
        ENDIF

* alignment
        CALL UGTBNK ('BSTU',IND)
        IF (IND.EQ.0) THEN
          CALL ERRLOG (31,'W: BSTMAPU No BSTU bank')
          DO 4 J=0,NSEC-1
          DO 4 I=0,NZ-1
4         UALI(I,J) = 0.
        ELSE
          IND = IND+6
          A0=0.
          A1=0.
          A2=0.
          DO 6 J=0,NSEC-1
          DO 6 I=0,NZ-1
          ALI = RW(IND)
          UALI(I,J) = ALI/10000.
          IF (ALI.EQ.0.) GOTO 6
          A0 = A0+1.
          A1 = A1+ALI
          A2 = A2+ALI**2
6         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 '('' BST u alignment '',I4,'' um'')' ,INT(A2)
          ENDIF
        ENDIF
      ENDIF

* unpack
      IP = IBITS (IH, 0, 4)
      IZ = IBITS (IH, 4, 3)
      IU = IBITS (IH, 7,10)
      IN = IBITS (IH,17, 4)
      IA = IBITS (IH,21, 5)
      IC = IBITS (IH,26, 6)

      IF (IZ.GE.NZ) THEN
        IU=0
        U=0.
        Z=0.
        RETURN
      ENDIF

      Z = ZN(IZ)
      IF (BTEST(IP,0)) Z = Z + STAG

* internal alignment
      U = UMIN + IU*PITCH + IN*DIVI
      U = U + UALI(IZ,IP)

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

      IF (IDB.GT.2) PRINT '(''BSTMAPU RUN EVT'',2I7,'' IP,IZ,IU,IN''
     +  ,2I3,I4,I3,'' S/N'',I3,'' Asy'',F6.3,'' U,Z'',F8.4,F9.4)'
     +  ,NCCRUN,NEVENT,IP,IZ,IU,IN,IC,ASY,U,Z

      RETURN


      ENTRY BSTUMAP (IP,IZ,U,CH,ASY,IU,Z,IH)

**********************************************************************
*     BST u mapping function
**********************************************************************
*
*     INPUT:  IP  phi sector number   0- 15
*             IZ    z   disk number   0-  7
*              U    u coordinate
*             CH    signal/noise
*             ASY   hit asymmetry
*     OUTPUT: IU    u  strip number   0-639
*              Z    z of hit
*             IH    packed BST strip channel nr for BRUE bank
*
**********************************************************************

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

      Z = ZN(IZ)
      IF (BTEST(IP,0)) Z = Z + STAG

* internal alignment
      UB = U - UALI(IZ,IP)
      IU = (UB-UMIN) / PITCH
      IN = (UB-UMIN - IU*PITCH) / DIVI
      IF (IU.LT.0.OR.IU.GE.NSTU)   GOTO 99
* charge + asymmetry
      IC = CH
      IA = ASY*32.

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

      IF (IDB.GT.2) PRINT '(''BSTUMAP RUN EVT'',2I7,'' IP,IZ,U''
     +  ,2I3,F8.4,'' S/N'',I3,'' Asy'',F6.3,'' IU'',I4,'' z'',F8.3)'
     +  ,NCCRUN,NEVENT,IP,IZ,UB,IC,ASY,IU,Z

      END
