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