[u/mrichter/AliRoot.git] / GEANT321 / gtrak / glsklt.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:41  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
*-- Author :
      SUBROUTINE GLSKLT
C.
C.    ******************************************************************
C.    *                                                                *
C.    *    SUBR. GLSKLT                                                *
C.    *                                                                *
C.    *   Prepares the Skeleton banks for parallel tracking            *
C.    *   Also lifts the stack bank JTRACK                             *
C.    *                                                                *
C.    *   Called by : GTREVE                                           *
C.    *   Authors   : S.Banerjee, F.Bruyant                            *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcstak.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcvolu.inc"
C.
      COMMON /GCSKLT/ LOCAL(2), JSK, JSKL, JVOLX
      CHARACTER*12    CFORM
C.
C.    ------------------------------------------------------------------
*
      IF (JSKLT.EQ.0) THEN
*
*  **    Initialize a temporary link area
*
         CALL MZLINT (IXSTOR, '/GCSKLT/', LOCAL, JSK, JVOLX)
         CALL MZFORM ('SKIN', '2I -F', IOSKIN)
         JVOLX = LQ(JVOLUM)
         NLVT  = IQ(JVOLX-1)
*
*  **    Lift the top level bank
*
         CALL MZBOOK (IXCONS, JSKLT, JSKLT, 1, 'SKLT', NLVT, NLVT, 0,
     +                2, 0)
         CALL MZBOOK (IXCONS, JSKL, JSKLT, -1, 'SKLV', 1, 1, 1, 2, 0)
         CALL MZBOOK (IXCONS, JSK, JSKL, -1, 'SKIN', 1, 0, 2, 2, -1)
         JVO  = LQ(JVOLUM-1)
         LQ(JSK-1) = JVO + 6
         IQ(JSK+1) = Q(JVO+5)
         IQ(JSK+2) = 1
*
*  **    Loop over the remaining levels
*
         DO 15 ILEV = 2, NLVT
            NINSK = IQ(JVOLX+ILEV)
            ND    = NINSK + ILEV - 1
            CALL MZBOOK (IXCONS, JSKL, JSKLT,-ILEV,'SKLV', NINSK, NINSK,
     +                   ND, 2, 0)
            DO 10 IN = 1, NINSK
               CALL MZBOOK (IXCONS, JSK, JSKL, -IN, 'SKIN', 1, 0, 15,
     +                      IOSKIN, 1)
   10       CONTINUE
   15    CONTINUE
*
*  **    Now create the Stack bank JTRACK
*
         NWR    = NWTRAC - NWINT
         WRITE (CFORM, 1001) NWINT, NWR
         CALL MZFORM ('TRAC', CFORM, IOTRAC)
         ND     = NWTRAC * NJTMAX
         CALL MZBOOK (IXCONS, JTRACK, JTRACK, 1, 'TRAC', 0, 0, ND,
     +                IOTRAC, -1)
*
         LOCAL(1) = 0
*
      ELSE
*
*  **    Clear the pointers in the skeleton
*
         DO 25 ILEV = 1, NLEVMX
            JSKL = LQ(JSKLT-ILEV)
            DO 20 I = 1, IQ(JSKL-3)
               IQ(JSKL+I) = 0
   20       CONTINUE
   25    CONTINUE
      ENDIF
*
* *** Fill up the skeleton upto NLEVEL
*
      IF (NLEVEL.GT.1) THEN
         DO 60 ILEV = 2, NLEVEL
            JSKL  = LQ(JSKLT-ILEV)
            NINSK = LINMX(ILEV)
            JOFF  = JSKL + IQ(JSKL-3)
            DO 40 IL = 1, ILEV-1
               IF (IQ(JOFF+IL).EQ.LINDEX(IL)) GO TO 40
               DO 30 I = IL, ILEV-1
                  IQ(JOFF+I) = LINDEX(I)
   30          CONTINUE
               DO 35 I = 1, NINSK
                 JSK  = LQ(JSKL-I)
                 IQ(JSK+1) = 0
   35          CONTINUE
               GO TO 45
   40       CONTINUE
   45       JSK  = LQ(JSKL-LINDEX(ILEV))
            IF (IQ(JSK+1).LE.0) THEN
               LQ(JSK-1) = LQ(JGPAR-ILEV)
               IQ(JSK+1) = IQ(JGPAR+ILEV)
               IQ(JSK+2) = LVOLUM(ILEV)
               DO 50 I = 1, 3
                  Q(JSK+2+I) = GTRAN(I,ILEV)
   50          CONTINUE
               DO 55 I = 1, 10
                  Q(JSK+5+I) = GRMAT(I,ILEV)
   55          CONTINUE
            ENDIF
   60    CONTINUE
      ENDIF
*
* *** Initialize pointers
*
      NJFREE = 1
      NJGARB = 0
      NJINVO = 0
      NLDOWN = 1
*
 1001 FORMAT ('/ ',I3,'I ',I3,'F ')
*                                                             END GLSKLT
      END
