[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gsnear.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:56  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
*-- Author :
      SUBROUTINE GSNEAR (CHMOTH,IN,NLIST,LIST)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *     Gives an ordered LIST of NLIST daughter volumes to search  *
C.    *     for when leaving the INth daughter of the volume CHMOTH    *
C.    *     (LIST(1) = 0 means back in mother at exit of INth content) *
C.    *                                                                *
C.    *     If IN = -1, the mother is regarded to have no contents     *
C.    *         contiguous to its boundaries (LIST and NLIST unused)   *
C.    *        (Bit 4 set in CHMOTH volume bank for action in GGCLOS)  *
C.    *                                                                *
C.    *     Default facility :                                         *
C.    *         If IN = 0, for each content in turn, GSNEAR builds a   *
C.    *         LIST  limited to 1 element LIST(1)=0                   *
C.    *                                                                *
C.    *     Called by : 'USER'                                         *
C.    *     Author    : F.Bruyant  *********                           *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
      CHARACTER*4 CHMOTH
      DIMENSION LIST(*)
C.    ------------------------------------------------------------------
*
      IVO = 0
      IF (JVOLUM.GT.0) CALL GLOOK (CHMOTH, IQ(JVOLUM+1), NVOLUM, IVO)
      IF (IVO.EQ.0) THEN
         WRITE (CHMAIL, 1001)
         CALL GMAIL (0, 0)
         GO TO 999
      ENDIF
*
* *** Check that volume CHMOTH has contents positioned by GSPOS or
*      GSPOSP, and not ordered by User
*
      JVO    = LQ(JVOLUM-IVO)
      ISEARC = Q(JVO+1)
      NIN    = Q(JVO+3)
      IF (NIN.LE.0.OR.ISEARC.GT.0) THEN
         WRITE (CHMAIL, 1002)
         CALL GMAIL (0, 0)
         GO TO 999
      ENDIF
*
      IF (IN.GT.0) THEN
*
* ***    Lift a JNEAR bank for current content
*
         JIN = LQ(JVO-IN)
         CALL MZBOOK (IXCONS, JNEAR,JIN,-1,'VONE', 0,0,NLIST+1, 2,0)
         IQ(JNEAR-5) = 100*IVO +IN
         IQ(JNEAR+1) = NLIST
         DO 19 I = 1,NLIST
            IQ(JNEAR+I+1) = LIST(I)
   19    CONTINUE
*
      ELSE IF (IN.EQ.0) THEN
*
* ***    Default option for all contents
*
         DO 49 I = 1,NIN
            JIN = LQ(JVO-I)
            CALL MZBOOK (IXCONS, JNEAR,JIN,-1,'VONE',0,0,2, 2,0)
            IQ(JNEAR-5) = 100*IVO+I
            JVO = LQ(JVOLUM-IVO)
            IQ(JNEAR+1)  = 1
   49    CONTINUE
*
      ELSE
*
         IQ(JVO) = IBSET(IQ(JVO),3)
*
      ENDIF
*
 1001 FORMAT (' GSNEAR : Volume',A4,' does not exist  *****')
 1002 FORMAT (' GSNEAR : Volume',A4,' not a candidate for GSNEAR *****')
*                                                             END GSNEAR
  999 END
Commit	Line	Data
fe4da5cc	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