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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:50  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.29  by  S.Giani
*-- Author :
      SUBROUTINE GGVCHK (JVOM, IN, NVAR, LVAR)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *    SUBR. GGVCHK (JVOM, IN, NVAR*, LVAR*)                       *
C.    *                                                                *
C.    *   Checks volume parameters of IN'th content of mother volume   *
C.    *    at address JVOM or, when IN = 0, of mother volume itself.   *
C.    *   Returns NVAR = 0, when no variable parameters                *
C.    *       or  NVAR =-1, when no variable parameters AND not a      *
C.    *        possible source of local development                    *
C.    *       otherwise,                                               *
C.    *        the list LVAR of the NVAR variable parameters positions *
C.    *                                                                *
C.    *   Called by : GGDVLP                                           *
C.    *   Author    : F.Bruyant                                        *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcshno.inc"
C.
      DIMENSION LVAR(*)
      INTEGER   LDP(7,12), NDP(12)
      SAVE LDP,NDP
C.
      DATA NDP/ 3, 4, 5, 7, 3, 3, 5, 5, 4, 3, 2, 2 /
      DATA LDP/ 1, 2, 3, 4*0,  1, 2, 3, 4, 3*0,  1, 2, 3, 4, 5, 2*0,
     +        1, 4, 5, 6, 8, 9, 10,  1, 2, 3, 4*0,  1, 2, 3, 4*0,
     +        1, 2, 3, 4, 5, 2*0,  1, 2, 3, 4, 5, 2*0,  1, 2, 3, 4, 3*0,
     +        1, 2, 3, 4*0,  2, 3, 5*0,  2, 3, 5*0 /
C.
C.    ------------------------------------------------------------------
*
      NVAR = 0
      NSP  = 0
      IF (IN.EQ.0) THEN
         NPAR = Q(JVOM+5)
         IF (NPAR.LE.0) THEN
            NIN = Q(JVOM+3)
            IF (NIN.LT.0) NVAR = -1
            GO TO 999
         ENDIF
         JPAR = JVOM +6
         ISH = Q(JVOM+2)
      ELSE
         JIN  = LQ(JVOM-IN)
         IVO  = Q(JIN+2)
         JVO  = LQ(JVOLUM-IVO)
         NPAR = Q(JVO+5)
         IF (NPAR.GT.0) THEN
            JPAR = JVO +6
         ELSE
            NIN  = Q(JVOM+3)
            IF (NIN.LT.0) THEN
               JPAR = 0
            ELSE
               JPAR = JIN +9
               NIN  = Q(JVO+3)
               IF (NIN.LT.0) THEN
                  NSP = -1
               ELSE
*
                  DO 9 IIN = 1, NIN
                     JJIN = LQ(JVO-IIN)
                     IIVO = Q(JJIN+2)
                     JJVO = LQ(JVOLUM-IIVO)
                     NNPAR= Q(JJVO+5)
                     IF (NNPAR.GT.0) THEN
                        JJPAR= JJVO + 6
                     ELSE
                        NSP=-1
                        GO TO 10
                     ENDIF
*
                     IISH = Q(JJVO+2)
                     NND  = NDP(IISH)
                     IF (IISH.LE.10) THEN
*
*   *                  Volumes other than PGON or PCON
*
                        DO 6 ID = 1,NND
                           IIDP = LDP(ID,IISH)
                           IF (Q(JJPAR+IIDP).LT.0.) THEN
                              NSP = -1
                              GO TO 10
                           ENDIF
    6                   CONTINUE
*
                     ELSE IF (IISH.LE.12) THEN
*
*   *                  PGON and PCON volumes
*
                        IPZ  = 15 -IISH
                        JJPAR = JJPAR +IPZ
                        NNZ   = 2*Q(JJPAR)
                        DO 8 IZ = 1, NNZ
                           DO 7 ID = 1, NND
                              IIDP = LDP(ID,IISH)
                              IF (Q(JJPAR+IIDP).LT.0.) THEN
                                 NSP = -1
                                 GO TO 10
                              ENDIF
    7                      CONTINUE
    8                   CONTINUE
                     ENDIF
    9             CONTINUE
*
               ENDIF
*
            ENDIF
         ENDIF
  10     ISH = Q(JVO+2)
      ENDIF
*        Shape 28 will not be supported in the future
      IF (ISH.EQ.28.OR.ISH.EQ.13.OR.ISH.EQ.NSCTUB.OR.ISH.EQ.14)THEN
         NVAR = 0
         GO TO 999
      ENDIF
