GEANT321/gtrak/gfinds.F.ori

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 06/07/94  18.26.03  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GFINDS
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Returns the set/volume parameters corresponding to       *
  17 C.    *       the current space point in /GCTRAK/                      *
  18 C.    *       and fill common /GCSETS/                                 *
  19 C.    *                                                                *
  20 C.    *       IHSET  user set identifier                               *
  21 C.    *       IHDET  user detector identifier                          *
  22 C.    *       ISET set number in JSET                                  *
  23 C.    *       IDET   detector number in JS=LQ(JSET-ISET)               *
  24 C.    *       IDTYPE detector type (1,2)                               *
  25 C.    *       NUMBV  detector volume numbers (array of length NVNAME)  *
  26 C.    *       NVNAME number of volume levels                           *
  27 C.    *                                                                *
  28 C.    *    ==>Called by : GTRACK                                       *
  29 C.    *       Author    R.Brun  *********                              *
  30 C.    *       Modified  V.Perev                                        *
  31 C.    *                                                                *
  32 C.    ******************************************************************
  33 C.
  34 #include "geant321/gcbank.inc"
  35 #include "geant321/gcsets.inc"
  36 #include "geant321/gcvolu.inc"
  37 #include "geant321/gctmed.inc"
  38 #if defined(CERNLIB_DEBUG)
  39       INTEGER        LNAM(15), LNUM(15)
  40 #endif
  41       JATTF(JV) = JV + Q(JV+5) + 6
  42 C.
  43 C.    ------------------------------------------------------------------
  44 C.
  45 *
  46 #if defined(CERNLIB_DEBUG)
  47       WRITE(CHMAIL,1000)NLEVEL
  48       CALL GMAIL (0, 0)
  49       DO 5 I    = 1,NLEVEL
  50         WRITE(CHMAIL,1001)NAMES(I),NUMBER(I),LVOLUM(I),LINDEX(I)
  51         CALL GMAIL (0, 0)
  52         WRITE(CHMAIL,1002)(GTRAN(J,I),J = 1,3),(GRMAT(J,I),J=1,10)
  53         CALL GMAIL (0, 0)
  54     5   CONTINUE
  55  1000 FORMAT (' DEBUG : GFINDS =',I3)
  56  1001 FORMAT (5(1X,A4,3I3))
  57  1002 FORMAT (1X,13F9.4)
  58       NLEV = NLEVEL
  59       CALL UCOPY (NAMES (1),LNAM(1),NLEV)
  60       CALL UCOPY (NUMBER(1),LNUM(1),NLEV)
  61       NLEVEL    = 0
  62       CALL GLVOLU (NLEV, LNAM, LNUM, IER)
  63       IF (IER.NE.0)             STOP
  64 #endif
  65 *
  66       IHSET = 0
  67       IHDET = 0
  68       ISET  = 0
  69       IDET  = 0
  70       IDTYPE = 0
  71       NVNAME = 0
  72 *
  73       DO 10 NLEV = NLEVEL,1,-1
  74          JVO = LQ(JVOLUM-LVOLUM(NLEV))
  75          JAT = JATTF(JVO)
  76          IDET = Q(JAT+8)
  77          IF(IDET.NE.0) THEN
  78             NL = NLEV
  79             GO TO 15
  80          ENDIF
  81   10  CONTINUE
  82       GOTO 99
  83   15  ISET   = Q(JAT+7)
  84       IDTYPE = Q(JAT+9)
  85       IHSET  = IQ(JSET+ISET)
  86       JS     = LQ(JSET-ISET)
  87       IHDET  = IQ(JS+IDET)
  88       JD     = LQ(JS-IDET)
  89       NVNAME = IQ(JD+2)
  90       DO 40 I=1,NVNAME
  91             NAME=IQ(JD+2*I+9)
  92             NUMBV(I)=0
  93             DO 30 J=1,NLEVEL
  94                IF(NAMES(J).EQ.NAME)THEN
  95                   NUMBV(I)=NUMBER(J)
  96                   GO TO 40
  97                ENDIF
  98   30        CONTINUE
  99   40  CONTINUE
 100 C
 101    99 END