GEANT321/ggeom/ggdpar.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:49  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 GGDPAR (JVOM, IN, NVAR, LVAR, LVOM, NPAR, PAR)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    SUBR. GGDPAR (JVOM,IN,NVAR,LVAR,LVOM,NPAR*,PAR*)            *
  17 C.    *                                                                *
  18 C.    *   Computes the actual parameters for the IN'th division of the *
  19 C.    *    mother volume at address JVOM                               *
  20 C.    *   Returns the set of actual parameters in NPAR, PAR            *
  21 C.    *                                                                *
  22 C.    *   Called by : GGDVLP                                           *
  23 C.    *   Author    : S.Banerjee                                       *
  24 C.    *               (Original algorithms of A.McPherson)             *
  25 C.    *                                                                *
  26 C.    ******************************************************************
  27 C.
  28 #include "geant321/gcbank.inc"
  29 #include "geant321/gcflag.inc"
  30 #include "geant321/gcunit.inc"
  31 C.
  32       PARAMETER (NPAMAX=50)
  33 C.
  34       DIMENSION LVAR(*), PAR(*)
  35 C.
  36       REAL      PARM(NPAMAX)
  37       INTEGER   LAX(10,12)
  38       SAVE LAX
  39 C.
  40       DATA      LAX / 1, 2, 3, 7*0, 1, 1, 2, 3, 6*0, 1, 1, 2, 2, 3, 5*0,
  41      +                3, 0, 0, 2, 1, 1, 0, 2, 1, 1, 1, 1, 3, 7*0,
  42      +                1, 1, 3, 2, 2, 5*0, 3, 1, 1, 1, 1, 5*0,
  43      +                3, 1, 1, 1, 1, 2, 2, 3*0, 1, 1, 2, 2, 6*0,
  44      +                1, 2, 3, 7*0, 2, 2, 0, 0, 3, 1, 1, 3, 1, 1,
  45      +                2, 2, 0, 3, 1, 1, 3, 1, 1, 0/
  46 C.
  47 C.    ------------------------------------------------------------------
  48 *
  49 * *** Prepares parameters for mother, in PARM, for division, in PAR
  50 *      and the division parameters
  51 *
  52       JIN = LQ(JVOM-1)
  53       IF (LQ(JVOM).EQ.LVOM) THEN
  54 *
  55 *      Case when current volume is source of local development
  56 *
  57          NPARM = Q(JVOM+5)
  58          CALL UCOPY (Q(JVOM+7), PARM, NPARM)
  59          NDIV  = Q(JIN+3)
  60          ORIG  = Q(JIN+4)
  61          STEP  = Q(JIN+5)
  62       ELSE
  63 *
  64 *      Other cases
  65 *
  66          NPARM = IQ(LVOM+5)
  67          CALL UCOPY (Q(LVOM+6), PARM, NPARM)
  68          NDIV  = IQ(LVOM+1)
  69          ORIG  = Q(LVOM+2)
  70          STEP  = Q(LVOM+3)
  71       ENDIF
  72 *
  73       ISHM  = Q(JVOM+2)
  74 *
  75       ORI   = ORIG + (IN - 1) * STEP
  76       IAXIS = Q(JIN+1)
  77       IVO   = Q(JIN+2)
  78       JVO   = LQ(JVOLUM-IVO)
  79       ISH   = Q(JVO+2)
  80       NPAR  = Q(JVO+5)
  81 *
  82 * *** Prepare the division parameters
  83 *
  84       IF (NPAR.GT.0) THEN
  85          CALL UCOPY (Q(JVO+7), PAR, NPAR)
  86       ELSE
  87          NPAR  = NPARM
  88          CALL UCOPY (PARM, PAR, NPARM)
  89 *
  90 *  **    Special treatment for phi divisions (when NPAR=0)
  91 *
  92          IF ((ISHM.GE.5.AND.ISHM.LE.8.AND.IAXIS.EQ.2) .OR.
  93      +       (ISHM.GE.11.AND.ISHM.LE.12.AND.IAXIS.EQ.2) .OR.
  94      +       (ISHM.EQ.9.AND.IAXIS.EQ.3)) THEN
  95             IF (ISHM.EQ.5.OR.ISHM.EQ.7) THEN
  96                NPAR = NPARM + 2
  97                PAR(NPAR-1) = -0.5 * STEP
  98                PAR(NPAR)   =  0.5 * STEP
  99             ELSE IF (ISHM.EQ.6.OR.ISHM.EQ.8) THEN
 100                DP   = PARM(NPAR) - PARM(NPAR-1)
 101                IF (DP.LT.0.0) DP = DP + 360.0
 102                IF (ORIG-PARM(NPAR-1).LT.0.0) ORIG = ORIG + 360.0
 103                IF (ORIG-PARM(NPAR-1).GT.DP ) GO TO 910
 104                DP   = PARM(NPAR) - ORIG
 105                IF (DP.LT.0.0) DP = DP + 360.0
 106                PAR(NPAR-1) = -0.5 * DP / NDIV
 107                PAR(NPAR  ) =  0.5 * DP / NDIV
 108             ELSE IF (ISHM.EQ.11.OR.ISHM.EQ.12) THEN
 109                IF (ISHM.EQ.11) NDIV = PARM(3)
 110                STEP = PARM(2) / NDIV
 111                PAR(1) = -0.5 * STEP
 112                PAR(2) = STEP
 113                PAR(3) = 1.
 114             ELSE IF (ISHM.EQ.9) THEN
 115                DP   = PARM(6) - PARM(5)
 116                IF (DP.LT.0.0) DP = DP + 360.0
 117                IF (ORIG-PARM(5).LT.0.0) ORIG = ORIG + 360.0
 118                IF (ORIG-PARM(5).GT.DP ) GO TO 910
 119                DP   = PARM(6) - ORIG
 120                IF (DP.LT.0.0) DP = DP + 360.0
 121                PAR(5) = -0.5 * DP / NDIV
 122                PAR(6) =  0.5 * DP / NDIV
 123             ENDIF
 124          ENDIF
 125       ENDIF
 126       IF (NVAR.LE.0)  GO TO 999
 127 *
 128 * *** Compute the actual parameters
 129 *
 130       IF (ISHM.EQ.1) THEN
 131 *
 132 * BOX
 133 *
 134          IF (ISH.EQ.1) THEN
 135             DO 10 I = 1, NVAR
 136                IAX = LVAR(I)
 137                IF (IAX.EQ.IAXIS) THEN
 138                   PAR(IAX) = 0.5 *STEP
 139                ELSE
 140                   PAR(IAX) = PARM(IAX)
 141                ENDIF
 142    10       CONTINUE
 143          ELSE
 144             GO TO 900
 145          ENDIF
 146 *
 147       ELSE IF (ISHM.EQ.2) THEN
 148 *
 149 * TRD1
 150 *
 151          IF (ISH.EQ.2) THEN
 152             DO 20 I = 1, NVAR
 153                IAX = LVAR(I)
 154                IF (LAX(IAX,ISH).EQ.IAXIS) THEN
 155                   PAR(IAX) = 0.5 * STEP
 156                ELSE IF (LAX(IAX,ISH).EQ.1.AND.IAXIS.EQ.3) THEN
 157                   ZZ   = ORI + PARM(4)
 158                   DXDZ = 0.5 * (PARM(2) - PARM(1)) / PARM(4)
 159                   IF (IAX.EQ.2) ZZ = ZZ + STEP
 160                   PAR(IAX) = PARM(1) + DXDZ * ZZ
 161                ELSE
 162                   PAR(IAX) = PARM(IAX)
 163                ENDIF
 164    20       CONTINUE
 165          ELSE
 166             GO TO 900
 167          ENDIF
 168 *
 169       ELSE IF (ISHM.EQ.3) THEN
 170 *
 171 * TRD2
 172 *
 173          IF (ISH.EQ.3.AND.IAXIS.EQ.3) THEN
 174             DO 30 I = 1, NVAR
 175                IAX = LVAR(I)
 176                IF (LAX(IAX,ISH).EQ.IAXIS) THEN
 177                   PAR(IAX) = 0.5 * STEP
 178                ELSE
 179                   IP1  = 2 * LAX(IAX,ISH) - 1
 180                   IP2  = IP1 + 1
 181                   ZZ   = ORI + PARM(5)
 182                   DXDZ = 0.5 * (PARM(IP2) - PARM(IP1)) / PARM(5)
 183                   IF (IAX.EQ.IP2) ZZ = ZZ + STEP
 184                   PAR(IAX) = PARM(IP1) + DXDZ * ZZ
 185                ENDIF
 186    30       CONTINUE
 187          ELSE IF (ISH.EQ.3) THEN
 188             GO TO 910
 189          ELSE
 190             GO TO 900
 191          ENDIF
 192 *
 193       ELSE IF (ISHM.EQ.4) THEN
 194 *
 195 * TRAP
 196 *
 197          IF (ISH.EQ.4.AND.IAXIS.NE.1) THEN
 198          IF(IAXIS.EQ.3) THEN
 199             DO 40 I = 1, NVAR
 200                IAX = LVAR(I)
 201                IF (IAX.EQ.1) THEN
 202                   PAR(IAX) = 0.5 * STEP
 203                ELSE IF (IAX.LE.6) THEN
 204                   ZZ   = ORI + PARM(1)
 205                   DPDZ = 0.5 * (PARM(IAX+4) - PARM(IAX)) / PARM(1)
 206                   PAR(IAX) = PARM(IAX) + DPDZ * ZZ
 207                ELSE
 208                   ZZ   = ORI + PARM(1) + STEP
 209                   DPDZ = 0.5 * (PARM(IAX) - PARM(IAX-4)) / PARM(1)
 210                   PAR(IAX) = PARM(IAX-4) + DPDZ * ZZ
 211                ENDIF
 212    40       CONTINUE
 213             HTAL = PARM(8) * PARM(11)
 214             HTAH = PARM(4) * PARM(7)
 215             ZZ1  = 0.5 * (ORI + PARM(1)) / PARM(1)
 216             ZZ2  = 0.5 * (ORI + PARM(1) + STEP) / PARM(1)
 217             PAR(7) = (HTAL*(1.0-ZZ1) + HTAH*ZZ1) / PARM(4)
 218             PAR(11)= (HTAL*(1.0-ZZ2) + HTAH*ZZ2) / PARM(8)
 219             CALL GNOTR1(PAR)
 220             ELSE IF (IAXIS.EQ.2) THEN
 221                DO 41 I = 1, NVAR
 222                PAR(LVAR(I)) = PARM(LVAR(I))
 223   41           CONTINUE
 224                DXDY1 = 0.5*(PARM(6)-PARM(5))/PARM(4)
 225                DXDY2 = 0.5*(PARM(10)-PARM(9))/PARM(8)
 226                DXM1  = 0.5*(PARM(6)+PARM(5))
 227                DXM2  = 0.5*(PARM(10)+PARM(9))
 228                DXH1  = DXM1+(ORI+STEP)*DXDY1
 229                DXH2  = DXM2+(ORI+STEP)*DXDY2
 230                DXL1  = DXM1+ORI*DXDY1
 231                DXL2  = DXM2+ORI*DXDY2
 232                PAR(5) = DXL1
 233                PAR(6) = DXH1
 234                PAR(9) = DXL2
 235                PAR(10) = DXH2
 236             ENDIF
 237          ELSE IF (ISH.EQ.4) THEN
 238             GO TO 910
 239          ELSE
 240             GO TO 900
 241          ENDIF
 242 *
 243       ELSE IF (ISHM.EQ.5 .OR. ISHM.EQ.6) THEN
 244 *
 245 * TUBE or TUBS
 246 *
 247          IF (ISH.EQ.5 .OR. ISH.EQ.6) THEN
 248             DO 50 I = 1, NVAR
 249                IAX = LVAR(I)
 250                IF (LAX(IAX,ISH).EQ.IAXIS) THEN
 251                   IF (IAXIS.EQ.3) THEN
 252                      PAR(IAX) = 0.5 * STEP
 253                   ELSE IF (IAXIS.EQ.1) THEN
 254                      IF (IAX.EQ.1) THEN
 255                         PAR(IAX) = ORI
 256                      ELSE
 257                         PAR(IAX) = ORI + STEP
 258                      ENDIF
 259                   ELSE
 260                      GO TO 910
 261                   ENDIF
 262                ELSE
 263                   PAR(IAX) = PARM(IAX)
 264                ENDIF
 265    50       CONTINUE
 266          ELSE
 267             GO TO 900
 268          ENDIF
 269 *
 270       ELSE IF (ISHM.EQ.7 .OR. ISHM.EQ.8) THEN
 271 *
 272 * CONE or CONS
 273 *
 274          IF (ISH.EQ.7 .OR. ISH.EQ.8) THEN
 275             DO 60 I = 1, NVAR
 276                IAX = LVAR(I)
 277                IF (LAX(IAX,ISH).EQ.IAXIS .AND. IAXIS.EQ.3) THEN
 278                   PAR(IAX) = 0.5 * STEP
 279                ELSE IF (IAXIS.EQ.3.AND.IAX.GT.1.AND.IAX.LT.6) THEN
 280                   IF (IAX.EQ.2.OR.IAX.EQ.4) THEN
 281                      DP   = 0.5 * (PARM(4) - PARM(2)) / PARM(1)
 282                      PM   = 0.5 * (PARM(4) + PARM(2))
 283                   ELSE
 284                      DP   = 0.5 * (PARM(5) - PARM(3)) / PARM(1)
 285                      PM   = 0.5 * (PARM(5) + PARM(3))
 286                   ENDIF
 287                   IF (IAX.GT.3) THEN
 288                      DZ   = ORI + STEP
 289                   ELSE
 290                      DZ   = ORI
 291                   ENDIF
 292                   PAR(IAX) = PM + DP * DZ
 293                ELSE IF (IAXIS.EQ.1.AND.LAX(IAX,ISH).EQ.IAXIS) THEN
 294                   IF (IAX.EQ.2) THEN
 295                      PAR(IAX) = ORI
 296                   ELSE IF (IAX.EQ.3) THEN
 297                      PAR(IAX) = ORI + STEP
 298                   ELSE IF (IAX.EQ.4) THEN
 299                      PAR(IAX) = ORI * PARM(IAX) / PARM(2)
 300                   ELSE
 301                      PAR(IAX) = (ORI + STEP) * PARM(IAX) / PARM(3)
 302                   ENDIF
 303                ELSE
 304                   PAR(IAX) = PARM(IAX)
 305                ENDIF
 306    60       CONTINUE
 307          ELSE
 308             GO TO 900
 309          ENDIF
 310 *
 311       ELSE IF (ISHM.EQ.9) THEN
 312 *
 313 * SPHE
 314 *
 315          IF (ISH.EQ.9) THEN
 316             DO 70 I = 1, NVAR
 317                IAX = LVAR(I)
 318                IF (LAX(IAX,ISH).EQ.IAXIS) THEN
 319                   IF (MOD(IAX,2).NE.0) THEN
 320                      PAR(IAX) = ORI
 321                   ELSE
 322                      PAR(IAX) = ORI + STEP
 323                   ENDIF
 324                ELSE
 325                   PAR(IAX) = PARM(IAX)
 326                ENDIF
 327    70       CONTINUE
 328          ELSE
 329             GO TO 900
 330          ENDIF
 331 *
 332       ELSE IF (ISHM.EQ.10) THEN
 333 *
 334 * PARA
 335 *
 336          IF (ISH.EQ.10) THEN
 337             DO 80 I = 1, NVAR
 338                IAX = LVAR(I)
 339                IF (LAX(IAX,ISH).EQ.IAXIS) THEN
 340                   PAR(IAX) = 0.5 * STEP
 341                ENDIF
 342    80       CONTINUE
 343          ELSE
 344             GO TO 900
 345          ENDIF
 346 *
 347       ELSE IF (ISHM.EQ.11 .OR. ISHM.EQ.12) THEN
 348 *
 349 * PGON or PCON
 350 *
 351          IF (ISH.EQ.ISHM) THEN
 352             IF (ISH.EQ.11) THEN
 353                IPNZ = 4
 354             ELSE
 355                IPNZ = 3
 356             ENDIF
 357             NZ   = PAR(IPNZ)
 358             NZ1  = PARM(IPNZ)
 359             IF (NZ.EQ.NZ1) THEN
 360                IF (IAXIS.EQ.1) THEN
 361                   RMN  = ORI
 362                   RMX  = ORI + STEP
 363                   DO 90 I = 1, NZ
 364                      IAX1 = IPNZ + 3*I - 1
 365                      IAX2 = IAX1 + 1
 366                      IF (I.EQ.1) THEN
 367                         PAR(IAX1) = RMN
 368                         PAR(IAX2) = RMX
 369                      ELSE
 370                         PAR(IAX1) = RMN * PARM(IAX1) / PARM(IPNZ+2)
 371                         PAR(IAX2) = RMX * PARM(IAX2) / PARM(IPNZ+3)
 372                      ENDIF
 373    90             CONTINUE
 374                ELSE IF (IAXIS.EQ.2) THEN
 375                   DO 100 I = 1, NVAR
 376                      IAX = LVAR(I)
 377                      PAR(IAX) = PARM(IAX)
 378   100             CONTINUE
 379                ELSE IF (NZ.EQ.2.AND.IAXIS.EQ.3) THEN
 380                   ZL   = PARM(IPNZ+1)
 381                   ZH   = PARM(IPNZ+4)
 382                   DZ   = ZH - ZL
 383                   DRMIDZ = (PARM(IPNZ+5)-PARM(IPNZ+2))/DZ
 384                   DRMADZ = (PARM(IPNZ+6)-PARM(IPNZ+3))/DZ
 385                   PAR(IPNZ+1) = -0.5 * STEP
 386                   PAR(IPNZ+4) =  0.5 * STEP
 387                   DO 110 I = 1, NVAR
 388                      IAX = LVAR(I)-IPNZ
 389                      IF(IAX.EQ.2) THEN
 390                         RAD = PARM(IPNZ+2)+(IN-1)*STEP*DRMIDZ
 391                      ELSEIF (IAX.EQ.3) THEN
 392                         RAD = PARM(IPNZ+3)+(IN-1)*STEP*DRMADZ
 393                      ELSEIF (IAX.EQ.5) THEN
 394                         RAD = PARM(IPNZ+2)+IN*STEP*DRMIDZ
 395                      ELSEIF (IAX.EQ.6) THEN
 396                         RAD = PARM(IPNZ+3)+IN*STEP*DRMADZ
 397                      ENDIF
 398                      PAR(IPNZ+IAX) = RAD
 399   110             CONTINUE
 400                ELSE
 401                   GO TO 920
 402                ENDIF
 403             ELSE
 404                GO TO 920
 405             ENDIF
 406          ELSE
 407             GO TO 900
 408          ENDIF
 409 *
 410       ELSE
 411          GO TO 900
 412       ENDIF
 413 *
 414       GO TO 999
 415 *
 416   900 WRITE (CHMAIL, 1001) ISH, ISHM
 417       GO TO 990
 418 *
 419   910 WRITE (CHMAIL, 1002) ISH, ISHM, IAXIS
 420       GO TO 990
 421 *
 422   920 WRITE (CHMAIL, 1003) ISH, NZ, ISHM, NZ1
 423 *
 424   990 CALL GMAIL( 0, 0)
 425       IEORUN = 1
 426 *
 427  1001 FORMAT (' GGDPAR : Not accepted ISH,ISHM=',2I5)
 428  1002 FORMAT (' GGDPAR : Not accepted ISH,ISHM,IAXIS=',3I5)
 429  1003 FORMAT (' GGDPAR : Not accepted ISH,NZ,ISHM,NZ1=',4I5)
 430 *                                                             END GGDPAR
 431   999 END