*
      ND = NDP(ISH)
*
      IF (JPAR.LE.0) THEN
         IF (ISH.LE.10) THEN
*
*  *       Volumes other PGON or PCON
*
            NVAR = ND
            DO 11 ID = 1, ND
   11       LVAR(ID) = LDP(ID,ISH)
         ELSE IF (ISH.LE.12) THEN
*
*  *       PGON and PCON volumes
*
            IPZ  = 15 - ISH
            NVAR = 6
            DO 12 ID = 1, NVAR
   12       LVAR(ID) = IPZ + ID
         ELSE
*
            GO TO 900
         ENDIF
         GO TO 999
      ENDIF
*
      IF (ISH.LE.10) THEN
*
*   *   Volumes other than PGON or PCON
*
         DO 19 ID = 1,ND
            IDP = LDP(ID,ISH)
            IF (Q(JPAR+IDP).GE.0.) GO TO 19
            NVAR = NVAR +1
            LVAR(NVAR) = IDP
   19    CONTINUE
*
      ELSE IF (ISH.LE.12) THEN
*
*   *   PGON and PCON volumes
*
         IPZ  = 15 -ISH
         JPAR = JPAR +IPZ
         NZ   = 2*Q(JPAR)
         INC  = IPZ
         DO 29 IZ = 1,NZ
            DO 28 ID = 1,ND
               IDP = LDP(ID,ISH)
               IF (Q(JPAR+IDP).GE.0.) GO TO 28
               NVAR = NVAR +1
               LVAR(NVAR) = INC +IDP
   28       CONTINUE
            INC = INC +3
   29    CONTINUE
      ELSE
*
         GO TO 900
      ENDIF
      IF (NVAR.EQ.0) NVAR = NSP
      GO TO 999
*
 900  WRITE (CHMAIL, 1001) ISH
      CALL GMAIL (0, 0)
 1001 FORMAT (' GGVCHK : No code for shape ISH=',I5)
*                                                             END GGVCHK
 999  END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:50 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.29 by S.Giani
	11	*-- Author :
	12	SUBROUTINE GGVCHK (JVOM, IN, NVAR, LVAR)
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * SUBR. GGVCHK (JVOM, IN, NVAR, LVAR) *
	17	C. * *
	18	C. * Checks volume parameters of IN'th content of mother volume *
	19	C. * at address JVOM or, when IN = 0, of mother volume itself. *
	20	C. * Returns NVAR = 0, when no variable parameters *
	21	C. * or NVAR =-1, when no variable parameters AND not a *
	22	C. * possible source of local development *
	23	C. * otherwise, *
	24	C. * the list LVAR of the NVAR variable parameters positions *
	25	C. * *
	26	C. * Called by : GGDVLP *
	27	C. * Author : F.Bruyant *
	28	C. * *
	29	C. ******************************************************************
	30	C.
	31	#include "geant321/gcbank.inc"
	32	#include "geant321/gcunit.inc"
	33	#include "geant321/gcshno.inc"
	34	C.
	35	DIMENSION LVAR(*)
	36	INTEGER LDP(7,12), NDP(12)
	37	SAVE LDP,NDP
	38	C.
	39	DATA NDP/ 3, 4, 5, 7, 3, 3, 5, 5, 4, 3, 2, 2 /
	40	DATA LDP/ 1, 2, 3, 40, 1, 2, 3, 4, 30, 1, 2, 3, 4, 5, 2*0,
	41	+ 1, 4, 5, 6, 8, 9, 10, 1, 2, 3, 40, 1, 2, 3, 40,
	42	+ 1, 2, 3, 4, 5, 20, 1, 2, 3, 4, 5, 20, 1, 2, 3, 4, 3*0,
	43	+ 1, 2, 3, 40, 2, 3, 50, 2, 3, 5*0 /
	44	C.
	45	C. ------------------------------------------------------------------
	46	*
	47	NVAR = 0
	48	NSP = 0
	49	IF (IN.EQ.0) THEN
	50	NPAR = Q(JVOM+5)
	51	IF (NPAR.LE.0) THEN
	52	NIN = Q(JVOM+3)
	53	IF (NIN.LT.0) NVAR = -1
	54	GO TO 999
	55	ENDIF
	56	JPAR = JVOM +6
	57	ISH = Q(JVOM+2)
	58	ELSE
	59	JIN = LQ(JVOM-IN)
	60	IVO = Q(JIN+2)
	61	JVO = LQ(JVOLUM-IVO)
	62	NPAR = Q(JVO+5)
	63	IF (NPAR.GT.0) THEN
	64	JPAR = JVO +6