Commit	Line	Data
fe4da5cc	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 29/03/94 15.41.23 by S.Giani
	11	*-- Author :
	12	SUBROUTINE GLSKLT
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * SUBR. GLSKLT *
	17	C. * *
	18	C. * Prepares the Skeleton banks for parallel tracking *
	19	C. * Also lifts the stack bank JTRACK *
	20	C. * *
	21	C. * Called by : GTREVE *
	22	C. * Authors : S.Banerjee, F.Bruyant *
	23	C. * *
	24	C. ******************************************************************
	25	C.
	26	#include "geant321/gcbank.inc"
	27	#include "geant321/gcstak.inc"
	28	#include "geant321/gctrak.inc"
	29	#include "geant321/gcvolu.inc"
	30	C.
	31	COMMON /GCSKLT/ LOCAL(2), JSK, JSKL, JVOLX
	32	CHARACTER*12 CFORM
	33	C.
	34	C. ------------------------------------------------------------------
	35	*
	36	IF (JSKLT.EQ.0) THEN
	37	*
	38	* ** Initialize a temporary link area
	39	*
	40	CALL MZLINT (IXSTOR, '/GCSKLT/', LOCAL, JSK, JVOLX)
	41	CALL MZFORM ('SKIN', '2I -F', IOSKIN)
	42	JVOLX = LQ(JVOLUM)
	43	NLVT = IQ(JVOLX-1)
	44	*
	45	* ** Lift the top level bank
	46	*
	47	CALL MZBOOK (IXCONS, JSKLT, JSKLT, 1, 'SKLT', NLVT, NLVT, 0,
	48	+ 2, 0)
	49	CALL MZBOOK (IXCONS, JSKL, JSKLT, -1, 'SKLV', 1, 1, 1, 2, 0)
	50	CALL MZBOOK (IXCONS, JSK, JSKL, -1, 'SKIN', 1, 0, 2, 2, -1)
	51	JVO = LQ(JVOLUM-1)
	52	LQ(JSK-1) = JVO + 6
	53	IQ(JSK+1) = Q(JVO+5)
	54	IQ(JSK+2) = 1
	55	*
	56	* ** Loop over the remaining levels
	57	*
	58	DO 15 ILEV = 2, NLVT
	59	NINSK = IQ(JVOLX+ILEV)
	60	ND = NINSK + ILEV - 1
	61	CALL MZBOOK (IXCONS, JSKL, JSKLT,-ILEV,'SKLV', NINSK, NINSK,
	62	+ ND, 2, 0)
	63	DO 10 IN = 1, NINSK
	64	CALL MZBOOK (IXCONS, JSK, JSKL, -IN, 'SKIN', 1, 0, 15,
65	+ IOSKIN, 1)
66	10 CONTINUE
67	15 CONTINUE
68	*
69	* ** Now create the Stack bank JTRACK
70	*
71	NWR = NWTRAC - NWINT
72	WRITE (CFORM, 1001) NWINT, NWR
73	CALL MZFORM ('TRAC', CFORM, IOTRAC)
74	ND = NWTRAC * NJTMAX
75	CALL MZBOOK (IXCONS, JTRACK, JTRACK, 1, 'TRAC', 0, 0, ND,
76	+ IOTRAC, -1)
77	*
78	LOCAL(1) = 0
79	*
80	ELSE
81	*
82	* ** Clear the pointers in the skeleton
83	*
84	DO 25 ILEV = 1, NLEVMX
85	JSKL = LQ(JSKLT-ILEV)
86	DO 20 I = 1, IQ(JSKL-3)
87	IQ(JSKL+I) = 0
88	20 CONTINUE
89	25 CONTINUE
90	ENDIF
91	*
92	* *** Fill up the skeleton upto NLEVEL
93	*
94	IF (NLEVEL.GT.1) THEN
95	DO 60 ILEV = 2, NLEVEL
96	JSKL = LQ(JSKLT-ILEV)
97	NINSK = LINMX(ILEV)
98	JOFF = JSKL + IQ(JSKL-3)
99	DO 40 IL = 1, ILEV-1
100	IF (IQ(JOFF+IL).EQ.LINDEX(IL)) GO TO 40
101	DO 30 I = IL, ILEV-1
102	IQ(JOFF+I) = LINDEX(I)
103	30 CONTINUE
104	DO 35 I = 1, NINSK
105	JSK = LQ(JSKL-I)
106	IQ(JSK+1) = 0
107	35 CONTINUE
108	GO TO 45
109	40 CONTINUE
110	45 JSK = LQ(JSKL-LINDEX(ILEV))
111	IF (IQ(JSK+1).LE.0) THEN
112	LQ(JSK-1) = LQ(JGPAR-ILEV)
113	IQ(JSK+1) = IQ(JGPAR+ILEV)
114	IQ(JSK+2) = LVOLUM(ILEV)
115	DO 50 I = 1, 3
116	Q(JSK+2+I) = GTRAN(I,ILEV)
117	50 CONTINUE
118	DO 55 I = 1, 10
119	Q(JSK+5+I) = GRMAT(I,ILEV)
120	55 CONTINUE
121	ENDIF
122	60 CONTINUE
123	ENDIF
124	*
125	* *** Initialize pointers
126	*
127	NJFREE = 1
128	NJGARB = 0
129	NJINVO = 0
130	NLDOWN = 1
131	*
132	1001 FORMAT ('/ ',I3,'I ',I3,'F ')
133	* END GLSKLT
134	END