GEANT321/ggeom/gsnear.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:56  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSNEAR (CHMOTH,IN,NLIST,LIST)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *     Gives an ordered LIST of NLIST daughter volumes to search  *
  17 C.    *     for when leaving the INth daughter of the volume CHMOTH    *
  18 C.    *     (LIST(1) = 0 means back in mother at exit of INth content) *
  19 C.    *                                                                *
  20 C.    *     If IN = -1, the mother is regarded to have no contents     *
  21 C.    *         contiguous to its boundaries (LIST and NLIST unused)   *
  22 C.    *        (Bit 4 set in CHMOTH volume bank for action in GGCLOS)  *
  23 C.    *                                                                *
  24 C.    *     Default facility :                                         *
  25 C.    *         If IN = 0, for each content in turn, GSNEAR builds a   *
  26 C.    *         LIST  limited to 1 element LIST(1)=0                   *
  27 C.    *                                                                *
  28 C.    *     Called by : 'USER'                                         *
  29 C.    *     Author    : F.Bruyant  *********                           *
  30 C.    *                                                                *
  31 C.    ******************************************************************
  32 C.
  33 #include "geant321/gcbank.inc"
  34 #include "geant321/gcunit.inc"
  35 #include "geant321/gcnum.inc"
  36       CHARACTER*4 CHMOTH
  37       DIMENSION LIST(*)
  38 C.    ------------------------------------------------------------------
  39 *
  40       IVO = 0
  41       IF (JVOLUM.GT.0) CALL GLOOK (CHMOTH, IQ(JVOLUM+1), NVOLUM, IVO)
  42       IF (IVO.EQ.0) THEN
  43          WRITE (CHMAIL, 1001)
  44          CALL GMAIL (0, 0)
  45          GO TO 999
  46       ENDIF
  47 *
  48 * *** Check that volume CHMOTH has contents positioned by GSPOS or
  49 *      GSPOSP, and not ordered by User
  50 *
  51       JVO    = LQ(JVOLUM-IVO)
  52       ISEARC = Q(JVO+1)
  53       NIN    = Q(JVO+3)
  54       IF (NIN.LE.0.OR.ISEARC.GT.0) THEN
  55          WRITE (CHMAIL, 1002)
  56          CALL GMAIL (0, 0)
  57          GO TO 999
  58       ENDIF
  59 *
  60       IF (IN.GT.0) THEN
  61 *
  62 * ***    Lift a JNEAR bank for current content
  63 *
  64          JIN = LQ(JVO-IN)
  65          CALL MZBOOK (IXCONS, JNEAR,JIN,-1,'VONE', 0,0,NLIST+1, 2,0)
  66          IQ(JNEAR-5) = 100*IVO +IN
  67          IQ(JNEAR+1) = NLIST
  68          DO 19 I = 1,NLIST
  69             IQ(JNEAR+I+1) = LIST(I)
  70    19    CONTINUE
  71 *
  72       ELSE IF (IN.EQ.0) THEN
  73 *
  74 * ***    Default option for all contents
  75 *
  76          DO 49 I = 1,NIN
  77             JIN = LQ(JVO-I)
  78             CALL MZBOOK (IXCONS, JNEAR,JIN,-1,'VONE',0,0,2, 2,0)
  79             IQ(JNEAR-5) = 100*IVO+I
  80             JVO = LQ(JVOLUM-IVO)
  81             IQ(JNEAR+1)  = 1
  82    49    CONTINUE
  83 *
  84       ELSE
  85 *
  86          IQ(JVO) = IBSET(IQ(JVO),3)
  87 *
  88       ENDIF
  89 *
  90  1001 FORMAT (' GSNEAR : Volume',A4,' does not exist  *****')
  91  1002 FORMAT (' GSNEAR : Volume',A4,' not a candidate for GSNEAR *****')
  92 *                                                             END GSNEAR
  93   999 END