GEANT321/gscan/gsscan.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:36  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.31  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSSCAN(ISL,ID)
  13 *
  14 ************************************************************************
  15 *             Enter current point in the LSTEMP/LSCAN structure        *
  16 *                                                                      *
  17 *           Layout of the LSCAN data structure                         *
  18 *           ==================================                         *
  19 *                                                                      *
  20 *                          |                                           *
  21 *                          | LSCAN                                     *
  22 *                          |                                           *
  23 *  -nphi      -iphi    -1  V                                           *
  24 * +-----------+---+--------+----------------------------------------   *
  25 * |           | . |        | (1..5)   nphi,nteta,modtet,nslist,free    *
  26 * |           | . |        | (6..10)  phimin,phimax,tetmin,tetmax      *
  27 * |           | . |        | (11..)   islist                           *
  28 * +-----------+---+--------+----------------------------------------   *
  29 *               |                                                      *
  30 *               | LPHI                                                 *
  31 *               |                                                      *
  32 *               V  nteta                                               *
  33 *               +--------------------------------------------------    *
  34 *               |   IDES  |  List of (W1,W2)  |                        *
  35 *               +--------------------------------------------------    *
  36 *                                                                      *
  37 *                                                                      *
  38 *   where  IDES  [ 1:16] = ISCUR pointer in LPHI to first (W1,W2)      *
  39 *                [17:32] = NW Number of pairs (W1,W2) -1               *
  40 *                                                                      *
  41 *           W1   [ 1:17] = IDET                                        *
  42 *                [18:22] = ISL number in ISLIST-1                      *
  43 *                [23:32] = SABS*FACTL                                  *
  44 *                                                                      *
  45 *           W2   [ 1:17] = RIN*FACTR                                   *
  46 *                [18:32] = SX0*FACTX0                                  *
  47 *                                                                      *
  48 *           SX0          = Sum of rad lengths up to current R boundary *
  49 *                                                                      *
  50 *           SABS         = Sum of abs lengths up to current R boundary *
  51 *                                                                      *
  52 *           RIN          = SQRT(X**2+Y**2+Z**2) at current R boundary  *
  53 *                                                                      *
  54 *           FACTX0       = multiplication factor (default=100)         *
  55 *                                                                      *
  56 *           FACTL        = multiplication factor (default=1000)        *
  57 *                                                                      *
  58 *           FACTR        = multiplication factor (default=100)         *
  59 *                                                                      *
  60 *     Bits are numbered from 1 to 32 and the most significative        *
  61 *     bit is bit number 2 (or 1 for unsigned integers)                 *
  62 *                                                                      *
  63 *                                                                      *
  64 *          ==>Called by : <USER>,GUKINE                                *
  65 *             Author    R.Brun  *********                              *
  66 ************************************************************************
  67 *
  68 #include "geant321/gcbank.inc"
  69 #include "geant321/gcscal.inc"
  70 #include "geant321/gcflag.inc"
  71 #include "geant321/gctrak.inc"
  72 #include "geant321/gcscan.inc"
  73 C.
  74 C.    ------------------------------------------------------------------
  75 C.
  76       ISX0=FACTX0*SX0
  77       ISAB=FACTL*SABS
  78       IRIN=FACTR*SLENG
  79       IF(IRIN.LE.0)GO TO 999
  80       IDES=IQ(LSTEMP+ITETA)
  81       IF(IDES.EQ.0)THEN
  82          IQ(LSTEMP+ITETA)=ISCUR
  83          NW=0
  84       ELSE
  85          NW=IBITS(IDES,16,16)+1
  86          IDOLD=IBITS(IQ(LSTEMP+ISCUR-2),0,18)
  87          IF(IDOLD.EQ.ID)GO TO 999
  88          CALL MVBITS(NW,0,16,IQ(LSTEMP+ITETA),16)
  89       ENDIF
  90       IW1=ID
  91       CALL MVBITS(ISL,0,5,IW1,17)
  92       CALL MVBITS(ISAB,0,10,IW1,22)
  93       IW2=IRIN
  94       CALL MVBITS(ISX0,0,15,IW2,17)
  95       IF(ISCUR+5.GT.IQ(LSTEMP-1))THEN
  96          CALL MZPUSH(IXCONS,LSTEMP,0,1000,'I')
  97       ENDIF
  98       IQ(LSTEMP+ISCUR)=IW1
  99       IQ(LSTEMP+ISCUR+1)=IW2
 100       ISCUR=ISCUR+2
 101       IF(IDEBUG.NE.0)THEN
 102          IF(ISWIT(3).GT.ITETA)THEN
 103             NAME=IQ(JVOLUM+1)
 104             IF(ISL.NE.0)NAME=ISLIST(ISL)
 105             IF(NW.EQ.0)PRINT 10000,IPHI,ITETA
 106             PRINT 10100,NW+1,NAME,ID,IRIN,ISX0,ISAB
 107 10000       FORMAT(' IPHI =',I3,' ITETA =',I3,
 108      +             ' NW   NAME      ID      IRIN     ISX0     ISAB')
 109 10100       FORMAT(21X,I3,3X,A4,2X,I6,2X,I8,2X,I7,2X,I7)
 110          ENDIF
 111       ENDIF
 112   999 END