This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / giopa / grsave.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.21  by  S.Giani
11 *-- Author :
12       SUBROUTINE GRSAVE(KEYSU,ID1,ID2,ID3,ICYCLE)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       Routine to write out data structures on a RZ file        *
17 C.    *                                                                *
18 C.    *       KEYSU    Keyword to select data structure(s)             *
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 (output)                           *
23 C.    *                                                                *
24 C.    *    ==>Called by : <USER>, UGINIT,GUOUT                         *
25 C.    *       Author    R.Brun  *********                              *
26 C.    *                                                                *
27 C.    ******************************************************************
28 C.
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
39 C
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/
50 C.
51 C.    ------------------------------------------------------------------
52 C.
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)
60 10000 FORMAT(' *** GRSAVE *** Obsolete routine. Please use GROUT')
61 C
62       CALL UCTOH(KEYSU,KEY,4,4)
63 C
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
79 C
80 C               Write data structure(s)
81 C
82       KEYRZ(2)=ID1
83       KEYRZ(3)=ID2
84       KEYRZ(4)=ID3
85 C
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
94 C
95   99  RETURN
96       END