65	ELSE
66	NIN = Q(JVOM+3)
67	IF (NIN.LT.0) THEN
68	JPAR = 0
69	ELSE
70	JPAR = JIN +9
71	NIN = Q(JVO+3)
72	IF (NIN.LT.0) THEN
73	NSP = -1
74	ELSE
75	*
76	DO 9 IIN = 1, NIN
77	JJIN = LQ(JVO-IIN)
78	IIVO = Q(JJIN+2)
79	JJVO = LQ(JVOLUM-IIVO)
80	NNPAR= Q(JJVO+5)
81	IF (NNPAR.GT.0) THEN
82	JJPAR= JJVO + 6
83	ELSE
84	NSP=-1
85	GO TO 10
86	ENDIF
87	*
88	IISH = Q(JJVO+2)
89	NND = NDP(IISH)
90	IF (IISH.LE.10) THEN
91	*
92	* * Volumes other than PGON or PCON
93	*
94	DO 6 ID = 1,NND
95	IIDP = LDP(ID,IISH)
96	IF (Q(JJPAR+IIDP).LT.0.) THEN
97	NSP = -1
98	GO TO 10
99	ENDIF
100	6 CONTINUE
101	*
102	ELSE IF (IISH.LE.12) THEN
103	*
104	* * PGON and PCON volumes
105	*
106	IPZ = 15 -IISH
107	JJPAR = JJPAR +IPZ
108	NNZ = 2*Q(JJPAR)
109	DO 8 IZ = 1, NNZ
110	DO 7 ID = 1, NND
111	IIDP = LDP(ID,IISH)
112	IF (Q(JJPAR+IIDP).LT.0.) THEN
113	NSP = -1
114	GO TO 10
115	ENDIF
116	7 CONTINUE
117	8 CONTINUE
118	ENDIF
119	9 CONTINUE
120	*
121	ENDIF
122	*
123	ENDIF
124	ENDIF
125	10 ISH = Q(JVO+2)
126	ENDIF
127	* Shape 28 will not be supported in the future
128	IF (ISH.EQ.28.OR.ISH.EQ.13.OR.ISH.EQ.NSCTUB.OR.ISH.EQ.14)THEN
129	NVAR = 0
130	GO TO 999
131	ENDIF
132	*
133	ND = NDP(ISH)
134	*
135	IF (JPAR.LE.0) THEN
136	IF (ISH.LE.10) THEN
137	*
138	* * Volumes other PGON or PCON
139	*
140	NVAR = ND
141	DO 11 ID = 1, ND
142	11 LVAR(ID) = LDP(ID,ISH)
143	ELSE IF (ISH.LE.12) THEN
144	*
145	* * PGON and PCON volumes
146	*
147	IPZ = 15 - ISH
148	NVAR = 6
149	DO 12 ID = 1, NVAR
150	12 LVAR(ID) = IPZ + ID
151	ELSE
152	*
153	GO TO 900
154	ENDIF
155	GO TO 999
156	ENDIF
157	*
158	IF (ISH.LE.10) THEN
159	*
160	* * Volumes other than PGON or PCON
161	*
162	DO 19 ID = 1,ND
163	IDP = LDP(ID,ISH)
164	IF (Q(JPAR+IDP).GE.0.) GO TO 19
165	NVAR = NVAR +1
166	LVAR(NVAR) = IDP
167	19 CONTINUE
168	*
169	ELSE IF (ISH.LE.12) THEN
170	*
171	* * PGON and PCON volumes
172	*
173	IPZ = 15 -ISH
174	JPAR = JPAR +IPZ
175	NZ = 2*Q(JPAR)
176	INC = IPZ
177	DO 29 IZ = 1,NZ
178	DO 28 ID = 1,ND
179	IDP = LDP(ID,ISH)
180	IF (Q(JPAR+IDP).GE.0.) GO TO 28
181	NVAR = NVAR +1
182	LVAR(NVAR) = INC +IDP
183	28 CONTINUE
184	INC = INC +3
185	29 CONTINUE
186	ELSE
187	*
188	GO TO 900
189	ENDIF
190	IF (NVAR.EQ.0) NVAR = NSP
191	GO TO 999
192	*
193	900 WRITE (CHMAIL, 1001) ISH
194	CALL GMAIL (0, 0)
195	1001 FORMAT (' GGVCHK : No code for shape ISH=',I5)
196	* END GGVCHK
197	999 END