| fe4da5cc |
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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame