GEANT321/gxint/gxgeom.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:21  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.2  1996/04/30 11:25:57  ravndal
   9 * Implicit Fortran data type convention overlooked
  10 *
  11 * Revision 1.1.1.1  1995/10/24 10:21:50  cernlib
  12 * Geant
  13 *
  14 *
  15 #include "geant321/pilot.h"
  16 *CMZ :  3.21/04 17/01/95  18.01.49  by  S.Giani
  17 *-- Author :
  18       SUBROUTINE GXGEOM
  19 C.
  20 C.    ******************************************************************
  21 C.    *                                                                *
  22 C.    *      Geometry commands                                         *
  23 C.    *                                                                *
  24 C.    *       Authors:   R.Brun      **********                        *
  25 C.    *                  P.Zanarini  **********                        *
  26 C.    *                  N.Hoimyr 1992    **********                   *
  27 C.    *                  S.Giani  1992    **********                   *
  28 C.    *                                                                *
  29 C.    ******************************************************************
  30 C.
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/pawc.inc"
  33 #include "geant321/gcunit.inc"
  34 #include "geant321/gcnum.inc"
  35 #include "geant321/gclist.inc"
  36 #include "geant321/gconsp.inc"
  37       CHARACTER*4 CHNAME,CHISH,CHPAR,IONLY,CYESNO,CHAX
  38       CHARACTER*32 CHPATL,VNAME
  39       CHARACTER*24 FNAME
  40       CHARACTER*4 ANAME
  41       CHARACTER*24 INST,SITE,DEPT,RESP
  42       DIMENSION ARRAY(100),UBUF(1)
  43       DATA UBUF/1./
  44 C.
  45 C.    ------------------------------------------------------------------
  46 C.
  47       IWKSTY = IGIWTY(1)
  48       CALL KUPATL(CHPATL,NPAR)
  49 *
  50       IF(CHPATL.EQ.'OPTI') THEN
  51          CALL KUGETI(IOPT)
  52          CALL GOPTIM(IOPT)
  53       ELSEIF (CHPATL.EQ.'SVOLU') THEN
  54          CALL KUGETC(CHNAME,NCH)
  55          CALL KUGETC(CHISH,NCH)
  56          CALL KUGETI(NUMED)
  57          CALL KUGETI(NP)
  58          CALL KUGETV(VNAME,LPAR,LLL)
  59          CALL GSVOLU(CHNAME,CHISH,NUMED,QQ(LPAR),NP,IVOLU)
  60 *
  61       ELSEIF (CHPATL.EQ.'SPOS') THEN
  62          CALL KUGETC(CHNAME,NCH)
  63          CALL KUGETI(N)
  64          CALL KUGETC(CHPAR,NCH)
  65          CALL KUGETR(X0)
  66          CALL KUGETR(Y0)
  67          CALL KUGETR(Z0)
  68          CALL KUGETI(IROT)
  69          CALL KUGETC(IONLY,NCH)
  70          CALL GSPOS(CHNAME,N,CHPAR,X0,Y0,Z0,IROT,IONLY)
  71 *
  72       ELSEIF (CHPATL.EQ.'SDVN') THEN
  73          CALL KUGETC(CHNAME,NCH)
  74          CALL KUGETC(CHPAR,NCH)
  75          CALL KUGETI(NDIV)
  76          CALL KUGETC(CHAX,NCH)
  77          IF (CHAX.EQ.'X'.OR.CHAX.EQ.'1') THEN
  78             IAX=1
  79          ELSEIF (CHAX.EQ.'Y'.OR.CHAX.EQ.'2') THEN
  80             IAX=2
  81          ELSEIF (CHAX.EQ.'Z'.OR.CHAX.EQ.'3') THEN
  82             IAX=3
  83          ENDIF
  84          IF(IAX.LE.3.AND.IAX.GE.1) THEN
  85             CALL GSDVN(CHNAME,CHPAR,NDIV,IAX)
  86          ELSE
  87             WRITE(CHMAIL,10000)
  88 10000       FORMAT(' *** GXGEOM *** Wrong value of IAX')
  89             CALL GMAIL(0,0)
  90          ENDIF
  91 *
  92       ELSEIF (CHPATL.EQ.'PVOLU') THEN
  93          CALL KUGETI(NUMB)
  94          IF(IWKSTY.GE.1.AND.IWKSTY.LE.10) THEN
  95             CALL GPVOLX(NUMB)
  96          ELSE
  97             CALL GPVOLU(NUMB)
  98          ENDIF
  99 *
 100       ELSEIF (CHPATL.EQ.'SROTM') THEN
 101          CALL KUGETI(N)
 102          CALL KUGETR(THETA1)
 103          CALL KUGETR(PHI1)
 104          CALL KUGETR(THETA2)
 105          CALL KUGETR(PHI2)
 106          CALL KUGETR(THETA3)
 107          CALL KUGETR(PHI3)
 108          CALL GSROTM(N,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
 109 *
 110       ELSEIF (CHPATL.EQ.'PROTM') THEN
 111          CALL KUGETI(NUMB)
 112          IF(IWKSTY.GE.1.AND.IWKSTY.LE.10) THEN
 113             CALL GPROTX(NUMB)
 114          ELSE
 115             CALL GPROTM(NUMB)
 116          ENDIF
 117 *
 118       ELSEIF (CHPATL.EQ.'STMED') THEN
 119          NMED=1
 120          NMAT=1
 121          IFIELD=0
 122          EPSIL=0.01
 123          ISVOL=0
 124          FIELDM=0.
 125          TMAXFD=0.01
 126          STEMAX=BIG
 127          DEEMAX=0.01
 128          STMIN=0.1
 129          CALL KUGETI(NMED)
 130          CALL KUGETC(VNAME,NCH)
 131          CALL KUGETI(NMAT)
 132          CALL KUGETI(ISVOL)
 133          CALL KUGETI(IFIELD)
 134          CALL KUGETR(FIELDM)
 135          CALL KUGETR(TMAXFD)
 136          CALL KUGETR(STEMAX)
 137          CALL KUGETR(DEEMAX)
 138          CALL KUGETR(EPSIL)
 139          CALL KUGETR(STMIN)
 140          CALL GSTMED(NMED,VNAME,NMAT,ISVOL,IFIELD,FIELDM,TMAXFD,
 141      +   STEMAX,DEEMAX,EPSIL,STMIN,UBUF,0)
 142 *
 143       ELSEIF (CHPATL.EQ.'PTMED') THEN
 144          CALL KUGETI(NUMB)
 145          IF(IWKSTY.GE.1.AND.IWKSTY.LE.10) THEN
 146             CALL GPTMEX(NUMB)
 147          ELSE
 148             CALL GPTMED(NUMB)
 149          ENDIF
 150 *
 151       ELSEIF (CHPATL.EQ.'EDITV') THEN
 152          CALL KUGETI(NUM)
 153          IF(NUM.LE.0)THEN
 154             CALL GGCLOS
 155          ELSE
 156             CALL GEDITV(NUM)
 157          ENDIF
 158 *
 159       ELSEIF(CHPATL.EQ.'SBOX') THEN
 160          CALL KUGETC(CHNAME,NCH)
 161          CALL KUGETI(NUMED)
 162          CALL KUGETR(HALFX)
 163          CALL KUGETR(HALFY)
 164          CALL KUGETR(HALFZ)
 165          CALL KUGETC(CYESNO,NCHAR)
 166          ARRAY(1)=HALFX
 167          ARRAY(2)=HALFY
 168          ARRAY(3)=HALFZ
 169          IF(CYESNO.EQ.'YES')THEN
 170             NUMP=0
 171          ELSE
 172             NUMP=3
 173          ENDIF
 174          CALL GSVOLU(CHNAME,'BOX ',NUMED,ARRAY,NUMP,IVOLU)
 175 *
 176       ELSEIF(CHPATL.EQ.'STRD1') THEN
 177          CALL KUGETC(CHNAME,NCH)
 178          CALL KUGETI(NUMED)
 179          CALL KUGETR(HLFDWX)
 180          CALL KUGETR(HLFUPX)
 181          CALL KUGETR(HALFY)
 182          CALL KUGETR(HALFZ)
 183          CALL KUGETC(CYESNO,NCHAR)
 184          ARRAY(1)=HLFDWX
 185          ARRAY(2)=HLFUPX
 186          ARRAY(3)=HALFY
 187          ARRAY(4)=HALFZ
 188          IF(CYESNO.EQ.'YES')THEN
 189             NUMP=0
 190          ELSE
 191             NUMP=4
 192          ENDIF
 193          CALL GSVOLU(CHNAME,'TRD1',NUMED,ARRAY,NUMP,IVOLU)
 194 *
 195       ELSEIF(CHPATL.EQ.'STRD2') THEN
 196          CALL KUGETC(CHNAME,NCH)
 197          CALL KUGETI(NUMED)
 198          CALL KUGETR(HLFDWX)
 199          CALL KUGETR(HLFUPX)
 200          CALL KUGETR(HLFDWY)
 201          CALL KUGETR(HLFUPY)
 202          CALL KUGETR(HALFZ)
 203          CALL KUGETC(CYESNO,NCHAR)
 204          ARRAY(1)=HLFDWX
 205          ARRAY(2)=HLFUPX
 206          ARRAY(3)=HLFDWY
 207          ARRAY(4)=HLFUPY
 208          ARRAY(5)=HALFZ
 209          IF(CYESNO.EQ.'YES')THEN
 210             NUMP=0
 211          ELSE
 212             NUMP=5
 213          ENDIF
 214          CALL GSVOLU(CHNAME,'TRD2',NUMED,ARRAY,NUMP,IVOLU)
 215 *
 216       ELSEIF(CHPATL.EQ.'STUBE') THEN
 217          CALL KUGETC(CHNAME,NCH)
 218          CALL KUGETI(NUMED)
 219          CALL KUGETR(XINRAD)
 220          CALL KUGETR(OUTRAD)
 221          CALL KUGETR(HALFZ)
 222          CALL KUGETC(CYESNO,NCHAR)
 223          ARRAY(1)=XINRAD
 224          ARRAY(2)=OUTRAD
 225          ARRAY(3)=HALFZ
 226          IF(CYESNO.EQ.'YES')THEN
 227             NUMP=0
 228          ELSE
 229             NUMP=3
 230          ENDIF
 231          CALL GSVOLU(CHNAME,'TUBE',NUMED,ARRAY,NUMP,IVOLU)
 232 *
 233       ELSEIF(CHPATL.EQ.'STUBS') THEN
 234          CALL KUGETC(CHNAME,NCH)
 235          CALL KUGETI(NUMED)
 236          CALL KUGETR(XINRAD)
 237          CALL KUGETR(OUTRAD)
 238          CALL KUGETR(HALFZ)
 239          CALL KUGETR(SPHI)
 240          CALL KUGETR(EPHI)
 241          CALL KUGETC(CYESNO,NCHAR)
 242          ARRAY(1)=XINRAD
 243          ARRAY(2)=OUTRAD
 244          ARRAY(3)=HALFZ
 245          ARRAY(4)=SPHI
 246          ARRAY(5)=EPHI
 247          IF(CYESNO.EQ.'YES')THEN
 248             NUMP=0
 249          ELSE
 250             NUMP=5
 251          ENDIF
 252          CALL GSVOLU(CHNAME,'TUBS',NUMED,ARRAY,NUMP,IVOLU)
 253 *
 254       ELSEIF(CHPATL.EQ.'SCONE') THEN
 255          CALL KUGETC(CHNAME,NCH)
 256          CALL KUGETI(NUMED)
 257          CALL KUGETR(XINRDW)
 258          CALL KUGETR(OUTRDW)
 259          CALL KUGETR(XINRUP)
 260          CALL KUGETR(OUTRUP)
 261          CALL KUGETR(HALFZ)
 262          CALL KUGETC(CYESNO,NCHAR)
 263          ARRAY(1)=XINRDW
 264          ARRAY(2)=OUTRDW
 265          ARRAY(3)=XINRUP
 266          ARRAY(4)=OUTRUP
 267          ARRAY(5)=HALFZ
 268          IF(CYESNO.EQ.'YES')THEN
 269             NUMP=0
 270          ELSE
 271             NUMP=5
 272          ENDIF
 273          CALL GSVOLU(CHNAME,'CONE',NUMED,ARRAY,NUMP,IVOLU)
 274 *
 275       ELSEIF(CHPATL.EQ.'SCONS') THEN
 276          CALL KUGETC(CHNAME,NCH)
 277          CALL KUGETI(NUMED)
 278          CALL KUGETR(XINRDW)
 279          CALL KUGETR(OUTRDW)
 280          CALL KUGETR(XINRUP)
 281          CALL KUGETR(OUTRUP)
 282          CALL KUGETR(HALFZ)
 283          CALL KUGETR(SPHI)
 284          CALL KUGETR(EPHI)
 285          CALL KUGETC(CYESNO,NCHAR)
 286          ARRAY(1)=XINRDW
 287          ARRAY(2)=OUTRDW
 288          ARRAY(3)=XINRUP
 289          ARRAY(4)=OUTRUP
 290          ARRAY(5)=HALFZ
 291          ARRAY(6)=SPHI
 292          ARRAY(7)=EPHI
 293          IF(CYESNO.EQ.'YES')THEN
 294             NUMP=0
 295          ELSE
 296             NUMP=7
 297          ENDIF
 298          CALL GSVOLU(CHNAME,'CONS',NUMED,ARRAY,NUMP,IVOLU)
 299 *
 300       ELSEIF(CHPATL.EQ.'SSPHE') THEN
 301          CALL KUGETC(CHNAME,NCH)
 302          CALL KUGETI(NUMED)
 303          CALL KUGETR(XINRAD)
 304          CALL KUGETR(OUTRAD)
 305          CALL KUGETR(SPHI)
 306          CALL KUGETR(EPHI)
 307          CALL KUGETR(STHETA)
 308          CALL KUGETR(ETHETA)
 309          CALL KUGETC(CYESNO,NCHAR)
 310          ARRAY(1)=XINRAD
 311          ARRAY(2)=OUTRAD
 312          ARRAY(3)=SPHI
 313          ARRAY(4)=EPHI
 314          ARRAY(5)=STHETA
 315          ARRAY(6)=ETHETA
 316          IF(CYESNO.EQ.'YES')THEN
 317             NUMP=0
 318          ELSE
 319             NUMP=6
 320          ENDIF
 321          CALL GSVOLU(CHNAME,'SPHE',NUMED,ARRAY,NUMP,IVOLU)
 322 *
 323       ELSEIF(CHPATL.EQ.'SPARA') THEN
 324          CALL KUGETC(CHNAME,NCH)
 325          CALL KUGETI(NUMED)
 326          CALL KUGETR(HALFX)
 327          CALL KUGETR(HALFY)
 328          CALL KUGETR(HALFZ)
 329          CALL KUGETR(AXIS)
 330          CALL KUGETR(PHI)
 331          CALL KUGETR(THETA)
 332          CALL KUGETC(CYESNO,NCHAR)
 333          ARRAY(1)=HALFX
 334          ARRAY(2)=HALFY
 335          ARRAY(3)=HALFZ
 336          ARRAY(4)=AXIS
 337          ARRAY(5)=PHI
 338          ARRAY(6)=THETA
 339          IF(CYESNO.EQ.'YES')THEN
 340             NUMP=0
 341          ELSE
 342             NUMP=6
 343          ENDIF
 344          CALL GSVOLU(CHNAME,'PARA',NUMED,ARRAY,NUMP,IVOLU)
 345 *
 346       ELSEIF (CHPATL.EQ.'CADINT') THEN
 347          CALL KUGETS(FNAME,NCH)
 348          CALL KUGETC(ANAME,NCH)
 349          CALL KUGETI(NBINS)
 350          CALL KUGETI(LUNIT)
 351          CALL KUGETI(LUNIT2)
 352          CALL KUGETS(INST,NCH)
 353          CALL KUGETS(SITE,NCH)
 354          CALL KUGETS(DEPT,NCH)
 355          CALL KUGETS(RESP,NCH)
 356          CALL GTXSET(FNAME,ANAME,NBINS,LUNIT,LUNIT2,
 357      +INST,SITE,DEPT,RESP)
 358 *
 359       ELSEIF (CHPATL.EQ.'WEUCLID') THEN
 360          CALL KUGETI(LUN)
 361          CALL KUGETS(FNAME,NCH)
 362          CALL KUGETC(CHNAME,NCH1)
 363          CALL KUGETI(NUMBER)
 364          CALL KUGETI(NLEVEL)
 365          CALL GWEUCL (LUN,FNAME(1:NCH),CHNAME,NUMBER,NLEVEL)
 366 *
 367       ELSEIF (CHPATL.EQ.'REUCLID') THEN
 368          CALL KUGETI(LUN)
 369          CALL KUGETS(FNAME,NCH)
 370          CALL GREUCL (LUN,FNAME(1:NCH))
 371 *
 372       ENDIF
 373 *
 374       END