| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1995/10/24 10:20:56 cernlib |
| 6 | * Geant |
| 7 | * |
| 8 | * |
| 9 | #include "geant321/pilot.h" |
| 10 | *CMZ : 3.21/03 06/10/94 18.33.17 by S.Giani |
| 11 | *-- Author : |
| 12 | SUBROUTINE GSDVT2(KNAME,MOTHER,STEP,IAXIS,C0,NUMED,NDVMX) |
| 13 | C. |
| 14 | C. ****************************************************************** |
| 15 | C. * * |
| 16 | C. * Divides MOTHER into divisions called NAME along * |
| 17 | C. * axis IAXIS starting at coordinate value C0 with step * |
| 18 | C. * size STEP. * |
| 19 | C. * The new volume created will have medium number NUMED. * |
| 20 | C. * If NUMED is 0, NUMED of mother is taken. * |
| 21 | C. * NDVMX is the expected maximum number of divisions * |
| 22 | C. * (If 0, no protection tests are performed) * |
| 23 | C. * * |
| 24 | C. * JVO=Pointer to MOTHER volume * |
| 25 | C. * JDIV=LQ(JVO-1) * |
| 26 | C. * * |
| 27 | C. * Q(JDIV+1)=IAXIS * |
| 28 | C. * Q(JDIV+2)=Volume number * |
| 29 | C. * Q(JDIV+3)=Number of divisions. * |
| 30 | C. * Q(JDIV+4)=C0 * |
| 31 | C. * Q(JDIV+5)=STEP * |
| 32 | C. * * |
| 33 | C. * ==>Called by : ,USER., GSDVS2, GSDVX * |
| 34 | C. * Authors F.Bruyant, M.Maire, A.McPherson ********* * |
| 35 | C. * * |
| 36 | C. ****************************************************************** |
| 37 | C. |
| 38 | #include "geant321/gcbank.inc" |
| 39 | #include "geant321/gcflag.inc" |
| 40 | #include "geant321/gcnum.inc" |
| 41 | #include "geant321/gcunit.inc" |
| 42 | #include "geant321/gcdraw.inc" |
| 43 | #include "geant321/gcshno.inc" |
| 44 | CHARACTER*4 KNAME,MOTHER |
| 45 | DIMENSION PAR(50),ATT(20) |
| 46 | SAVE ATT |
| 47 | DATA ATT /1.,1.,1.,1.,1.,15*0./ |
| 48 | C. |
| 49 | C. ------------------------------------------------------------------ |
| 50 | C. |
| 51 | C CHECK IF VOLUME MASTER BANK EXISTS |
| 52 | C |
| 53 | CALL UCTOH(KNAME,NAME,4,4) |
| 54 | IF(JVOLUM.GT.0)GO TO 10 |
| 55 | WRITE(CHMAIL,1000) |
| 56 | CALL GMAIL(0,0) |
| 57 | GO TO 99 |
| 58 | C |
| 59 | C CHECK IF MOTHER VOLUME EXISTS |
| 60 | C |
| 61 | 10 CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO) |
| 62 | IF(IVO.GT.0)GO TO 20 |
| 63 | WRITE(CHMAIL,2000)MOTHER |
| 64 | CALL GMAIL(0,0) |
| 65 | GO TO 99 |
| 66 | C |
| 67 | C CHECK IF NAME VOLUME EXISTS |
| 68 | C |
| 69 | 20 CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IN) |
| 70 | IF(IN.LE.0)GO TO 50 |
| 71 | WRITE(CHMAIL,2000)NAME |
| 72 | CALL GMAIL(0,0) |
| 73 | GO TO 99 |
| 74 | C |
| 75 | C CHECK IF MOTHER IS NOT DIVIDED |
| 76 | C |
| 77 | 50 JVO=LQ(JVOLUM-IVO) |
| 78 | NIN=Q(JVO+3) |
| 79 | IF(NIN.EQ.0)GO TO 60 |
| 80 | WRITE(CHMAIL,4000)MOTHER |
| 81 | CALL GMAIL(0,0) |
| 82 | GO TO 99 |
| 83 | C |
| 84 | C CHECK VALIDITY OF AXIS VALUE |
| 85 | C |
| 86 | 60 IF(IAXIS.GT.0.AND.IAXIS.LT.4)GO TO 70 |
| 87 | WRITE(CHMAIL,5000)IAXIS |
| 88 | CALL GMAIL(0,0) |
| 89 | GO TO 99 |
| 90 | C |
| 91 | C CHECK VALIDITY OF STEP |
| 92 | C |
| 93 | 70 IF(STEP.GT.0.0)GO TO 80 |
| 94 | WRITE(CHMAIL,6000)STEP |
| 95 | CALL GMAIL(0,0) |
| 96 | GO TO 99 |
| 97 | C |
| 98 | C CREATE BANK TO STORE DIVISION PARAMETERS |
| 99 | C |
| 100 | 80 CALL MZBOOK(IXCONS,JDIV,JVO,-1,'VODI',0,0,6,3,0) |
| 101 | IF(IEOTRI.NE.0)GO TO 95 |
| 102 | IQ(JDIV-5)=IVO |
| 103 | C |
| 104 | C NOW STORE PARAMETERS INTO BANK AREA |
| 105 | C |
| 106 | 90 Q(JDIV+1)=IAXIS |
| 107 | Q(JDIV+2)=NVOLUM+1 |
| 108 | Q(JVO+3)=-1 |
| 109 | IVOM= IVO |
| 110 | NWM = IQ(JVO-1) |
| 111 | NW = NWM |
| 112 | CALL GFIPAR(JVO,0,0,NPAR,NATT,PAR,ATT) |
| 113 | C |
| 114 | C CHECK START AND STEP AND FIND AND STORE NDIV. |
| 115 | C |
| 116 | ISH=Q(JVO+2) |
| 117 | IF(ISH.NE.1) GO TO 100 |
| 118 | C |
| 119 | C BOX |
| 120 | C |
| 121 | IF(PAR(IAXIS).LE.0.0) GO TO 920 |
| 122 | IF(ABS(C0).GT.PAR(IAXIS)) GO TO 910 |
| 123 | NDIV=(PAR(IAXIS)-C0+0.001)/STEP |
| 124 | IF (NDIV.LE.0) GO TO 910 |
| 125 | PAR(IAXIS)=STEP/2. |
| 126 | GO TO 210 |
| 127 | C |
| 128 | 100 CONTINUE |
| 129 | IF(ISH.NE.2) GO TO 110 |
| 130 | C |
| 131 | C TRAPEZOID WITH ONLY X THICKNESS VARYING WITH Z. |
| 132 | C |
| 133 | IF(IAXIS.EQ.1) GO TO 900 |
| 134 | IF(PAR(IAXIS+1).LE.0.0) GO TO 920 |
| 135 | IF(ABS(C0).GT.PAR(IAXIS+1)) GO TO 910 |
| 136 | NDIV=(PAR(IAXIS+1)-C0+0.001)/STEP |
| 137 | IF (NDIV.LE.0) GO TO 910 |
| 138 | PAR(1)=-1. |
| 139 | PAR(2)=-1. |
| 140 | PAR(IAXIS+1)=STEP/2. |
| 141 | GO TO 210 |
| 142 | C |
| 143 | 110 CONTINUE |
| 144 | IF(ISH.NE.3) GO TO 120 |
| 145 | C |
| 146 | C TRAPEZOID WITH BOTH X AND Y THICKNESSES VARYING WITH |
| 147 | C Z |
| 148 | C |
| 149 | IF(IAXIS.NE.3) GO TO 900 |
| 150 | IF(PAR(5).LE.0.0) GO TO 920 |
| 151 | IF(ABS(C0).GT.PAR(5)) GO TO 910 |
| 152 | NDIV=(PAR(5)-C0+0.001)/STEP |
| 153 | IF (NDIV.LE.0) GO TO 910 |
| 154 | PAR(1)=-1. |
| 155 | PAR(2)=-1. |
| 156 | PAR(3)=-1. |
| 157 | PAR(4)=-1. |
| 158 | PAR(5)=STEP/2. |
| 159 | GO TO 210 |
| 160 | C |
| 161 | 120 CONTINUE |
| 162 | IF(ISH.NE.4) GO TO 125 |
| 163 | IF(IAXIS.NE.3) GO TO 126 |
| 164 | IF(PAR(1).LE.0.0) GO TO 920 |
| 165 | IF(ABS(C0).GT.PAR(1)) GO TO 910 |
| 166 | NDIV=(PAR(1)-C0+0.001)/STEP |
| 167 | IF (NDIV.LE.0) GO TO 910 |
| 168 | PAR(1)=STEP*0.5 |
| 169 | PAR(4)=-1.0 |
| 170 | PAR(5)=-1.0 |
| 171 | PAR(6)=-1.0 |
| 172 | PAR(8)=-1.0 |
| 173 | PAR(9)=-1.0 |
| 174 | PAR(10)=-1.0 |
| 175 | GO TO 210 |
| 176 | C |
| 177 | 126 IF(IAXIS.NE.2) GO TO 900 |
| 178 | IF(MOD(PAR(3),180.).EQ.0.) GO TO 127 |
| 179 | WRITE(CHMAIL,10100) |
| 180 | 10100 FORMAT(' Division of TRAP ',A4, |
| 181 | + ' along Y only possible when PHI=0,180') |
| 182 | CALL GMAIL(0,0) |
| 183 | GOTO 99 |
| 184 | 127 IF(PAR(4).EQ.PAR(8)) GO TO 128 |
| 185 | WRITE(CHMAIL,10200) |
| 186 | 10200 FORMAT(' Division of TRAP ',A4, |
| 187 | + ' along Y only possible when H1=H2') |
| 188 | CALL GMAIL(0,0) |
| 189 | GOTO 99 |
| 190 | 128 CONTINUE |
| 191 | IF(PAR(4).LT.0.0) GO TO 920 |
| 192 | IF(ABS(C0).GE.PAR(4)) GO TO 910 |
| 193 | NDIV = (PAR(4)-C0+0.001)/STEP |
| 194 | IF (NDIV.LE.0) GO TO 910 |
| 195 | PAR(4) = 0.5*STEP |
| 196 | PAR(5) = -1. |
| 197 | PAR(6) = -1. |
| 198 | PAR(8) = 0.5*STEP |
| 199 | PAR(9) = -1. |
| 200 | PAR(10) = -1. |
| 201 | C |
| 202 | GO TO 210 |
| 203 | C |
| 204 | 125 CONTINUE |
| 205 | IF(ISH.NE.5.AND.ISH.NE.6.AND.ISH.NE.NSCTUB) GO TO 160 |
| 206 | C |
| 207 | C Tube, tube segment or cut tube. |
| 208 | C |
| 209 | IF(IAXIS.NE.3) GO TO 130 |
| 210 | IF(PAR(3).LE.0.0) GO TO 920 |
| 211 | IF(ABS(C0).GT.PAR(3)) GO TO 910 |
| 212 | NDIV=(PAR(3)-C0+0.001)/STEP |
| 213 | IF (NDIV.LE.0) GO TO 910 |
| 214 | PAR(3)=STEP/2. |
| 215 | GO TO 210 |
| 216 | C |
| 217 | 130 CONTINUE |
| 218 | IF(IAXIS.NE.1) GO TO 140 |
| 219 | IF(PAR(1).LE.0.0.OR.PAR(2).LE.0.0) GO TO 920 |
| 220 | IF(C0.LT.PAR(1)) GO TO 910 |
| 221 | NDIV=(PAR(2)-C0+0.001)/STEP |
| 222 | IF (NDIV.LE.0) GO TO 910 |
| 223 | PAR(1)=-1. |
| 224 | PAR(2)=-1. |
| 225 | GO TO 210 |
| 226 | C |
| 227 | 140 CONTINUE |
| 228 | IF(ISH.EQ.6) GO TO 150 |
| 229 | NW=NW+2 |
| 230 | ISH=6 |
| 231 | NDIV=360.001/STEP |
| 232 | IF (NDIV.LE.0) GO TO 910 |
| 233 | NPAR=5 |
| 234 | PAR(4)=-STEP/2. |
| 235 | PAR(5)=STEP/2. |
| 236 | GO TO 210 |
| 237 | C |
| 238 | 150 CONTINUE |
| 239 | DP=PAR(5)-PAR(4) |
| 240 | DC0P = C0-PAR(4) |
| 241 | SG = SIGN(1.0,DC0P) |
| 242 | DC0P = MOD( ABS(DC0P), 360.0) |
| 243 | IF(SG.LE.0.0) DC0P = 360.0-DC0P |
| 244 | C0 = PAR(4)+DC0P |
| 245 | IF(C0-PAR(4).LT.0.0) C0=C0+360.0 |
| 246 | IF(C0-PAR(4).GT.DP) GO TO 910 |
| 247 | DP=PAR(5)-C0 |
| 248 | IF(DP.LT.0.0) DP=DP+360 |
| 249 | NDIV=(DP+0.001)/STEP |
| 250 | IF (NDIV.LE.0) GO TO 910 |
| 251 | PAR(4)=-STEP/2. |
| 252 | PAR(5)=STEP/2. |
| 253 | GO TO 210 |
| 254 | C |
| 255 | 160 CONTINUE |
| 256 | C |
| 257 | IF(ISH.NE.7.AND.ISH.NE.8) GO TO 190 |
| 258 | IF(IAXIS.EQ.1) GO TO 165 |
| 259 | IF(IAXIS.NE.3) GO TO 170 |
| 260 | C |
| 261 | IF(PAR(1).LE.0.0) GO TO 920 |
| 262 | IF(ABS(C0).GT.PAR(1)) GO TO 910 |
| 263 | NDIV=(PAR(1)-C0+0.001)/STEP |
| 264 | IF (NDIV.LE.0) GO TO 910 |
| 265 | PAR(1)=STEP*0.5 |
| 266 | C |
| 267 | 165 CONTINUE |
| 268 | C |
| 269 | PAR(2)=-1.0 |
| 270 | PAR(3)=-1.0 |
| 271 | PAR(4)=-1.0 |
| 272 | PAR(5)=-1.0 |
| 273 | GO TO 210 |
| 274 | C |
| 275 | 170 CONTINUE |
| 276 | IF(IAXIS.EQ.1) GO TO 210 |
| 277 | C |
| 278 | IF(ISH.EQ.8) GO TO 180 |
| 279 | NW=NW+2 |
| 280 | ISH=8 |
| 281 | NDIV=360.001/STEP |
| 282 | IF (NDIV.LE.0) GO TO 910 |
| 283 | NPAR=7 |
| 284 | PAR(6)=-STEP/2. |
| 285 | PAR(7)=STEP/2. |
| 286 | GO TO 210 |
| 287 | C |
| 288 | 180 CONTINUE |
| 289 | DP=PAR(7)-PAR(6) |
| 290 | DC0P = C0-PAR(6) |
| 291 | SG = SIGN(1.0,DC0P) |
| 292 | DC0P = MOD( ABS(DC0P), 360.0) |
| 293 | IF(SG.LE.0.0) DC0P = 360.0-DC0P |
| 294 | C0 = PAR(6)+DC0P |
| 295 | IF(C0-PAR(6).LT.0.0) C0=C0+360.0 |
| 296 | IF(C0-PAR(6).GT.DP) GO TO 910 |
| 297 | DP=PAR(7)-C0 |
| 298 | IF(DP.LT.0.0) DP=DP+360.0 |
| 299 | NDIV=(DP+0.001)/STEP |
| 300 | IF (NDIV.LE.0) GO TO 910 |
| 301 | PAR(6)=-STEP/2. |
| 302 | PAR(7)=STEP/2. |
| 303 | GO TO 210 |
| 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 | 195 CONTINUE |
| 311 | C |
| 312 | IF(IAXIS.NE.3) GO TO 210 |
| 313 | DP=PAR(6)-PAR(5) |
| 314 | DC0P = C0-PAR(4) |
| 315 | SG = SIGN(1.0,DC0P) |
| 316 | DC0P = MOD( ABS(DC0P), 360.0) |
| 317 | IF(SG.LE.0.0) DC0P = 360.0-DC0P |
| 318 | C0 = PAR(4)+DC0P |
| 319 | IF(C0.LT.PAR(5)) C0=C0+360.0 |
| 320 | IF(C0-PAR(5).GT.DP) GO TO 910 |
| 321 | DP=PAR(6)-C0 |
| 322 | IF(DP.LT.0.0) DP=DP+360 |
| 323 | NDIV=(DP+0.001)/STEP |
| 324 | IF (NDIV.LE.0) GO TO 910 |
| 325 | PAR(3)=-1. |
| 326 | PAR(4)=-1. |
| 327 | PAR(5)=-0.5*STEP |
| 328 | PAR(6)=0.5*STEP |
| 329 | GO TO 210 |
| 330 | C |
| 331 | 200 CONTINUE |
| 332 | C |
| 333 | GO TO 900 |
| 334 | C |
| 335 | C NOW CREATE THE VOLUME FOR DIVISION |
| 336 | C |
| 337 | 210 IF (NDVMX.GT.0) THEN |
| 338 | IF (NDIV.GT.NDVMX) THEN |
| 339 | WRITE (CHMAIL, 1210) NDIV,NDVMX |
| 340 | CALL GMAIL(0,0) |
| 341 | 1210 FORMAT (' GSDVT2 : NDIV gt NDVMX', 2I8,' truncated') |
| 342 | NDIV = NDVMX |
| 343 | ENDIF |
| 344 | ELSE IF (NDVMX.LT.0) THEN |
| 345 | * Case when called by GSDVX |
| 346 | IF (NDIV.GT.-NDVMX) NDIV = -NDVMX |
| 347 | ENDIF |
| 348 | Q(JDIV+4)=C0 |
| 349 | Q(JDIV+5)=STEP |
| 350 | Q(JDIV+3)=NDIV |
| 351 | NVOLUM=NVOLUM+1 |
| 352 | NVOL =IQ(JVOLUM-2) |
| 353 | IF(NVOLUM.GT.NVOL)CALL MZPUSH(IXCONS,JVOLUM,50,50,'I') |
| 354 | CALL MZBOOK(IXCONS,JVO,JVOLUM,-NVOLUM,'VOL1',50,50,NW,3,0) |
| 355 | IF(IEOTRI.NE.0)GO TO 95 |
| 356 | IQ(JVOLUM+NVOLUM)=NAME |
| 357 | C |
| 358 | C COPY PARAMETERS IN DATA AREA |
| 359 | C |
| 360 | JVOM=LQ(JVOLUM-IVOM) |
| 361 | CALL UCOPY(Q(JVOM+1),Q(JVO+1),NWM) |
| 362 | CALL GSIPAR(JVO,0,NPAR,NATT,PAR,ATT) |
| 363 | Q(JVO+2)=ISH |
| 364 | Q(JVO+3)=0. |
| 365 | IF (NUMED.GT.0) Q(JVO+4)=NUMED |
| 366 | GO TO 99 |
| 367 | C |
| 368 | 900 CONTINUE |
| 369 | C |
| 370 | C DIVIDE ACTION NOT SUPPORTED. |
| 371 | C |
| 372 | WRITE(CHMAIL,8000) |
| 373 | CALL GMAIL(0,0) |
| 374 | WRITE(CHMAIL,8001) ISH,IAXIS |
| 375 | CALL GMAIL(0,0) |
| 376 | C |
| 377 | GO TO 99 |
| 378 | C |
| 379 | 910 CONTINUE |
| 380 | C |
| 381 | C C0 START OF DIVISION OUT OF OBJECT OR STEP SIZE TOO BIG. |
| 382 | C |
| 383 | WRITE(CHMAIL,9000) C0,STEP |
| 384 | CALL GMAIL(0,0) |
| 385 | C |
| 386 | GO TO 99 |
| 387 | 920 CONTINUE |
| 388 | C |
| 389 | C +VE DEFINITE PARAMETER IN DIMENSION OF C0 SET -VE OR 0. |
| 390 | C |
| 391 | WRITE(CHMAIL,9010) |
| 392 | CALL GMAIL(0,0) |
| 393 | C |
| 394 | GO TO 99 |
| 395 | C |
| 396 | C NOT ENOUGH SPACE |
| 397 | C |
| 398 | 95 WRITE(CHMAIL,7000)NAME,MOTHER |
| 399 | CALL GMAIL(0,0) |
| 400 | C |
| 401 | 99 CONTINUE |
| 402 | 1000 FORMAT(' ***** GSDVT2 CALLED AND NO VOLUMES DEFINED *****') |
| 403 | 2000 FORMAT(' ***** GSDVT2 VOLUME ',A4,' ALREADY EXISTS *****') |
| 404 | 3000 FORMAT(' ***** GSDVT2 ROTATION MATRIX',I5,' DOES NOT EXIST *****') |
| 405 | 4000 FORMAT(' ***** GSDVT2 MOTHER ',A4,' ALREADY DIVIDED *****') |
| 406 | 5000 FORMAT(' ***** GSDVT2 BAD AXIS VALUE ',I5,' *****') |
| 407 | 6000 FORMAT(' ***** GSDVT2 BAD STEP SIZE ',E15.5,' *****') |
| 408 | 7000 FORMAT(' ***** GSDVT2 NOT ENOUGH SPACE TO STORE DIVISIONS ', |
| 409 | + ' IN ',A4,' *****') |
| 410 | 8000 FORMAT(' DIVIDE ACTION WITH C0 REQUESTED NOT SUPPORTED', |
| 411 | +' AT PRESENT.') |
| 412 | 8001 FORMAT(' ISH =',I5,' IAXIS =',I5) |
| 413 | 9000 FORMAT(' ***** GSDVT2 C0',E15.5,' OUT OF OBJECT', |
| 414 | +' OR STEP',E15.5,' TOO BIG *****') |
| 415 | 9010 FORMAT(' ATTEMPT TO SPECIFY C0 WHEN APPROPRIATE DIMENSION', |
| 416 | +' OF THE MOTHER IS DEFINED -VE (TO BE SELECTED AT RUN TIME)') |
| 417 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame