MINICERN/packlib/zebra/rz/rzcopy.F

   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