GEANT321/ggeom/gsdvn.F

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