Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / glsklt.F
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