]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/rz/rzrenk.F
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzrenk.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/24 17:27:07 mclareni
6* Extend the include file cleanup to dzebra, rz and tq, and also add
7* dependencies in some cases.
8*
9* Revision 1.1.1.1 1996/03/06 10:47:26 mclareni
10* Zebra
11*
12*
13#include "zebra/pilot.h"
14 SUBROUTINE RZRENK(KEYOLD,KEYNEW)
15*
16************************************************************************
17*
18* To rename a key in the CWD
19* Input:
20* KEYOLD Key array of dimension NWKEY containing the old key vector
21* KEYNEW Key array of dimension NWKEY containing the new key vector
22*
23* Called by <USER>
24*
25* Author : R.Brun DD/US/PD
26* Written : 16.05.86
27* Last mod: 16.05.86
28*
29************************************************************************
30*
31#include "zebra/zunit.inc"
32#include "zebra/rzcl.inc"
33#include "zebra/rzk.inc"
34#include "zebra/rzckey.inc"
35 DIMENSION KEYOLD(*),KEYNEW(*)
36*
37*-----------------------------------------------------------------------
38*
39
40#include "zebra/q_jbyt.inc"
41
42 IQUEST(1)=0
43 IF(LQRS.EQ.0)GO TO 99
44*
45* Check permission
46*
47 IFLAG=1
48 CALL RZMODS('RZRENK',IFLAG)
49 IF(IFLAG.NE.0)GO TO 99
50*
51 NKEYS=IQ(KQSP+LCDIR+KNKEYS)
52 NWKEY=IQ(KQSP+LCDIR+KNWKEY)
53 IF(NKEYS.LE.0)GO TO 90
54*
55 DO 10 K=1,NWKEY
56 IKDES=(K-1)/10
57 IKBIT1=3*K-30*IKDES-2
58 IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
59 KEY(K)=KEYOLD(K)
60 ELSE
61 CALL ZHTOI(KEYOLD(K),KEY(K),1)
62 ENDIF
63 10 CONTINUE
64 DO 40 I=1,NKEYS
65 DO 20 K=1,NWKEY
66 LKC=IQ(KQSP+LCDIR+KLK)+(NWKEY+1)*(I-1)
67 IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GO TO 40
68 20 CONTINUE
69 DO 30 K=1,NWKEY
70 IKDES=(K-1)/10
71 IKBIT1=3*K-30*IKDES-2
72 IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
73 IQ(KQSP+LCDIR+LKC+K)=KEYNEW(K)
74 ELSE
75 CALL ZHTOI(KEYNEW(K),IQ(KQSP+LCDIR+LKC+K),1)
76 ENDIF
77 30 CONTINUE
78 GO TO 99
79 40 CONTINUE
80*
81 90 IQUEST(1)=1
82 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
83 1000 FORMAT(' RZRENK. Current directory contains no keys')
84*
85 99 RETURN
86 END