GEANT321/ggeom/gsdvn.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:55  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GSDVN(KNAME,MOTHER,NDIV,IAXIS)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *       Routine divides MOTHER into NDIV divisions called NAME   *
  20 C.    *       along axis number IAXIS.                                 *
  21 C.    *          JVO=Pointer to MOTHER volume                          *
  22 C.    *          JDIV=LQ(JVO-1)                                        *
  23 C.    *                                                                *
  24 C.    *            Q(JDIV+1)=IAXIS                                     *
  25 C.    *            Q(JDIV+2)=Volume number.                            *
  26 C.    *            Q(JDIV+3)=NDIV                                      *
  27 C.    *            Q(JDIV+4)=Lowest coord of slices.                   *
  28 C.    *            Q(JDIV+5)=Step size in coordinates.                 *
  29 C.    *                                                                *
  30 C.    *    ==>Called by :  <USER>, GEDITV                              *
  31 C.    *         Authors R.Brun,   A.McPherson  *********               *
  32 C.    *                                                                *
  33 C.    ******************************************************************
  34 C.
  35 #include "geant321/gcbank.inc"
  36 #include "geant321/gcflag.inc"
  37 #include "geant321/gcnum.inc"
  38 #include "geant321/gcunit.inc"
  39 #include "geant321/gcdraw.inc"
  40 #include "geant321/gcshno.inc"
  41       CHARACTER*4 KNAME,MOTHER
  42       DIMENSION PAR(100),PARM(100),ATT(20)
  43       SAVE ATT
  44       DATA ATT /1.,1.,1.,1.,1.,15*0./
  45 C.
  46 C.    ------------------------------------------------------------------
  47 C.
  48 C              Check if volume master bank exists.
  49 C
  50       CALL UCTOH(KNAME,NAME,4,4)
  51       IF(JVOLUM.GT.0)GO TO 10
  52       WRITE(CHMAIL,1000)
  53       CALL GMAIL(0,0)
  54       GO TO 99
  55 C
  56 C              Check if MOTHER volume exists.
  57 C
  58   10  CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO)
  59       IF(IVO.GT.0)GO TO 20
  60       WRITE(CHMAIL,1100)MOTHER
  61       CALL GMAIL(0,0)
  62       GO TO 99
  63 C
  64 C              Check if NAME volume exists.
  65 C
  66   20  CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IN)
  67       IF(IN.LE.0)GO TO 50
  68       WRITE(CHMAIL,2000)NAME
  69       CALL GMAIL(0,0)
  70       GO TO 99
  71 C
  72 C              Check if MOTHER is not divided.
  73 C
  74   50  JVO=LQ(JVOLUM-IVO)
  75       NIN=Q(JVO+3)
  76       IF(NIN.EQ.0)GO TO 60
  77       WRITE(CHMAIL,4000)MOTHER
  78       CALL GMAIL(0,0)
  79       GO TO 99
  80 C
  81 C              Check validity of axis value.
  82 C
  83   60  IF(IAXIS.GT.0.AND.IAXIS.LT.4)GO TO 70
  84       WRITE(CHMAIL,5000)IAXIS
  85       CALL GMAIL(0,0)
  86       GO TO 99
  87 C
  88 C              Check validity of NDIV
  89 C
  90   70  IF(NDIV.GT.0)GO TO 80
  91       WRITE(CHMAIL,6000)NDIV
  92       CALL GMAIL(0,0)
  93       GO TO 99
  94 C
  95 C               Create bank to store division parameters.
  96 C
  97   80  CALL MZBOOK(IXCONS,JDIV,JVO,-1,'VODI',0,0,6,3,0)
  98       IF(IEOTRI.NE.0)GO TO 95
  99       IQ(JDIV-5)=IVO
 100 C
 101 C               Now store parameters into bank area.
 102 C
 103   90  Q(JDIV+1)=IAXIS
 104       Q(JDIV+2)=NVOLUM+1
 105       Q(JDIV+3)=NDIV
 106       Q(JVO+3)=-1
 107       IVOM= IVO
 108       NWM = IQ(JVO-1)
 109       NW  = NWM
 110       ISH = Q(JVO+2)
 111 C
 112 C               Bit to allow division of objects defined
 113 C               by GSPOSP.
 114 C
 115       C0=0.0
 116       STEP=0.0
 117       NPAR=Q(JVO+5)
 118       NATT=Q(JVO+6)
 119       CALL UCOPY(Q(JVO+NPAR+7),ATT,NATT)
 120       IF(NPAR.LE.0) GO TO 230
 121 C
 122       CALL GFIPAR(JVO,0,0,NPAR,NATT,PAR,ATT)
 123       CALL UCOPY(PAR,PARM,NPAR)
 124 C
 125 C              Find and store start and step.
 126 C
 127       IF(ISH.NE.1) GO TO 100
 128 C
 129 C               Box.
 130 C
 131       STEP=-1.0
 132       PAR(IAXIS)=-1.0
 133       IF(PARM(IAXIS).LT.0.0) GO TO 230
 134       C0  =-PARM(IAXIS)
 135       STEP=PARM(IAXIS)*2.0/NDIV
 136       PAR(IAXIS)=STEP/2.
 137       GO TO 230
 138 C
 139   100 CONTINUE
 140       IF(ISH.NE.2) GO TO 110
 141 C
 142 C              Trapezoid with only X thickness varying with Z.
 143 C
 144       IF(IAXIS.EQ.1) GO TO 900
 145       PAR(1)=-1.
 146       PAR(2)=-1.
 147       STEP=-1.0
 148       PAR(IAXIS+1)=-1.0
 149       IF(PARM(IAXIS+1).LT.0.0) GO TO 230
 150       C0  =-PARM(IAXIS+1)
 151       STEP=PARM(IAXIS+1)*2.0/NDIV
 152       PAR(IAXIS+1)=STEP/2.
 153       GO TO 230
 154 C
 155   110 CONTINUE
 156       IF(ISH.NE.3) GO TO 120
 157 C
 158 C              Trapezoid with both X and Y thicknesses varying with
 159 C              Z
 160 C
 161       IF(IAXIS.NE.3) GO TO 900
 162       PAR(1)=-1.
 163       PAR(2)=-1.
 164       PAR(3)=-1.
 165       PAR(4)=-1.
 166       STEP=-1.0
 167       PAR(5)=-1.0
 168       IF(PARM(5).LT.0.0) GO TO 230
 169       C0  =-PARM(5)
 170       STEP=PARM(5)*2.0/NDIV
 171       PAR(5)=STEP/2.
 172       GO TO 230
 173 C
 174   120 CONTINUE
 175       IF(ISH.NE.4) GO TO 125
 176       IF(IAXIS.NE.3) GO TO 126
 177       PAR(1)=-1.
 178       PAR(4)=-1.
 179       PAR(5)=-1.
 180       PAR(6)=-1.
 181       PAR(8)=-1.
 182       PAR(9)=-1.
 183       PAR(10)=-1.
 184       STEP=-1.0
 185       IF(PARM(1).LT.0.0) GO TO 230
 186       C0=-PARM(1)
 187       STEP=PARM(1)*2.0/NDIV
 188       PAR(1)=STEP*0.5
 189 C
 190       GO TO 230
 191 C
 192   126 IF(IAXIS.NE.2) GO TO 900
 193       IF(MOD(PARM(3),180.).EQ.0.) GO TO 127
 194       WRITE(CHMAIL,10100)
 195 10100 FORMAT(' Division of TRAP ',A4,
 196      +    ' along Y only possible when PHI=0,180')
 197       CALL GMAIL(0,0)
 198       GOTO 99
 199   127 IF(PARM(4).EQ.PARM(8))  GO TO 128
 200       WRITE(CHMAIL,10200)
 201 10200 FORMAT(' Division of TRAP ',A4,
 202      +    ' along Y only possible when H1=H2')
 203       CALL GMAIL(0,0)
 204       GOTO 99
 205   128 CONTINUE
 206       STEP = -1.
 207       IF(PARM(4).LT.0.0) GO TO 230
 208       C0=-PARM(4)
 209       STEPH = PARM(4)/NDIV
 210       PAR(4) = STEPH
 211       PAR(5) = -1.
 212       PAR(6) = -1.
 213       PAR(8) = STEPH
 214       PAR(9) = -1.
 215       PAR(10) = -1.
 216       STEP = 2.*STEPH
 217 C
 218       GO TO 230
 219 C
 220   125 CONTINUE
 221       IF(ISH.NE.5.AND.ISH.NE.6.AND.ISH.NE.NSCTUB) GO TO 160
 222 C
 223 C              Tube, tube segment or cut tube.
 224 C
 225       IF(IAXIS.NE.3) GO TO 130
 226       STEP=-1.0
 227       PAR(3)=-1.0
 228       IF(PARM(3).LT.0.0) GO TO 230
 229       C0  =-PARM(3)
 230       STEP=PARM(3)*2.0/NDIV
 231       PAR(3)=STEP/2.
 232       GO TO 230
 233 C
 234   130 CONTINUE
 235       IF(IAXIS.NE.1) GO TO 140
 236       PAR(1)=-1.
 237       PAR(2)=-1.
 238       STEP=-1.0
 239       IF(PARM(1).LT.0.0) GO TO 230
 240       C0  =PARM(1)
 241       IF(PARM(2).LT.0.0) GO TO 230
 242       STEP=(PARM(2)-PARM(1))/NDIV
 243       GO TO 230
 244 C
 245   140 CONTINUE
 246       IF(ISH.EQ.6) GO TO 150
 247       NW=NW+2
 248       ISH=6
 249       C0  =0.0
 250       STEP=360.0/NDIV
 251       NPAR=5
 252       PAR(4)=-STEP/2.
 253       PAR(5)=STEP/2.
 254       GO TO 230
 255 C
 256   150 CONTINUE
 257       DP=PAR(5)-PAR(4)
 258       IF(DP.LT.0.0) DP=DP+360.0
 259       C0  =PAR(4)
 260       STEP=DP/NDIV
 261       PAR(4)=-STEP/2.
 262       PAR(5)=STEP/2.
 263       GO TO 230
 264 C
 265   160 CONTINUE
 266 C
 267       IF(ISH.NE.7.AND.ISH.NE.8) GO TO 190
 268       IF(IAXIS.EQ.1) GO TO 165
 269       IF(IAXIS.NE.3) GO TO 170
 270 C
 271       STEP=-1.0
 272       PAR(1)=-1.0
 273       IF(PARM(1).LT.0.0) GO TO 165
 274       C0=-PARM(1)
 275       STEP=PARM(1)*2.0/NDIV
 276       PAR(1)=STEP*0.5
 277 C
 278   165 CONTINUE
 279 C
 280       PAR(2)=-1.0
 281       PAR(3)=-1.0
 282       PAR(4)=-1.0
 283       PAR(5)=-1.0
 284       GO TO 230
 285 C
 286   170 CONTINUE
 287       IF(IAXIS.EQ.1) GO TO 230
 288 C
 289       IF(ISH.EQ.8) GO TO 180
 290       NW=NW+2
 291       ISH=8
 292       C0  =0.0
 293       STEP=360.0/NDIV
 294       NPAR=7
 295       PAR(6)=-STEP/2.
 296       PAR(7)=STEP/2.
 297       GO TO 230
 298 C
 299   180 CONTINUE
 300       DP=PAR(7)-PAR(6)
 301       IF(DP.LT.0.0) DP=DP+360.0
 302       C0  =PAR(6)
 303       STEP=DP/NDIV
 304       PAR(6)=-STEP/2.
 305       PAR(7)=STEP/2.
 306       GO TO 230
 307 C
 308   190 CONTINUE
 309       IF(ISH.NE.9) GO TO 200
 310       IF(IAXIS.NE.1) GO TO 195
 311       PAR(1)=-1.0
 312       PAR(2)=-1.0
 313       C0    = PARM(1)
 314       STEP = (PARM(2)-PARM(1))/NDIV
 315   195 CONTINUE
 316       IF(IAXIS.NE.2) GO TO 196
 317       WRITE(CHMAIL,8102)
 318       CALL GMAIL(0,0)
 319       GOTO 99
 320 C
 321   196 CONTINUE
 322       IF(IAXIS.NE.3) GO TO 230
 323       C0=PAR(5)
 324       DP=PAR(6)-PAR(5)
 325       IF(DP.LE.0.0) DP=DP+360.0
 326       STEP=DP/NDIV
 327       PAR(3)=-1.
 328       PAR(4)=-1.
 329       PAR(5)=-0.5*STEP
 330       PAR(6)=0.5*STEP
 331       GO TO 230
 332 C
 333   200 CONTINUE
 334 C
 335       IF(ISH.NE.10) GO TO 210
 336 C
 337 C              Parallelipiped.
 338 C
 339       C0  =-PAR(IAXIS)
 340       STEP=-2.0*C0/NDIV
 341       PAR(IAXIS)=STEP/2.
 342       GO TO 230
 343 C
 344   210 CONTINUE
 345       IF(ISH.GT.12) GO TO 900
 346       IF(IAXIS.EQ.1) GO TO 230
 347       IF(IAXIS.EQ.2) GO TO 220
 348 C
 349       IPNZ=4
 350       IF(ISH.EQ.12) IPNZ=3
 351       IF(PAR(IPNZ).NE.2) GO TO 910
 352 C
 353       ZH=PAR(IPNZ+4)
 354       ZL=PAR(IPNZ+1)
 355       STEP=(ZH-ZL)/NDIV
 356       C0=ZL
 357       PAR(IPNZ+4)=STEP*0.5
 358       PAR(IPNZ+1)=-PAR(IPNZ+4)
 359       PAR(IPNZ+2)=-1.
 360       PAR(IPNZ+3)=-1.
 361       PAR(IPNZ+5)=-1.
 362       PAR(IPNZ+6)=-1.
 363 C
 364       GO TO 230
 365   220 CONTINUE
 366 C
 367       NDV=NDIV
 368       IF(ISH.EQ.11) NDV=PAR(3)
 369       Q(JDIV+3)=NDV
 370       C0=PAR(1)
 371       STEP=PAR(2)/NDV
 372       PAR(1)=-STEP*0.5
 373       PAR(2)=STEP
 374       IF(ISH.EQ.11)PAR(3)=1.
 375 C
 376   230 CONTINUE
 377 C
 378 C                Now create the volume for division.
 379 C
 380       Q(JDIV+4)=C0
 381       Q(JDIV+5)=STEP
 382       NVOLUM=NVOLUM+1
 383       NVOL  =IQ(JVOLUM-2)
 384       IF(NVOLUM.GT.NVOL)CALL MZPUSH(IXCONS,JVOLUM,50,50,'I')
 385       CALL MZBOOK(IXCONS,JVO,JVOLUM,-NVOLUM,'VOL1',50,50,NW,3,0)
 386       IF(IEOTRI.NE.0)GO TO 95
 387       IQ(JVOLUM+NVOLUM)=NAME
 388 C
 389 C              Copy parameters in data area.
 390 C
 391       JVOM=LQ(JVOLUM-IVOM)
 392       CALL UCOPY(Q(JVOM+1),Q(JVO+1),NWM)
 393       IF(NPAR.GT.0) CALL GSIPAR(JVO,0,NPAR,NATT,PAR,ATT)
 394       Q(JVO+2)=ISH
 395       Q(JVO+3)=0.
 396       GO TO 99
 397 C
 398   900 CONTINUE
 399 C
 400 C        Divide action not supported.
 401 C
 402       WRITE(CHMAIL,8000)
 403       CALL GMAIL(0,0)
 404       WRITE(CHMAIL,8001) ISH,IAXIS
 405       CALL GMAIL(0,0)
 406 C
 407       GO TO 99
 408 C
 409   910 CONTINUE
 410 C
 411 C          Trying to divide multi Z sector shape along Z.
 412 C
 413       WRITE(CHMAIL,8100)
 414       CALL GMAIL(0,0)
 415       WRITE(CHMAIL,8101) ISH,IAXIS,IPNZ,INT(PAR(IPNZ))
 416       CALL GMAIL(0,0)
 417 C
 418       GO TO 99
 419 C
 420 C              Not enough space.
 421 C
 422   95  WRITE(CHMAIL,7000)NAME,MOTHER
 423       CALL GMAIL(0,0)
 424 C
 425   99  CONTINUE
 426  1000 FORMAT(' ***** GSDVN CALLED AND NO VOLUMES DEFINED *****')
 427  1100 FORMAT(' ***** GSDVN MOTHER VOLUME ',A4,' DOES NOT EXIST *****')
 428  2000 FORMAT(' ***** GSDVN VOLUME ',A4,' ALREADY EXISTS *****')
 429  3000 FORMAT(' ***** GSDVN ROTATION MATRIX',I5,' DOES NOT EXISTS *****')
 430  4000 FORMAT(' ***** GSDVN MOTHER ',A4,' ALREADY DIVIDED *****')
 431  5000 FORMAT(' ***** GSDVN BAD AXIS VALUE ',I5,' *****')
 432  6000 FORMAT(' ***** GSDVN BAD NUMBER OF DIVISIONS ',I5,' *****')
 433  7000 FORMAT(' ***** GSDVN NOT ENOUGH SPACE TO STORE DIVISIONS ',
 434      +       ' IN ',A4,' *****')
 435  8000 FORMAT(' DIVIDE ACTION REQUESTED NOT SUPPORTED AT PRESENT.')
 436  8001 FORMAT(' ISH =',I5,' IAXIS =',I5)
 437  8100 FORMAT(' ATTEMPT TO DIVIDE MULTI Z SECTOR SHAPE ALONG Z.')
 438  8101 FORMAT(' ISH =',I5,' IAXIS =',I5,' NZ (THE',I3,'TH PAR) IS',I5)
 439  8102 FORMAT(' DIVISION OF A SPHERE ALONG AXIS 2 NOT SUPPORTED')
 440       END