GEANT321/giopa/grget.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:17  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.20  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GRGET (KEYSU,ID1,ID2,ID3,ICYCLE)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Routine to read  data structures from a RZ file          *
  17 C.    *                                                                *
  18 C.    *       KEYSU    Keyword to select data structure                *
  19 C.    *       ID1      First  RZ KEY identifier (ex IDRUN)             *
  20 C.    *       ID2      Second RZ KEY identifier (ex IDEVT)             *
  21 C.    *       ID3      Third  RZ KEY identifier (user free)            *
  22 C.    *       ICYCLE   Cycle number                                    *
  23 C.    *                                                                *
  24 C.    *    ==>Called by : <USER>, UGINIT,GUKINE                        *
  25 C.    *       Author    R.Brun  *********                              *
  26 C.    *                                                                *
  27 C.    ******************************************************************
  28 C.
  29 #include "geant321/gcbank.inc"
  30 #include "geant321/gcunit.inc"
  31 #include "geant321/gcflag.inc"
  32 #include "geant321/gcnum.inc"
  33 #include "geant321/gcdraw.inc"
  34 #include "geant321/gccuts.inc"
  35 C
  36       DIMENSION CUTVEC(10)
  37       EQUIVALENCE (CUTVEC,CUTGAM)
  38 C
  39       CHARACTER*4 KLEY(19)
  40       CHARACTER*4 KEYSU(1)
  41       DIMENSION KEYRZ(4)
  42       DIMENSION LINIT(8),LKINE(2),LTRIG(6)
  43       DIMENSION LKEY(19),LINK(10),JLINK(17),KSEL(17),IXD(17)
  44       EQUIVALENCE (JLINK(1),JDIGI)
  45       EQUIVALENCE (LKEY(18),KINIT),(LKEY(19),KTRIG),(LKEY(5),KKINE)
  46 C
  47       SAVE IFIRST,LKEY
  48       DATA KLEY/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART','ROTM'
  49      +         ,'RUNG','SETS','STAK','STAT','TMED','TRAC','VERT','VOLU'
  50      +         ,'JXYZ','INIT','TRIG'/
  51       DATA IXD/2,1,2,2,2,8*1,2,2,1,2/
  52       DATA LINIT/2,6,7,8,9,10,13,16/
  53       DATA LKINE/5,15/
  54       DATA LTRIG/1,3,4,5,15,17/
  55       DATA NLINIT/8/
  56       DATA NLKINE/2/
  57       DATA NLTRIG/6/
  58       DATA IFIRST/0/
  59 C.
  60 C.    ------------------------------------------------------------------
  61 C.
  62       IF(IFIRST.EQ.0)THEN
  63          IFIRST=1
  64          CALL UCTOH(KLEY,LKEY,4,76)
  65       ENDIF
  66 *
  67       WRITE(CHMAIL,10000)
  68       CALL GMAIL(0,0)
  69 10000 FORMAT(' *** GRGET *** Obsolete routine. Please use GRIN')
  70 C
  71       CALL UCTOH(KEYSU,KEY,4,4)
  72       CALL VZERO(KSEL,17)
  73 C
  74       IF(KEY.EQ.KINIT)THEN
  75          CALL UCOPY(LINIT,LINK,NLINIT)
  76          NLINK=NLINIT
  77       ELSEIF(KEY.EQ.KKINE)THEN
  78          CALL UCOPY(LKINE,LINK,NLKINE)
  79          NLINK=NLKINE
  80       ELSEIF(KEY.EQ.KTRIG)THEN
  81          CALL UCOPY(LTRIG,LINK,NLTRIG)
  82          NLINK=NLTRIG
  83       ELSE
  84          IL=IUCOMP(KEY,LKEY,17)
  85          IF(IL.EQ.0)GO TO 50
  86          LINK(1)=IL
  87          NLINK=1
  88       ENDIF
  89 C
  90 C               Read data structure(s)
  91 C
  92       KEYRZ(2)=ID1
  93       KEYRZ(3)=ID2
  94       KEYRZ(4)=ID3
  95 C
  96       DO 10 I=1,NLINK
  97          IL=LINK(I)
  98          IF(JLINK(IL).NE.0)THEN
  99             CALL MZDROP(IXCONS,JLINK(IL),' ')
 100             JLINK(IL)=0
 101          ENDIF
 102          KEYRZ(1)=LKEY(IL)
 103          IF(IXD(IL).NE.2)THEN
 104             IDIV=IXCONS
 105          ELSE
 106             IDIV=IXDIV
 107          ENDIF
 108          CALL RZIN(IDIV,JLINK(IL),1,KEYRZ,ICYCLE,' ')
 109          KSEL(IL)=1
 110    10 CONTINUE
 111 C
 112 C             Fill header bank
 113 C             Reconstruct NKVIEW,NVOLUM,NVERTX,NTRACK
 114 C             Reconstruct NMATE, NTMED, NPART
 115 C
 116       IF(KSEL(6).NE.0.AND.JMATE.GT.0) NMATE=IQ(JMATE-2)
 117       IF(KSEL(7).NE.0.AND.JPART.GT.0) NPART=IQ(JPART-2)
 118       IF(KSEL(13).NE.0.AND.JTMED.NE.0 ) THEN
 119          DO 20 J=1,10
 120             CUTVEC(J) = Q(JTMED+J)
 121    20    CONTINUE
 122          NTMED=IQ(JTMED-2)
 123       ENDIF
 124       IF(KSEL(16).NE.0.AND.JVOLUM.GT.0) THEN
 125          NVOLUM=0
 126          DO 30 J=1, IQ(JVOLUM-2)
 127             IF(LQ(JVOLUM-J).EQ.0) GO TO 40
 128             NVOLUM=NVOLUM+1
 129    30    CONTINUE
 130    40    CONTINUE
 131       END IF
 132       IF(KSEL( 2).NE.0.AND.JDRAW.GT.0 ) NKVIEW=IQ(JDRAW-2)
 133 C
 134       IF(JHEAD.GT.0)THEN
 135          IDRUN=IQ(JHEAD+1)
 136          IDEVT=IQ(JHEAD+2)
 137       ENDIF
 138 C
 139       IF(KSEL(5).GT.0)THEN
 140          NVERTX=0
 141          NTRACK=0
 142          IF(JVERTX.GT.0)NVERTX=IQ(JVERTX+1)
 143          IF(JKINE .GT.0)NTRACK=IQ(JKINE +1)
 144       ENDIF
 145 C
 146    50 RETURN
 147       END