]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/giopa/grsave.F
Hole() method needed by TRD to find out wheter frame has holes.
[u/mrichter/AliRoot.git] / GEANT321 / giopa / grsave.F
CommitLineData
fe4da5cc 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.21 by S.Giani
11*-- Author :
12 SUBROUTINE GRSAVE(KEYSU,ID1,ID2,ID3,ICYCLE)
13C.
14C. ******************************************************************
15C. * *
16C. * Routine to write out data structures on a RZ file *
17C. * *
18C. * KEYSU Keyword to select data structure(s) *
19C. * ID1 First RZ KEY identifier (ex IDRUN) *
20C. * ID2 Second RZ KEY identifier (ex IDEVT) *
21C. * ID3 Third RZ KEY identifier (user free) *
22C. * ICYCLE Cycle number (output) *
23C. * *
24C. * ==>Called by : <USER>, UGINIT,GUOUT *
25C. * Author R.Brun ********* *
26C. * *
27C. ******************************************************************
28C.
29#include "geant321/gcbank.inc"
30#include "geant321/gcunit.inc"
31 CHARACTER*4 KLEY(19)
32 CHARACTER*4 KEYSU(1)
33 DIMENSION KEYRZ(4)
34 DIMENSION LINIT(8),LKINE(2),LTRIG(6)
35 DIMENSION LKEY(19),LINK(10),JLINK(17)
36 EQUIVALENCE (JLINK(1),JDIGI)
37 EQUIVALENCE (LKEY(18),KINIT),(LKEY(19),KTRIG),(LKEY(5),KKINE)
38 SAVE IFIRST,LKEY
39C
40 DATA KLEY/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART','ROTM'
41 + ,'RUNG','SETS','STAK','STAT','TMED','TRAC','VERT','VOLU'
42 + ,'JXYZ','INIT','TRIG'/
43 DATA LINIT/2,6,7,8,9,10,13,16/
44 DATA LKINE/5,15/
45 DATA LTRIG/1,3,4,5,15,17/
46 DATA NLINIT/8/
47 DATA NLKINE/2/
48 DATA NLTRIG/6/
49 DATA IFIRST/0/
50C.
51C. ------------------------------------------------------------------
52C.
53 IF(IFIRST.EQ.0)THEN
54 IFIRST=1
55 CALL UCTOH(KLEY,LKEY,4,76)
56 ENDIF
57*
58 WRITE(CHMAIL,10000)
59 CALL GMAIL(0,0)
6010000 FORMAT(' *** GRSAVE *** Obsolete routine. Please use GROUT')
61C
62 CALL UCTOH(KEYSU,KEY,4,4)
63C
64 IF(KEY.EQ.KINIT)THEN
65 CALL UCOPY(LINIT,LINK,NLINIT)
66 NLINK=NLINIT
67 ELSEIF(KEY.EQ.KKINE)THEN
68 CALL UCOPY(LKINE,LINK,NLKINE)
69 NLINK=NLKINE
70 ELSEIF(KEY.EQ.KTRIG)THEN
71 CALL UCOPY(LTRIG,LINK,NLTRIG)
72 NLINK=NLTRIG
73 ELSE
74 IL=IUCOMP(KEY,LKEY,17)
75 IF(IL.EQ.0)GO TO 99
76 LINK(1)=IL
77 NLINK=1
78 ENDIF
79C
80C Write data structure(s)
81C
82 KEYRZ(2)=ID1
83 KEYRZ(3)=ID2
84 KEYRZ(4)=ID3
85C
86 DO 10 I=1,NLINK
87 IL=LINK(I)
88 IF(JLINK(IL).EQ.0)GO TO 10
89 KEYRZ(1)=LKEY(IL)
90 IF(IL.EQ.4)CALL GRLEAS(JHITS)
91 IF(IL.EQ.1)CALL GRLEAS(JDIGI)
92 CALL RZOUT(IXSTOR,JLINK(IL),KEYRZ,ICYCLE,'L')
93 10 CONTINUE
94C
95 99 RETURN
96 END