]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/rz/rzcopy.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzcopy.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/24 17:26:44 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:23 mclareni
10* Zebra
11*
12*
13#include "zebra/pilot.h"
14 SUBROUTINE RZCOPY(CHPATH,KEYU,ICYCLE,KEYUN,CHOPT)
15*
16************************************************************************
17*
18* Routine to copy an object from CHPATH or the whole tree to the CWD
19* Input:
20* CHPATH The pathname of the directory tree which has to be copied to
21* the CWD
22* KEYU KEY of the object to be copied from CHPATH
23* ICYCLE Cycle number of the key to be copied
24* KEYUN New value of the key in CWD (may be the same as KEYU)
25* CHOPT Character string to specify various options
26* default ' ' copy the object with (KEYU,ICYCLE) from CHPATH to the CWD
27* If KEYUN already exists, a new cycle is created
28* 'C' copy all cycles for the specified key
29* 'K' copy all keys (If 'C' option is given, copy all cycles)
30* 'T' copy the complete tree CHPATH
31* When the option 'T' is given, by default only the highest
32* cycle of each key is copied
33* To copy all cycles use 'TC' option
34*
35* Called by <USER>
36*
37* Author : R.Brun DD/US/PD
38* Written : 07.05.86
39* Last mod: 14.05.92 Add CHOPT on call to RZFDIR
40* : 04.03.94 S.Banerjee (Change in cycle structure)
41* : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
42*
43************************************************************************
44#include "zebra/zunit.inc"
45#include "zebra/rzcl.inc"
46#include "zebra/rzk.inc"
47#include "zebra/rzckey.inc"
48#include "zebra/rzdir.inc"
49#include "zebra/rzch.inc"
50#include "zebra/rzcycle.inc"
51#if defined(CERNLIB_QMVAX)
52#include "zebra/rzclun.inc"
53#endif
54 CHARACTER*(*) CHPATH,CHOPT
55 DIMENSION KEYU(*),KEYUN(*)
56 DIMENSION IOPTV(3),ISD(NLPATM),NSD(NLPATM),IHDIR(4)
57 CHARACTER*16 CHFPAT(NLPATM)
58 EQUIVALENCE (IOPTC,IOPTV(1)),(IOPTK,IOPTV(2))
59 + ,(IOPTT,IOPTV(3))
60 LOGICAL COPY,RZSAME
61*
62*-----------------------------------------------------------------------
63*
64#if defined(CERNLIB_QMVAX)
65#include "zebra/q_jbit.inc"
66#endif
67#include "zebra/q_jbyt.inc"
68
69 IQUEST(1)=0
70 LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
71*
72* Save existing material (if any)
73*
74 CALL RZSAVE
75*
76 CALL UOPTC(CHOPT,'CKT',IOPTV)
77*
78* Check if WRITE permission on file and directory
79*
80 IF(LQRS.EQ.0)GO TO 999
81 IFLAG=0
82 CALL RZMODS('RZCOPY',IFLAG)
83 IF(IFLAG.NE.0)GO TO 999
84*
85* Save CWD name
86*
87 CALL RZCDIR(CHWOLD,'R')
88*
89* Load directory CHPATH
90*
91 CALL RZPATH(CHPATH)
92 NLPAT0=NLPAT
93 NLPAT1=NLPAT
94 DO 1 I=1,NLPAT
95 1 CHFPAT(I)=CHPAT(I)
96 CALL RZFDIR('RZCOPY',LT,LFROM,' ')
97 IF(LFROM.EQ.0)THEN
98 IQUEST(1)=4
99 GO TO 999
100 ENDIF
101 ISD(NLPAT1)=0
102 NSD(NLPAT1)=IQ(KQSP+LFROM+KNSD)
103 CALL SBIT0(IQ(KQSP+LFROM),IQDROP)
104 LB =IQ(KQSP+LT+KLB)
105 LROLD =IQ(KQSP+LT+LB+1)
106 LUNOLD=IQ(KQSP+LT-5)
107 NKEYS=IQ(KQSP+LFROM+KNKEYS)
108 NWKEY=IQ(KQSP+LFROM+KNWKEY)
109*
110* Check if KEY descriptors matches
111*
112 IF(NWKEY.NE.IQ(KQSP+LCDIR+KNWKEY).OR.
113 + IQ(KQSP+LFROM+KKDES).NE.IQ(KQSP+LCDIR+KKDES))THEN
114 IQUEST(1)=4
115 IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
116 1000 FORMAT(' RZCOPY. Key descriptors do not match')
117 GO TO 900
118 ENDIF
119*
120 IF(IOPTT.NE.0)THEN
121 LBANK=LCDIR
122 5 IF(LBANK.NE.LTOP)THEN
123 LBANK=LQ(KQSP+LBANK+1)
124 IF(LBANK.EQ.LFROM)THEN
125 IF(LOGLV.GE.-2) WRITE(IQLOG,3000)
126 3000 FORMAT(' RZCOPY. Cannot copy mother tree in daughter')
127 IQUEST(1)=4
128 GO TO 900
129 ENDIF
130 GO TO 5
131 ENDIF
132 ENDIF
133*
134 IF(NKEYS.EQ.0)THEN
135 IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)GO TO 999
136 GO TO 100
137 ENDIF
138*
139* Convert KEYU,KEYUN (If only one key to be copied)
140*
141 IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)THEN
142 DO 10 I=1,NWKEY
143 IKDES=(I-1)/10
144 IKBIT1=3*I-30*IKDES-2
145 IF(JBYT(IQ(KQSP+LFROM+KKDES+IKDES),IKBIT1,3).LT.3)THEN
146 KEY(I)=KEYU(I)
147 KEY2(I)=KEYUN(I)
148 ELSE
149 CALL ZHTOI(KEYU(I),KEY(I),1)
150 CALL ZHTOI(KEYUN(I),KEY2(I),1)
151 ENDIF
152 10 CONTINUE
153 ENDIF
154 15 IF(IOPTT.NE.0)THEN
155 ISD(NLPAT1)=0
156 NSD(NLPAT1)=IQ(KQSP+LFROM+KNSD)
157 ENDIF
158*
159* Loop on all keys of level 0
160*
161 DO 80 I=1,NKEYS
162 LK=IQ(KQSP+LFROM+KLK)
163 LKC=LK+(NWKEY+1)*(I-1)
164 IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)THEN
165 DO 20 K=1,NWKEY
166 IF(IQ(KQSP+LFROM+LKC+K).NE.KEY(K))GO TO 80
167 20 CONTINUE
168 ELSE
169 DO 25 K=1,NWKEY
170 KEY2(K)=IQ(KQSP+LFROM+LKC+K)
171 25 CONTINUE
172 ENDIF
173 LCYC =IQ(KQSP+LFROM+LKC)
174 IF (KVSCYC.NE.0) THEN
175* IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) THEN
176 IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LFROM+LKC+1)) THEN
177 IQUEST(1) = 11
178 GO TO 900
179 ENDIF
180 ENDIF
181*
182* Store cycles in reverse order for 'C' option
183*
184 IF(IOPTC.NE.0)THEN
185 IF(LCORD.EQ.0)THEN
186 CALL MZBOOK(JQPDVS,LCORD,LTOP,-4,'RZCO',0,0,50,2,-1)
187 ENDIF
188 IQ(KQSP+LCORD+1)=0
189 30 NORD=IQ(KQSP+LCORD+1)+1
190 IF (KVSCYC.NE.0) THEN
191 LCOLD = JBYT(IQ(KQSP+LFROM+LCYC+KPPCYC), 1,16)
192 ELSE
193 LCOLD = IQ(KQSP+LFROM+LCYC+KPPCYC)
194 ENDIF
195 IF(NORD.GT.IQ(KQSP+LCORD-1))THEN
196 CALL MZPUSH(JQPDVS,LCORD,0,50,'I')
197 ENDIF
198 IQ(KQSP+LCORD+1)=NORD
199 IQ(KQSP+LCORD+NORD+1)=LCYC
200 IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
201 LCYC=LCOLD
202 GO TO 30
203 ENDIF
204 DO 40 IC=NORD,1,-1
205 LCYC=IQ(KQSP+LCORD+IC+1)
206 CALL RZCOP1(LUNOLD,LROLD,KEY2,IQ(KQSP+LFROM+LCYC+1))
207 IF(IQUEST(1).NE.0) GO TO 900
208 40 CONTINUE
209 ELSE
210 50 IF (KVSCYC.NE.0) THEN
211 LCOLD = JBYT(IQ(KQSP+LFROM+LCYC+KPPCYC), 1,16)
212 ELSE
213 LCOLD = IQ(KQSP+LFROM+LCYC+KPPCYC)
214 ENDIF
215 ICY = JBYT(IQ(KQSP+LFROM+LCYC+KCNCYC),21,12)
216 COPY=ICYCLE.GE.ICY.OR.(ICYCLE.LE.0.AND.LCOLD.EQ.0).OR.
217 + IOPTT.NE.0.OR.IOPTK.NE.0
218 IF(COPY)THEN
219 CALL RZCOP1(LUNOLD,LROLD,KEY2,IQ(KQSP+LFROM+LCYC+1))
220 IF(IQUEST(1).NE.0) GO TO 900
221 ELSE
222 IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
223 LCYC=LCOLD
224 GO TO 50
225 ENDIF
226 ENDIF
227 ENDIF
228 IF(IOPTK.EQ.0.AND.IOPTT.EQ.0)GO TO 900
229*
230 80 CONTINUE
231*
232 100 IF(IOPTT.EQ.0)GO TO 900
233*
234* Copy subdirectories
235*
236 110 ISD(NLPAT1)=ISD(NLPAT1)+1
237 IF(ISD(NLPAT1).LE.NSD(NLPAT1))THEN
238 NLPAT1=NLPAT1+1
239 LSF=IQ(KQSP+LFROM+KLS)
240 IH=LSF+7*(ISD(NLPAT1-1)-1)
241 CALL ZITOH(IQ(KQSP+LFROM+IH),IHDIR,4)
242 CALL UHTOC(IHDIR,4,CHFPAT(NLPAT1),16)
243 DO 120 I=1,NLPAT1
244 120 CHPAT(I)=CHFPAT(I)
245 NLPAT=NLPAT1
246 CALL RZFDIR('RZCOPY',LT,LFROM,' ')
247 IF(LFROM.EQ.0)THEN
248 IQUEST(1)=4
249 GO TO 900
250 ENDIF
251 NKEYS=IQ(KQSP+LFROM+KNKEYS)
252 NWKEY=IQ(KQSP+LFROM+KNWKEY)
253 KTAGS=KKDES+(NWKEY-1)/10+1
254 DO 130 I=2,NLPAT1
255 130 CHCDIR(I)=CHFPAT(I)
256 CALL RZPAFF(CHCDIR,NLPAT1-1,CHL)
257 CALL RZCDIR(CHL,' ')
258 CALL RZMDIR(CHFPAT(NLPAT1),NWKEY,'?',' ')
259 IF(IQUEST(1).NE.0)GO TO 900
260 CALL RZPAFF(CHCDIR,NLPAT1,CHL)
261 CALL RZCDIR(CHL,' ')
262 IF(IQ(KQSP+LCDIR-1).LT.2*NWKEY+KTAGS+20)THEN
263 CALL RZEXPD('RZCOPY',100)
264 IF(IQUEST(1).NE.0)GO TO 900
265 ENDIF
266 CALL UCOPY(IQ(KQSP+LFROM+KKDES),IQ(KQSP+LCDIR+KKDES),
267 + 2*NWKEY+KTAGS-KKDES)
268 CALL SBIT1(IQ(KQSP+LTOP),2)
269 CALL SBIT1(IQ(KQSP+LCDIR),2)
270 GO TO 15
271 ELSE
272 NLPAT1=NLPAT1-1
273 IF(NLPAT1.GE.NLPAT0)THEN
274 LUP=LQ(KQSP+LFROM+1)
275 CALL MZDROP(JQPDVS,LFROM,' ')
276 LFROM=LUP
277 GO TO 110
278 ENDIF
279 ENDIF
280*
281 900 IRCOD = IQUEST(1)
282 IF(LCORD.NE.0)THEN
283 CALL MZDROP(JQPDVS,LCORD,' ')
284 LCORD=0
285 ENDIF
286 IF(LRIN.NE.0)THEN
287 CALL MZDROP(JQPDVS,LRIN ,' ')
288 LRIN=0
289 ENDIF
290 CALL RZCDIR(CHWOLD,' ')
291 IF(LFROM.NE.LCDIR)CALL SBIT1(IQ(KQSP+LFROM),IQDROP)
292 IQUEST(1) = IRCOD
293#if defined(CERNLIB_QMVAX)
294 IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
295 IF(LUNOLD.NE.LUN)THEN
296 IF(JBIT(IQ(KQSP+LFROM),4).NE.0)UNLOCK(UNIT=LUNOLD)
297 ENDIF
298#endif
299*
300 999 RETURN
301 END