*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:33  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
      SUBROUTINE CDREPL (PATHN, LSUP, LBK, IUDIV, KEYO,KEYN, CHOPT, IRC)
*     ==================================================================
*
************************************************************************
*                                                                      *
*        SUBR. CDREPL (PATHN, LSUP,*LBK*,IUDIV, KEYO,KEYN,CHOPT, IRC*) *
*                                                                      *
*   Stores data from memory to disk and also enters in the memory ala  *
*   DBUSE in NODE/KEY structure. Also replaces an Old set of keys in   *
*   KEYO by a new set of keys in KEYN                                  *
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     PATHN    Character string describing the pathname                *
*     LSUP     Address of bank in memory where data reside             *
*     LBK      Address of Keys bank KYCD   (INPUT or OUTPUT)           *
*     IUDIV    Division index of the user data bank                    *
*     KEYO     Vector of old keys                                      *
*     KEYN     Vector of new keys                                      *
*     CHOPT    Character string with any of the following characters   *
*          A   trust LBK address if non-zero                           *
*          B   Save in the special backup file; not in standard Journal*
*          C   create Node/Key data structure ala DBUSE                *
*          D   Store only the differences from an existing object      *
*          F   Updates with a fully matched data object (in user keys) *
*          K   Store data only inside the keys (not yet installed)     *
*          H   Insertion time as supplied by user to be honoured       *
*          P   Store data compressed (bit packing)                     *
*          R   Replace existing object as specified by the vector KEYO *
*          T   Special text type of data (to be used with Y)           *
*          Y   Store with full RZ option (No compression to be made)   *
*          Z   Store only nonzero elements. An element is considered to*
*              to be zero if its absolute value is less than DELTA     *
*     IRC      Return code (see below)                                 *
*                                                                      *
*   Called by user,   CDSTOM                                           *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IQUEST(1) =  0 : No error                                        *
*               = 61 : Too many keys                                   *
*               = 62 : Too many keys with option N                     *
*               = 63 : Data base structure in memory clobbered         *
*               = 64 : Error in MZCOPY while copying Data bank         *
*                                                                      *
************************************************************************
*
#include "hepdb/caopts.inc"
#include "hepdb/cdcblk.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/clinks.inc"
#include "hepdb/ctpath.inc"
      PARAMETER       (JBIAS=2)
      DIMENSION       KEYN(9), KEYO(9), LBK(9), LSUP(9)
      CHARACTER       CHOPT*(*), PATHN*(*), PATHY*80, CHOP*2
*
*     ------------------------------------------------------------------
*
* *** Decode the character option
*
      LREFCD(1) = LBK(1)
      CALL CDOPTS (CHOPT, IRC)
      IF (IRC.NE.0)     GO TO 999
*
      IF (IOPFCA.NE.0) IOPDCA = 1
      IF (IOPTCA.NE.0) IOPYCA = 1
      IF (IOPYCA.NE.0) THEN
        IOPPCA = 0
        IOPZCA = 0
      ENDIF
      IF (IOPPCA.NE.0) IOPZCA = 0
*
* *** Prepare the output with the old keys
*
      IOPICA = 1
      IF (LSTRCL(3).NE.0) CALL MZDROP (IDISCD, LSTRCL(3), 'L')
      CALL CDBANK (IDISCD, LSTRCL(3), LSTRCL(3), JBIAS, 'SAME', 0, 0, 0,
     +             2, 0, IRC)
      IF (IRC.NE.0)     GO TO 999
*
      CALL CDKOUT (PATHN, LSTRCL(3), IDISCD, KEYO, KEYVCK, IRC)
      IF (LSTRCL(3).NE.0) THEN
        CALL MZDROP (IDISCD, LSTRCL(3), 'L')
        LSTRCL(3) = 0
      ENDIF
      IF (IRC.NE.0)     GO TO 999
      CALL RZCDIR (PATHY, 'R')
*
* *** Prepare the Key vector array of the new object
*
      IOPICA = 0
      CALL CDKOUT (PATHY, LSUP(1), IUDIV, KEYN, KEYVCK, IRC)
      IF (IRC.NE.0)     GO TO 999
*
* *** Create data bank in memory ala DBUSE
*
      IF (IOPCCA.NE.0)  THEN
*
*  **   Create database skeleton in memory (banks NOCD and KYCD)
*
        IF (IOPACA.EQ.0. OR. (IOPACA.NE.0. AND. LREFCD(1).EQ.0) )  THEN
*
          CALL CDBOOK (PATHY, LBK, 1, CHOPT, IRC)
          IF (IRC.NE.0) GO TO 999
          LREFCD(1) = LBK(1)
          CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(1)+1), NWKYCK)
          NDK    = IQ(KOFUCD+LREFCD(1)-1)
          IQ(KOFUCD+LREFCD(1)+NDK+MKYFRI) = 0
          DO 20 I = 1, NPARCD
            IQ(KOFUCD+LREFCD(1)+NWKYCK+I) = KEYVCK(NOF1CK+2*I)
   20     CONTINUE
*
        ELSE
#if defined(CERNLIB__DEBUG)
*
          IF (IDEBCD.GT.0) THEN
            LBNOCD = LQ(KOFUCD+LREFCD(1)-KLNOCD)
            NF     = IQ(KOFUCD+LBNOCD+MNDNCH)
            CALL UHTOC (IQ(KOFUCD+LBNOCD+MNDNAM), 4, PAT2CT, NF)
            PAT2CT = PAT2CT (1:NF)
            N      = LENOCC (PATHY) + 1
*
   25       N      = N -1
            IF (PATHY(N:N).NE.PAT2CT(NF:NF))  THEN
              IQUEST(1) = 63
              IQUEST(11)= N
              CALL CDPRNT (LPRTCD, '(/,'' CDREPL : Database structure'//
     +             ' in memory clobbered'')', IARGCD, 0)
              GO TO 999
            ELSE IF (N.NE.1)  THEN
              NF     = NF -1
              GO TO 25
            ENDIF
          ENDIF
#endif
*
          CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LREFCD(1)+1), NWKYCK)
          NDK    = IQ(KOFUCD+LREFCD(1)-1)
          IQ(KOFUCD+LREFCD(1)+NDK+MKYFRI) = 0
          DO 30 I = 1, NPARCD
            IQ(KOFUCD+LREFCD(1)+NWKYCK+I) = KEYVCK(NOF1CK+2*I)
   30     CONTINUE
        ENDIF
*
*  **   Now copy the data banks appended at LSUP to the key bank
*
        IF (IOPYCA.EQ.0)  THEN
          CHOP   = 'NP'
        ELSE
          CHOP   = 'LP'
        ENDIF
*
        LBD    = LQ(KOFUCD+LREFCD(1)-KLDACD)
        IF (LBD.NE.0) CALL MZDROP (IDIVCD, LBD, 'L')
        IF (IOPKCA.EQ.0 .AND. LSUP(1).NE.0) THEN
          CALL MZCOPY (IUDIV, LSUP(1), IDIVCD, LREFCD(1), -KLDACD, CHOP)
        ENDIF
*
        IF (IQUEST(1).NE.0)  THEN
          IQUEST(11) = IQUEST(1)
          IRC        = 64
#if defined(CERNLIB__DEBUG)
          IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDREPL : Error'//
     +    ' '',I6,'' while copying the Data bank in the Node/Key stru'//
     +    'cture'')', IQUEST(11), 1)
#endif
        ENDIF
*
      ENDIF
*                                                             END CDREPL
  999 END
