This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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