GEANT321/gxint/gxobj.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:50  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.33  by  S.Giani
  11 *-- Author :
  12 *
  13       SUBROUTINE GXOBJ(BRCLAS,BRNAME,BRPATH,OBNAME,OBCLAS,STEXT,LTEXT)
  14 *
  15 ***********************************************************************
  16 *                                                                     *
  17 *      This routine scans the Geant data structures to return each    *
  18 *       time the next object found. It is used in the new user in-    *
  19 *       terface based on KUIP-MOTIF.                                  *
  20 *                                                                     *
  21 *      Author :    S. Giani     ********************                  *
  22 *                                                                     *
  23 ***********************************************************************
  24 *
  25 #include "geant321/gcbank.inc"
  26 #include "geant321/gcunit.inc"
  27 #include "geant321/gcnum.inc"
  28 #include "geant321/gcflag.inc"
  29 #include "geant321/gcdraw.inc"
  30 *
  31       CHARACTER*(*) BRCLAS,BRNAME,BRPATH,OBNAME,OBCLAS,STEXT,LTEXT
  32       CHARACTER*4 NAMV,NAMS,IUSET,IUDET
  33       CHARACTER*20 NATMED,NAPART,NAMM
  34       DIMENSION UBUF(1),VBUF(10),WBUF(10)
  35       SAVE IDPOIN,ISET
  36 *
  37       IF(OBNAME.EQ.' ')IDPOIN=0
  38 *
  39       IF(BRCLAS.EQ.'VOLU')THEN
  40          IDPOIN=IDPOIN+1
  41          IF(IDPOIN.EQ.(NVOLUM+1))THEN
  42             IDPOIN=0
  43             OBNAME=' '
  44          ELSE
  45             CALL GFVOLU(IDPOIN,NAMV,NAMS)
  46             OBNAME=NAMV
  47             OBCLAS=NAMS
  48             WRITE(STEXT,'(I12)') IDPOIN
  49             LTEXT=OBCLAS
  50          ENDIF
  51       ELSEIF(BRCLAS.EQ.'MATE')THEN
  52    10    CONTINUE
  53          IDPOIN=IDPOIN+1
  54          IF(IDPOIN.EQ.(NMATE+1))THEN
  55             IDPOIN=0
  56             OBNAME=' '
  57          ELSE
  58             CALL GFMATE(IDPOIN,NAMM,A,Z,DENS,RADL,ABSL,UBUF,NWBUF)
  59             JMA = LQ(JMATE-IDPOIN)
  60             IFF = Q(JMA+11)
  61             IF(A.GE.0.)THEN
  62                OBNAME=NAMM
  63                IF(IFF.LE.1)THEN
  64                   OBCLAS='Elem'
  65                ELSE
  66                   OBCLAS='Mixt'
  67                ENDIF
  68                WRITE(STEXT,'(I12)') IDPOIN
  69                LTEXT=OBCLAS
  70             ELSE
  71                GOTO 10
  72             ENDIF
  73          ENDIF
  74       ELSEIF(BRCLAS.EQ.'TMED')THEN
  75    20    CONTINUE
  76          IDPOIN=IDPOIN+1
  77          IF(IDPOIN.EQ.(NTMED+1))THEN
  78             IDPOIN=0
  79             OBNAME=' '
  80          ELSE
  81             CALL GFTMED(IDPOIN,NATMED,NMAT,ISVOL,IFIELD,FIELDM, TMAXFD,
  82      +      STEMAX,DEEMAX,EPSIL,STMIN,UBUF,NWBUF)
  83             IF(NMAT.NE.0)THEN
  84                OBNAME=NATMED
  85                OBCLAS='Med'
  86                WRITE(STEXT,'(I12)') IDPOIN
  87                LTEXT=OBCLAS
  88             ELSE
  89                GOTO 20
  90             ENDIF
  91          ENDIF
  92       ELSEIF(BRCLAS.EQ.'PART')THEN
  93    30    CONTINUE
  94          IDPOIN=IDPOIN+1
  95          IF(IDPOIN.EQ.(NPART+1))THEN
  96             IDPOIN=0
  97             OBNAME=' '
  98          ELSE
  99             CALL GFPART(IDPOIN,NAPART,ITRTYP,AMASS,CHARGE,TLIFE,
 100      +      VBUF,NWBUF)
 101             IF(ITRTYP.NE.0)THEN
 102                OBNAME=NAPART
 103                OBCLAS='Part'
 104                WRITE(STEXT,'(I12)') IDPOIN
 105                LTEXT=OBCLAS
 106             ELSE
 107                GOTO 30
 108             ENDIF
 109          ENDIF
 110       ELSEIF(BRCLAS.EQ.'KINE')THEN
 111    40    CONTINUE
 112          IDPOIN=IDPOIN+1
 113          IF(IDPOIN.EQ.(NTRACK+1))THEN
 114             IDPOIN=0
 115             OBNAME=' '
 116          ELSE
 117             CALL GFKINE(IDPOIN,VERT,PVERT,IPART,NVERT,WBUF,NWBUF)
 118             IF(IPART.NE.0)THEN
 119                WRITE(OBNAME,'(I12)') IDPOIN
 120                OBCLAS='Kine'
 121                WRITE(STEXT,'(I12)') IDPOIN
 122                LTEXT=OBCLAS
 123             ELSE
 124                GOTO 40
 125             ENDIF
 126          ENDIF
 127       ELSEIF(BRCLAS.EQ.'HITS')THEN
 128         IF(BRPATH.EQ.' ')THEN
 129          IF(JSET.NE.0)THEN
 130            NSET=IQ(JSET-1)
 131          ELSE
 132            NSET=0
 133          ENDIF
 134    45    CONTINUE
 135          IDPOIN=IDPOIN+1
 136          IF(IDPOIN.EQ.(NSET+1))THEN
 137             IDPOIN=0
 138             OBNAME=' '
 139          ELSE
 140             CALL UHTOC(IQ(JSET+IDPOIN),4,IUSET,4)
 141             CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET)
 142             IF(ISET.NE.0)THEN
 143                OBNAME=IUSET
 144                OBCLAS='Hitset'
 145                WRITE(STEXT,'(I12)') IDPOIN
 146                LTEXT=OBCLAS
 147             ELSE
 148                GOTO 45
 149             ENDIF
 150          ENDIF
 151         ELSE
 152          IF(JSET.NE.0)THEN
 153            NSET=IQ(JSET-1)
 154            IUSET=BRPATH(2:5)
 155            CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET)
 156            NDET=IQ(LQ(JSET-ISET)-1)
 157          ELSE
 158            NDET=0
 159          ENDIF
 160    46    CONTINUE
 161          IDPOIN=IDPOIN+1
 162          IF(IDPOIN.EQ.(NDET+1))THEN
 163             IDPOIN=0
 164             OBNAME=' '
 165          ELSE
 166             CALL UHTOC(IQ(LQ(JSET-ISET)+IDPOIN),4,IUDET,4)
 167             CALL GLOOK(IUDET,IQ(LQ(JSET-ISET)+1),NDET,IDET)
 168             IF(IDET.NE.0)THEN
 169                OBNAME=IUDET
 170                OBCLAS='Hitdet'
 171                WRITE(STEXT,'(I12)') IDPOIN
 172                LTEXT=OBCLAS
 173             ELSE
 174                GOTO 46
 175             ENDIF
 176          ENDIF
 177         ENDIF
 178       ELSEIF(BRCLAS.EQ.'ROTM')THEN
 179    50    CONTINUE
 180          IDPOIN=IDPOIN+1
 181          IF((IDPOIN.EQ.(IQ(JROTM-2)+1)).OR.JROTM.LE.0)THEN
 182             IDPOIN=0
 183             OBNAME=' '
 184          ELSE
 185             JR=LQ(JROTM-IDPOIN)
 186             IF(JR.GT.0)THEN
 187                WRITE(OBNAME,'(I12)') IDPOIN
 188                OBCLAS='Rmatr'
 189                WRITE(STEXT,'(I12)') IDPOIN
 190                LTEXT=OBCLAS
 191             ELSE
 192                GOTO 50
 193             ENDIF
 194          ENDIF
 195       ELSEIF(BRCLAS.EQ.'VIEW')THEN
 196          IDPOIN=IDPOIN+1
 197          IF(IDPOIN.EQ.(NKVIEW+1))THEN
 198             IDPOIN=0
 199             OBNAME=' '
 200          ELSE
 201             WRITE(OBNAME,'(I12)') IDPOIN
 202             OBCLAS='VB'
 203             WRITE(STEXT,'(I12)') IDPOIN
 204             LTEXT=OBCLAS
 205          ENDIF
 206       ELSE
 207          PRINT*,'BRCLAS NOT VALID'
 208       ENDIF
 209 *
 210       END