GEANT321/ggeom/gcent.F

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