This commit was generated by cvs2svn to compensate for changes in r2,

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

diff --git a/GEANT321/gtrak/glsklt.F b/GEANT321/gtrak/glsklt.F
new file mode 100644 (file)
index 0000000..95d2dad
--- /dev/null
+++ b/GEANT321/gtrak/glsklt.F
@@ -0,0 +1,134 @@
+*
+* $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