GEANT321/ggeom/gcent.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:17  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:48  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GCENT(IAX,X0)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C     *       SUBROUTINE TO CENTRE A SLICE OF THE NLEVEL TH            *
  20 C     *       SHAPE, WHEN THE CENTRE OF THE SLICE ALONG AXIS           *
  21 C     *       NUMBER IAX AFTER ROTATION BY MATRIX IROT IS AT           *
  22 C     *       X0(IAX). THE CENTER IN THE UNROTATED FRAME IS            *
  23 C     *       RETURNED.                                                *
  24 C     *                                                                *
  25 C.    *    ==>Called by : GFTRAC, GINVOL, GLVOLU, GMEDIV, GNEXT,       *
  26 C.    *                   GTMEDI, GTNEXT                               *
  27 C.    *         Author  A.McPherson  *********                         *
  28 C.    *                                                                *
  29 C.    ******************************************************************
  30 C.
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/gcvolu.inc"
  33 #include "geant321/gcunit.inc"
  34       DIMENSION X0(3),PAR(100),ATT(20)
  35 C.
  36 C.    ------------------------------------------------------------------
  37 C.
  38 C
  39       IVO=LVOLUM(NLEVEL)
  40       JVO=LQ(JVOLUM-IVO)
  41       ISH=Q(JVO+2)
  42 C
  43       IF(ISH.EQ.4) GO TO 20
  44 C
  45 C          NOT A GENERAL TRAPEZOID.
  46 C
  47       IF(ISH.EQ.10.AND.IAX.NE.1) GO TO 20
  48 C
  49 C         NOT A PARALLELEPIPED WITH NON X AXIS SLICING.
  50 C
  51       DO 10 I=1,3
  52       IF(I.NE.IAX) X0(I)=0.0
  53    10 CONTINUE
  54 C
  55       GO TO 999
  56    20 CONTINUE
  57 C
  58 C
  59       JIN=0
  60       IF(NLEVEL.LE.1) GO TO 30
  61 C
  62       IN   = LINDEX(NLEVEL)
  63       IVOO = LVOLUM(NLEVEL-1)
  64       JVOO = LQ(JVOLUM-IVOO)
  65       IF (Q(JVOO+3).LT.0.) THEN
  66          JIN = LQ(JVOO-1)
  67       ELSE
  68          JIN = LQ(JVOO-IN)
  69       ENDIF
  70 C
  71    30 CONTINUE
  72 C
  73 C
  74       IF (NLEVEL.LT.NLDEV(NLEVEL)) THEN
  75          JPAR = 0
  76       ELSE
  77 *       (case with structure JVOLUM locally developed)
  78          JPAR = LQ(LQ(JVOLUM-LVOLUM(NLDEV(NLEVEL))))
  79          IF (NLEVEL.EQ.NLDEV(NLEVEL)) GO TO 120
  80          DO 110 ILEV = NLDEV(NLEVEL), NLEVEL-1
  81             IF (IQ(JPAR+1).EQ.0) THEN
  82                JPAR = LQ(JPAR-LINDEX(ILEV+1))
  83                IF (JPAR.EQ.0) GO TO 120
  84             ELSE IF (IQ(JPAR-3).GT.1) THEN
  85                JPAR = LQ(JPAR-LINDEX(ILEV+1))
  86             ELSE
  87                JPAR = LQ(JPAR-1)
  88             ENDIF
  89             IF (ILEV.EQ.NLEVEL-1) THEN
  90                JPAR = JPAR + 5
  91                NPAR = IQ(JPAR)
  92                CALL UCOPY (Q(JPAR+1), PAR, NPAR)
  93             ENDIF
  94   110    CONTINUE
  95          GO TO 130
  96       ENDIF
  97 *      (normal case)
  98   120 CONTINUE
  99 *
 100 C
 101       CALL GFIPAR(JVO,JIN,IN,NPAR,NATT,PAR,ATT)
 102 C
 103   130 CONTINUE
 104       IF(ISH.EQ.10) GO TO 40
 105 C
 106 C          A GENERAL TRAPEZOID
 107 C
 108       IF(IAX.NE.3) GO TO 41
 109 C
 110       X0(1)=PAR(2)*X0(IAX)
 111       X0(2)=PAR(3)*X0(IAX)
 112 C
 113       GO TO 999
 114 C
 115    41 IF(IAX.NE.2) GO TO 900
 116 C
 117       X0(1) = X0(IAX)*PAR(7)
 118       GO TO 999
 119 C
 120    40 CONTINUE
 121 C
 122 C          PARALLELEPIPED WITH NON X AXIS SLICING.
 123 C
 124       X0(1)=PAR(IAX+2)*X0(IAX)
 125 C
 126       IF(IAX.EQ.3) GO TO 50
 127 C
 128       X0(3)=0.0
 129 C
 130       GO TO 999
 131    50 CONTINUE
 132 C
 133       X0(2)=PAR(6)*X0(3)
 134 C
 135       GO TO 999
 136 C
 137   900 CONTINUE
 138 C
 139 C          GENERAL TRAPEZOID SLICED OTHER THAN IN Z
 140 C          DOES NOT MAKE SENSE.
 141 C
 142       WRITE(CHMAIL,1000) ISH,IAX
 143       CALL GMAIL(0,0)
 144       WRITE(CHMAIL,2000)
 145       CALL GMAIL(0,0)
 146  1000 FORMAT(' ISH,IAX =',2I5,' DOES NOT MAKE SENSE.')
 147  2000 FORMAT(' IT IS A GENERAL TRAPEZOID SLICED OTHER THAN IN Z')
 148 C
 149 C
 150   999 CONTINUE
 151       END