GEANT321/gtrak/gfinds.F

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