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