GEANT321/ggeom/gsdvn2.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 GSDVN2(KNAME,MOTHER,NDIV,IAXIS,C0I,NUMED)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *       DIVIDES MOTHER INTO NDIV DIVISIONS CALLED NAME           *
  20 C.    *       ALONG AXIS IAXIS STARTING AT COORDINATE VALUE C0.        *
  21 C.    *       THE NEW VOLUME CREATED WILL BE MEDIUM NUMBER NUMED.      *
  22 C.    *                                                                *
  23 C.    *          JVO=POINTER TO MOTHER VOLUME                          *
  24 C.    *          JDIV=LQ(JVO-1)                                        *
  25 C.    *                                                                *
  26 C.    *            Q(JDIV+1)=IAXIS                                     *
  27 C.    *            Q(JDIV+2)=VOLUME NUMBER                             *
  28 C.    *            Q(JDIV+3)=NDIV                                      *
  29 C.    *            Q(JDIV+4)=C0                                        *
  30 C.    *            Q(JDIV+5)=STEP SIZE IN COORDINATES.                 *
  31 C.    *                                                                *
  32 C.    *    ==>Called by : <USER>, GSDVX                                *
  33 C.    *         Authors F.Bruyant,   A.McPherson  *********            *
  34 C.    *                                                                *
  35 C.    ******************************************************************
  36 C.
  37 #include "geant321/gcbank.inc"
  38 #include "geant321/gcflag.inc"
  39 #include "geant321/gcnum.inc"
  40 #include "geant321/gcunit.inc"
  41 #include "geant321/gcdraw.inc"
  42 #include "geant321/gcshno.inc"
  43       CHARACTER*4 KNAME,MOTHER
  44       DIMENSION PAR(100),ATT(20)
  45       SAVE ATT
  46       DATA ATT /1.,1.,1.,1.,1.,15*0./
  47 C.
  48 C.    ------------------------------------------------------------------
  49 C.
  50 C              CHECK IF VOLUME MASTER BANK EXISTS
  51 C
  52       CALL UCTOH(KNAME,NAME,4,4)
  53       IF(JVOLUM.GT.0)GO TO 10
  54       WRITE(CHMAIL,1000)
  55       CALL GMAIL(0,0)
  56       GO TO 99
  57 C
  58 C              CHECK IF MOTHER VOLUME EXISTS
  59 C
  60   10  CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO)
  61       IF(IVO.GT.0)GO TO 20
  62       WRITE(CHMAIL,2000)MOTHER
  63       CALL GMAIL(0,0)
  64       GO TO 99
  65 C
  66 C              CHECK IF NAME VOLUME EXISTS
  67 C
  68   20  CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IN)
  69       IF(IN.LE.0)GO TO 50
  70       WRITE(CHMAIL,2000)NAME
  71       CALL GMAIL(0,0)
  72       GO TO 99
  73 C
  74 C              CHECK IF MOTHER IS NOT DIVIDED
  75 C
  76   50  JVO=LQ(JVOLUM-IVO)
  77       NIN=Q(JVO+3)
  78       IF(NIN.EQ.0)GO TO 60
  79       WRITE(CHMAIL,4000)MOTHER
  80       CALL GMAIL(0,0)
  81       GO TO 99
  82 C
  83 C              CHECK VALIDITY OF AXIS VALUE
  84 C
  85   60  IF(IAXIS.GT.0.AND.IAXIS.LT.4)GO TO 70
  86       WRITE(CHMAIL,5000)IAXIS
  87       CALL GMAIL(0,0)
  88       GO TO 99
  89 C
  90 C              CHECK VALIDITY OF NDIV
  91 C
  92   70  IF(NDIV.GT.0)GO TO 80
  93       WRITE(CHMAIL,6000)NDIV
  94       CALL GMAIL(0,0)
  95       GO TO 99
  96 C
  97 C               CREATE BANK TO STORE DIVISION PARAMETERS
  98 C
  99   80  CALL MZBOOK(IXCONS,JDIV,JVO,-1,'VODI',0,0,6,3,0)
 100       IF(IEOTRI.NE.0)GO TO 95
 101       IQ(JDIV-5)=IVO
 102 C
 103 C               NOW STORE PARAMETERS INTO BANK AREA
 104 C
 105   90  Q(JDIV+1)=IAXIS
 106       Q(JDIV+2)=NVOLUM+1
 107       Q(JDIV+3)=NDIV
 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 FIND AND STORE STEP.
 115 C
 116       ISH=Q(JVO+2)
 117       C0 = C0I
 118       IF(ISH.NE.1) GO TO 100
 119 C
 120 C               BOX
 121 C
 122       IF(PAR(IAXIS).LE.0.0) GO TO 920
 123       IF(ABS(C0).GT.PAR(IAXIS)) GO TO 910
 124       STEP=(PAR(IAXIS)-C0)/NDIV
 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       STEP=(PAR(IAXIS+1)-C0)/NDIV
 137       PAR(1)=-1.
 138       PAR(2)=-1.
 139       PAR(IAXIS+1)=STEP/2.
 140       GO TO 210
 141 C
 142   110 CONTINUE
 143       IF(ISH.NE.3) GO TO 120
 144 C
 145 C              TRAPEZOID WITH BOTH X AND Y THICKNESSES VARYING WITH
 146 C              Z
 147 C
 148       IF(IAXIS.NE.3) GO TO 900
 149       IF(PAR(5).LE.0.0) GO TO 920
 150       IF(ABS(C0).GT.PAR(5)) GO TO 910
 151       STEP=(PAR(5)-C0)/NDIV
 152       PAR(1)=-1.
 153       PAR(2)=-1.
 154       PAR(3)=-1.
 155       PAR(4)=-1.
 156       PAR(5)=STEP/2.
 157       GO TO 210
 158 C
 159   120 CONTINUE
 160       IF(ISH.NE.4) GO TO 125
 161       IF(IAXIS.NE.3) GO TO 126
 162       IF(PAR(1).LE.0.0) GO TO 920
 163       IF(ABS(C0).GT.PAR(1)) GO TO 910
 164       STEP=(PAR(1)-C0)/NDIV
 165       PAR(1)=STEP*0.5
 166       PAR(4)=-1.0
 167       PAR(5)=-1.0
 168       PAR(6)=-1.0
 169       PAR(8)=-1.0
 170       PAR(9)=-1.0
 171       PAR(10)=-1.0
 172       GO TO 210
 173 C
 174   126 IF(IAXIS.NE.2) GO TO 900
 175       IF(MOD(PAR(3),180.).EQ.0.) GO TO 127
 176       WRITE(CHMAIL,10100)
 177 10100 FORMAT(' Division of TRAP ',A4,
 178      +    ' along Y only possible when PHI=0,180')
 179       CALL GMAIL(0,0)
 180       GOTO 99
 181   127 IF(PAR(4).EQ.PAR(8))  GO TO 128
 182       WRITE(CHMAIL,10200)
 183 10200 FORMAT(' Division of TRAP ',A4,
 184      +    ' along Y only possible when H1=H2')
 185       CALL GMAIL(0,0)
 186       GOTO 99
 187   128 CONTINUE
 188       IF(PAR(4).LE.0.) GO TO 920
 189       IF(ABS(C0).GT.PAR(4)) GO TO 910
 190       STEP = (PAR(4)-C0)/NDIV
 191       PAR(4) = 0.5*STEP
 192       PAR(5) = -1.
 193       PAR(6) = -1.
 194       PAR(8) = 0.5*STEP
 195       PAR(9) = -1.
 196       PAR(10) = -1.
 197 C
 198       GO TO 210
 199 C
 200   125 CONTINUE
 201       IF(ISH.NE.5.AND.ISH.NE.6.AND.ISH.NE.NSCTUB) GO TO 160
 202 C
 203 C              Tube, tube segment or cut tube.
 204 C
 205       IF(IAXIS.NE.3) GO TO 130
 206       IF(PAR(3).LE.0.0) GO TO 920
 207       IF(ABS(C0).GT.PAR(3)) GO TO 910
 208       STEP=(PAR(3)-C0)/NDIV
 209       PAR(3)=STEP/2.
 210       GO TO 210
 211 C
 212   130 CONTINUE
 213       IF(IAXIS.NE.1) GO TO 140
 214       IF(PAR(1).LE.0.0.OR.PAR(2).LE.0.0) GO TO 920
 215       IF(C0.LT.PAR(1).OR.C0.GT.PAR(2)) GO TO 910
 216       STEP=(PAR(2)-C0)/NDIV
 217       PAR(1)=-1.
 218       PAR(2)=-1.
 219       GO TO 210
 220 C
 221   140 CONTINUE
 222       IF(ISH.EQ.6) GO TO 150
 223       NW=NW+2
 224       ISH=6
 225       STEP=360.0/NDIV
 226       NPAR=5
 227       PAR(4)=-STEP/2.
 228       PAR(5)=STEP/2.
 229       GO TO 210
 230 C
 231   150 CONTINUE
 232       DP=PAR(5)-PAR(4)
 233       DC0P = C0-PAR(4)
 234       SG = SIGN(1.0,DC0P)
 235       DC0P = MOD( ABS(DC0P), 360.0)
 236       IF(SG.LE.0.0) DC0P = 360.0-DC0P
 237       C0 = PAR(4)+DC0P
 238       IF(C0-PAR(4).LT.0.0) C0=C0+360.0
 239       IF(C0-PAR(4).GT.DP) GO TO 910
 240       DP=PAR(5)-C0
 241       IF(DP.LT.0.0) DP=DP+360
 242       STEP=DP/NDIV
 243       PAR(4)=-STEP/2.
 244       PAR(5)=STEP/2.
 245       GO TO 210
 246 C
 247   160 CONTINUE
 248 C
 249       IF(ISH.NE.7.AND.ISH.NE.8) GO TO 190
 250       IF(IAXIS.EQ.1) GO TO 165
 251       IF(IAXIS.NE.3) GO TO 170
 252 C
 253       IF(PAR(1).LE.0.0) GO TO 920
 254       IF(ABS(C0).GT.PAR(1)) GO TO 910
 255       STEP=(PAR(1)-C0)/NDIV
 256       PAR(1)=STEP*0.5
 257 C
 258   165 CONTINUE
 259 C
 260       PAR(2)=-1.0
 261       PAR(3)=-1.0
 262       PAR(4)=-1.0
 263       PAR(5)=-1.0
 264       GO TO 210
 265 C
 266   170 CONTINUE
 267       IF(IAXIS.EQ.1) GO TO 210
 268 C
 269       IF(ISH.EQ.8) GO TO 180
 270       NW=NW+2
 271       ISH=8
 272       STEP=360.0/NDIV
 273       NPAR=7
 274       PAR(6)=-STEP/2.
 275       PAR(7)=STEP/2.
 276       GO TO 210
 277 C
 278   180 CONTINUE
 279       DP=PAR(7)-PAR(6)
 280       DC0P = C0-PAR(6)
 281       SG = SIGN(1.0,DC0P)
 282       DC0P = MOD( ABS(DC0P), 360.0)
 283       IF(SG.LE.0.0) DC0P = 360.0-DC0P
 284       C0 = PAR(6)+DC0P
 285       IF(C0-PAR(6).LT.0.0) C0=C0+360.0
 286       IF(C0-PAR(6).GT.DP) GO TO 910
 287       DP=PAR(7)-C0
 288       IF(DP.LT.0.0) DP=DP+360.0
 289       STEP=DP/NDIV
 290       PAR(6)=-STEP/2.
 291       PAR(7)=STEP/2.
 292       GO TO 210
 293 C
 294   190 CONTINUE
 295       IF(ISH.NE.9) GO TO 200
 296       IF(IAXIS.NE.1) GO TO 195
 297       PAR(1)=-1.0
 298       PAR(2)=-1.0
 299       IF(C0.LT.PAR(1).OR.C0.GT.PAR(2)) THEN
 300          GOTO 910
 301       ENDIF
 302       STEP = (PAR(2)-C0)/NDIV
 303       GOTO 210
 304   195 CONTINUE
 305       IF(IAXIS.NE.2) GO TO 196
 306       WRITE(CHMAIL,8102)
 307       CALL GMAIL(0,0)
 308       GOTO 99
 309 C
 310   196 CONTINUE
 311       IF(IAXIS.NE.3) GO TO 210
 312       ANGMIN = MOD(PAR(5),360.)
 313       IF(ANGMIN.LT.0.) ANGMIN=ANGMIN+360.
 314       ANGMAX = MOD(PAR(6),360.)
 315       IF(ANGMAX.LE.ANGMIN) ANGMAX=ANGMAX+360.
 316       C0 = MOD(C0,360.)
 317       IF(C0.LT.0.0) C0=C0+360.0
 318       IF(C0.GT.ANGMAX.OR.C0.LT.ANGMIN) GO TO 910
 319       STEP=(ANGMAX-C0)/NDIV
 320       PAR(3)=-1.
 321       PAR(4)=-1.
 322       PAR(5)=-0.5*STEP
 323       PAR(6)=0.5*STEP
 324       GO TO 210
 325 C
 326   200 CONTINUE
 327 C
 328       GO TO 900
 329 C
 330 C                NOW CREATE THE VOLUME FOR DIVISION
 331 C
 332  210  Q(JDIV+4)=C0
 333       Q(JDIV+5)=STEP
 334       NVOLUM=NVOLUM+1
 335       NVOL  =IQ(JVOLUM-2)
 336       IF(NVOLUM.GT.NVOL)CALL MZPUSH(IXCONS,JVOLUM,50,50,'I')
 337       CALL MZBOOK(IXCONS,JVO,JVOLUM,-NVOLUM,'VOL1',50,50,NW,3,0)
 338       IF(IEOTRI.NE.0)GO TO 95
 339       IQ(JVOLUM+NVOLUM)=NAME
 340 C
 341 C              COPY PARAMETERS IN DATA AREA
 342 C
 343       JVOM=LQ(JVOLUM-IVOM)
 344       CALL UCOPY(Q(JVOM+1),Q(JVO+1),NWM)
 345       CALL GSIPAR(JVO,0,NPAR,NATT,PAR,ATT)
 346       Q(JVO+2)=ISH
 347       Q(JVO+3)=0.
 348       Q(JVO+4)=NUMED
 349       GO TO 99
 350 C
 351   900 CONTINUE
 352 C
 353 C        DIVIDE ACTION NOT SUPPORTED.
 354 C
 355       WRITE(CHMAIL,8000)
 356       CALL GMAIL(0,0)
 357       WRITE(CHMAIL,8001) ISH,IAXIS
 358       CALL GMAIL(0,0)
 359 C
 360       GO TO 99
 361 C
 362   910 CONTINUE
 363 C
 364 C              C0 START OF DIVISION OUT OF OBJECT.
 365 C
 366       WRITE(CHMAIL,9000) C0
 367       CALL GMAIL(0,0)
 368 C
 369       GO TO 99
 370   920 CONTINUE
 371 C
 372 C              +VE DEFINITE PARAMETER IN DIMENSION OF C0 SET -VE OR 0.
 373 C
 374       WRITE(CHMAIL,9010)
 375       CALL GMAIL(0,0)
 376 C
 377       GO TO 99
 378 C
 379 C              NOT ENOUGH SPACE
 380 C
 381   95  WRITE(CHMAIL,7000)NAME,MOTHER
 382       CALL GMAIL(0,0)
 383 C
 384   99  CONTINUE
 385  1000 FORMAT(' ***** GSDVN2 CALLED AND NO VOLUMES DEFINED *****')
 386  2000 FORMAT(' ***** GSDVN2 VOLUME ',A4,' ALREADY EXISTS *****')
 387  3000 FORMAT(' ***** GSDVN2 ROTATION MATRIX',I5,' DOES NOT EXIST *****')
 388  4000 FORMAT(' ***** GSDVN2 MOTHER ',A4,' ALREADY DIVIDED *****')
 389  5000 FORMAT(' ***** GSDVN2 BAD AXIS VALUE ',I5,' *****')
 390  6000 FORMAT(' ***** GSDVN2 BAD NUMBER OF DIVISIONS ',I5,' *****')
 391  7000 FORMAT(' ***** GSDVN2 NOT ENOUGH SPACE TO STORE DIVISIONS ',
 392      +       ' IN ',A4,' *****')
 393  8000 FORMAT(' DIVIDE ACTION WITH C0 REQUESTED NOT SUPPORTED',
 394      +' AT PRESENT.')
 395  8001 FORMAT(' ISH =',I5,' IAXIS =',I5)
 396  8102 FORMAT(' DIVISION OF A SPHERE ALONG AXIS 2 NOT SUPPORTED')
 397  9000 FORMAT(' ***** GSDVN2 C0',E15.5,' OUT OF OBJECT *****')
 398  9010 FORMAT(' ***** GSDVN2 C0 WITH -VE DIMENSION IN MOTHER *****')
 399       END