*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:32  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
* Ignoring t=dummy
#endif
      SUBROUTINE CDKOUT (PATHN, LADDR, IUDIV, KEYI, KEYO, IRC)
*     ========================================================
*
************************************************************************
*                                                                      *
*        SUBR. CDKOUT (PATHN, LADDR, IUDIV, KEYI, KEYO*, IRC*)         *
*                                                                      *
*   Stores data from memory to disk                                    *
*   Data structure refered by LREFCD(2); set up by the calling routine *
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     PATHN    Character string describing the pathname                *
*     IUDIV    Division index where the data reside                    *
*     KEYI     Input vector of keys (validity ranges, user and special *
*              user keys to be filled in by the user)                  *
*     KEYO     Output vector of keys (copy of KEYI +system keys filled *
*              in by the HEPDB package)                                *
*     IRC      Return code (see below)                                 *
*                                                                      *
*   Called by CDREPL, CDSTOR                                           *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IRC       =  0 : No error                                        *
*               = 71 : Illegal path name                               *
*               = 73 : RZOUT fails to write on disk                    *
*               = 74 : Error in RZRENK in updating key values for      *
*                      partitioned data set                            *
*               = 76 : Cannot form the IO descriptor for the FZ header *
*               = 77 : FZOUT fails to write on to the sequential file  *
*               = 78 : Illegal number of keys in data base             *
*                                                                      *
************************************************************************
*
#include "hepdb/caopti.inc"
#include "hepdb/caopts.inc"
#include "hepdb/cdcblk.inc"
#include "hepdb/cfzlun.inc"
#include "hepdb/cinitl.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/clinks.inc"
#include "hepdb/ctpath.inc"
#include "hepdb/czpack.inc"
#if defined(CERNLIB__P3CHILD)
#include "hepdb/p3dbl3.inc"
#endif
      PARAMETER       (NLEVM=20)
      CHARACTER       PATHN*(*), PATHY*80, PATHX*16, PATHL*80, CHOPT*28
      CHARACTER       CFORM(6)*1, CHCUR(NLEVM)*1, CHFOR*100, CHOP*1
      INTEGER         KEYI(9), KEYO(9), LADDR(9), NLCUR(NLEVM),IOPTS(26)
      EQUIVALENCE     (IOPACA, IOPTS(1))
      DATA            CFORM /'B', 'I', 'F', 'D', 'H', 'A'/
#include "zebra/q_jbit.inc"
* Ignoring t=pass
#include "zebra/q_sbit.inc"
* Ignoring t=pass
*
*     ------------------------------------------------------------------
*
      LREFCD(2) = LADDR(1)
*
* *** Load top directory information; gets in PAT1CT complete path name
*
      CALL CDLDUP (PATHN, 1, IRC)
      IF (IRC.NE.0)         GO TO 999
*
* *** Set the current directory path name
*
      PATHL  = ' '
      PATHY  = PAT1CT
      CALL RZCDIR (PATHY, ' ')
      NKEYCK = IQUEST(7)
      NWKYCK = IQUEST(8)
      LCDRCD = IQUEST(11)
      IKDRCD = IQUEST(13)
      KST    = NWKYCK + 1
      CALL CDKYTG
      IF (NKEYCK.NE.0)  THEN
        IOPTP  = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
      ELSE
        IOPTP  = 0
      ENDIF
*
* *** Load IPREC/DELTA from dictionary; choose the transcript file
*
      CALL CDLDIC (PATHY, 1, IRC)
      IF (IRC.NE.0)         GO TO 999
      IF (ICMPCD.EQ.0) THEN
        IOPYCA = 1
        PACKCZ = .FALSE.
      ELSE IF (ICMPCD.EQ.2.AND.IOPZCA.NE.0) THEN
        PACKCZ = .TRUE.
        PRECCZ = DELTCD
      ELSE
        PACKCZ = .FALSE.
      ENDIF
      IF (IOPBCA.EQ.0) THEN
        LUFZCF = LUFZCD
      ELSE
        LUFZCF = LUBKCD
      ENDIF
*
* *** Fill up Key Serial number, pointer, insertion time
*
      CALL UCOPY (KEYI, KEYO, NWKYCK)
      KEYO(IDHKSN) = 0
      KEYO(IDHPTR) = 0
      IF (IOPHCA.EQ.0.OR.KEYO(IDHINS).LE.0) THEN
        CALL DATIME (IDATE, ITIME)
        CALL CDPKTM (IDATE, ITIME, IDATM, IRC)
        KEYO(IDHINS) = IDATM
      ENDIF
*
      IDB    = ICDTYP (LREFCD(2))
      IF (IDB.EQ.2.OR.IDB.EQ.3) THEN
        IOPTR  = 0
      ELSE
        IOPTR  = 1
      ENDIF
*
      IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
        IF (IOPTCA.NE.0) THEN
          CHOP   = 'S'
        ELSE IF (IOPYCA.NE.0) THEN
          CHOP   = 'L'
        ELSE
          CHOP   = ' '
        ENDIF
      ELSE
        CHOP   = 'S'
      ENDIF
*
* *** Encode the character option, IO descriptor for the header
*
      IF (IOPPCD.NE.0.OR.LUFZCF.GT.0) THEN
        CHOPT  = 'H'
        NDOP   = 1
        DO 10 I = 1, 26
          IF (IOPTS(I).NE.0.AND.I.NE.8) THEN
            IF (NDOP.EQ.0) THEN
              CHOPT  = CALFCA(I)
            ELSE
              CHOPT  = CHOPT(1:NDOP)//CALFCA(I)
            ENDIF
            NDOP   = NDOP + 1
          ENDIF
   10   CONTINUE
        NDOP   = (NDOP + 3) / 4
*
        NLEV   = 1
        NCUR   = 5
        IFORO  = 2
        CHCUR(NLEV) = CFORM(IFORO)
        IF (PACKCZ) THEN
          NLCUR(NLEV) = 4
          IFORO  = 3
          NCUR   = 1
          NLEV   = NLEV + 1
          CHCUR(NLEV) = CFORM(IFORO)
          CALL UCOPY (PRECCZ, IHEDCF(MPRECF), 1)
        ELSE
          IHEDCF(MPRECF) = IPRECD
        ENDIF
        DO 15 I = 1, NWKYCK
          IFORM  = IOTYCK(I)
          IF (IFORM.EQ.6) IFORM = 5
          IF (IFORM.EQ.IFORO) THEN
            NCUR   = NCUR + 1
          ELSE
            NLCUR(NLEV) = NCUR
            IF (NLEV.GE.NLEVM) THEN
              IRC    = 76
#if defined(CERNLIB__DEBUG)
              IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
     +        'Cannot get IO descriptor '//PATHY//''')', IARGCD, 0)
#endif
              GO TO 999
            ENDIF
            NLEV   = NLEV + 1
            CHCUR(NLEV) = CFORM(IFORM)
            NCUR   = 1
            IFORO  = IFORM
          ENDIF
   15   CONTINUE
        NLCUR(NLEV) = NCUR
*
#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
        WRITE (CHFOR, 2001) (NLCUR(I), CHCUR(I), I = 1, NLEV)
#endif
#if (defined(CERNLIB_IBM))&&(defined(CERNLIB__P3CHILD))
        CHFOR  = ' '
        II     = 1
        DO 20 I = 1, NLEV
          CALL UTWRIT (CHFOR(II:II+1), '(I2)', NLCUR(I))
          II     = II + 2
          CHFOR(II:II) = CHCUR(I)
          II     = II + 2
   20   CONTINUE
#endif
        II     = 4 *NLEV
        CHFOR = CHFOR(1:II)//' -H'
        CALL MZIOCH (IOFMCF, NWFMCF, CHFOR(1:II+3))
*
*  **   Complete the header
*
        NCHR   = LENOCC (PATHY)
        NWDP   = (NCHR + 3) / 4
        NWDH   = NWDP + NDOP + NWKYCK + 5
        IHEDCF(MACTCF) = 1
        IHEDCF(MNKYCF) = NWKYCK
        IHEDCF(MOPTCF) = NDOP
        IHEDCF(MPATCF) = NWDP
        IF (NDOP.GT.0)
     +    CALL UCTOH (CHOPT, IHEDCF(MPRECF+NWKYCK+1), 4, 4*NDOP)
        CALL UCTOH (PATHY, IHEDCF(MPRECF+NWKYCK+NDOP+1), 4, 4*NWDP)
        CALL UCOPY (KEYO, IHEDCF(MPRECF+1), NWKYCK)
      ENDIF
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
*
      IF (IOPPCD.NE.0) THEN
#endif
#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
        CALL CDWLOK (IRC)
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(!defined(CERNLIB__ONLINE))
        CALL CDSTSV (TOPNCD, 0, IRC)
#endif
#if defined(CERNLIB__P3CHILD)
        LUFZCF = LODBP3
        RNDBP3 = 'CDKOUT '
        NWDBP3 = 2
        CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
        CALL CDCHLD
        IRC    = IQDBP3
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
        IF (IRC.NE.0)       GO TO 999
*
*  **   Copy the record to CLUSCOM or SPOOL
*
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))
          IF (IDEBCD.GE.1) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Call'//
     +    ' FZOUT with option '//CHOP//''')', IARGCD, 0)
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
        CALL FZOUT (LUFZCF, IUDIV, LREFCD(2), 1, CHOP, IOFMCF, NWDH,
     +              IHEDCF)
        IF (IQUEST(1).NE.0) THEN
          IRC    = 77
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(defined(CERNLIB__DEBUG))
          IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error'//
     +    ' in FZOUT while writing Data for '//PATHY//''')', IARGCD, 0)
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
          GO TO 999
        ENDIF
#endif
#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
*
        CALL CDCWSV (IRC)
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
        GO TO 999
      ENDIF
#endif
#if !defined(CERNLIB__P3CHILD)
*
* *** Take necessary action for partitioned and nonpartitioned datasets
*
      IF (IOPTP.EQ.0) THEN
        KOBJ   = 0
      ELSE
        KPNT   = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
     +                   NKEYCK*KST, KST)
        IF (KPNT.NE.0) THEN
          NK     = (KPNT - MPSRCD) / KST + 1
        ELSE
          NK     = NKEYCK
        ENDIF
        CALL CDKEYR (NK, NWKYCK, KYP1CK)
        KOBJ   = KYP1CK(MOBJCD)
        MXKP   = KYP1CK(MXKPCD)
        CALL CDPATH (PATHX, NKEYCK)
        CALL RZCDIR (PATHX, ' ')
        IF (IQUEST(1).NE.0) THEN
          IRC    = 71
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
          IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
     +       'Illegal Path Name '//PATHY//PATHX(1:8)//''')', IARGCD, 0)
#endif
#if !defined(CERNLIB__P3CHILD)
          GO TO 999
        ENDIF
        NKEYCK = IQUEST(7)
        LCDRCD = IQUEST(11)
        IKDRCD = IQUEST(13)
*
*  **   Make a different subdirectory if there are too many keys
*
        IF (NKEYCK.GE.MXKP) THEN
          NWKEY  = NWKYCK
          CHFOR = ' '
          DO 30 I = 1, NWKEY
            IF (I.EQ.1) THEN
              CHFOR  = CFORM(IOTYCK(I))
            ELSE
              CHFOR  = CHFOR(1:I-1)//CFORM(IOTYCK(I))
            ENDIF
   30     CONTINUE
          IF (IOPHCA.EQ.0.OR.KEYO(IDHINS).LE.0) THEN
            KEY7CK = 0
          ELSE
            KEY7CK = KEYO(IDHINS)
          ENDIF
          IF (ICMPCD.EQ.2) THEN
            CHOPT  = 'ZP'
          ELSE IF (ICMPCD.NE.0) THEN
            CHOPT = 'CP'
          ELSE
            CHOPT = 'P '
          ENDIF
          CALL CDMKDI (PATHY, NWKEY, CHFOR, CTAGCK, MXKP, IPRECD,
     +                 DELTCD, CHOPT, IRC)
          IF (IRC.NE.0)     GO TO 999
          CALL RZCDIR (PATHY, ' ')
          NKEYCK = IQUEST(7)
          LCDRCD = IQUEST(11)
          IKDRCD = IQUEST(13)
          KPNT   = IUHUNT (NKEYCK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
     +                     NKEYCK*KST, KST)
          IF (KPNT.NE.0) THEN
            NK     = (KPNT - MPSRCD) / KST + 1
          ELSE
            NK     = NKEYCK
          ENDIF
          CALL CDKEYR (NK, NWKYCK, KYP1CK)
          KOBJ   = KYP1CK(MOBJCD)
          CALL CDPATH (PATHX, NKEYCK)
          CALL RZCDIR (PATHX, ' ')
          IF (IQUEST(1).NE.0) THEN
            IRC    = 71
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
            IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
     +         'Illegal Path Name '//PATHY//PATHX(1:8)//''')', IARGCD,0)
#endif
#if !defined(CERNLIB__P3CHILD)
            GO TO 999
          ENDIF
          NKEYCK = IQUEST(7)
          LCDRCD = IQUEST(11)
          IKDRCD = IQUEST(13)
        ENDIF
        CALL UCOPY (KYP1CK, KYP2CK, NWKYCK)
*
      ENDIF
*
* *** Find the unique serial number of the object
*
      LOBJ   = KOBJ
      IF (NKEYCK.GT.0) THEN
        ISTP   = NWKYCK + 1
        DO 40 IK = 1, NKEYCK
          IP     = KOFSCD + LCDRCD + IKDRCD + (IK-1)*ISTP + IDHKSN
          IF (IQ(IP).GT.LOBJ) LOBJ = IQ(IP)
   40   CONTINUE
      ENDIF
      LOBJ   = LOBJ + 1
*
*  ** Write the sequential output if needed
*
      IF (LUFZCF.GT.0) THEN
        IHEDCF(MPRECF+IDHKSN) = LOBJ
        CALL FZOUT (LUFZCF, IUDIV, LREFCD(2), 1, CHOP, IOFMCF, NWDH,
     +              IHEDCF)
        IF (IQUEST(1).NE.0) THEN
          IRC    = 77
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
          IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error'//
     +    ' in FZOUT while writing Data for '//PATHY//''')', IARGCD, 0)
#endif
#if !defined(CERNLIB__P3CHILD)
          GO TO 50
        ENDIF
      ENDIF
*
* *** Fill up Key vectors 1,2,6,7
*
      KEYO(IDHKSN) = LOBJ
      KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JRZUCD)
      KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JPRTCD)
      KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JASFCD)
      IF (IOPICA.EQ.0) THEN
        KEYO(IDHFLG) = MSBIT0 (KEYO(IDHFLG), JIGNCD)
      ELSE
        KEYO(IDHFLG) = MSBIT1 (KEYO(IDHFLG), JIGNCD)
      ENDIF
*
* *** Lock the directory if necessary
*
      IF (IOPPCD.EQ.0.AND.IOPSCD.NE.0) THEN
        CALL RZCDIR (PATHY, ' ')
        NKEYCK = IQUEST(7)
        LCDRCD = IQUEST(11)
        IKDRCD = IQUEST(13)
        CALL RZLOCK ('CDKOUT')
        PATHL  = PATHY
        IF (IOPTP.NE.0) THEN
          CALL RZCDIR (PATHX, ' ')
          NKEYCK = IQUEST(7)
          LCDRCD = IQUEST(11)
          IKDRCD = IQUEST(13)
        ENDIF
      ENDIF
*
      IF (IOPYCA.NE.0 .OR. IOPTR.NE.0 .OR. IOPTCA.NE.0) THEN
*
*  **   RZ mode output
*
        KEYO(IDHFLG) = MSBIT1 (KEYO(IDHFLG), JRZUCD)
        IF (IOPTCA.NE.0) KEYO(IDHFLG) = MSBIT1 (KEYO(IDHFLG), JASFCD)
*
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
        IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
#endif
#if !defined(CERNLIB__P3CHILD)
        CALL RZOUT (IUDIV, LREFCD(2), KEYO, ICYCLE, CHOP)
*
      ELSE
*
*  **   Copy data to DB internal store
*
*  **   0 Data word : do not pack
*
        IF (IQ(KOFUCD+LREFCD(2)-1).EQ.0) THEN
          IRSET  = 1
          IOPPS  = IOPPCA
          IOPZS  = IOPZCA
          IOPPCA = 0
          IOPZCA = 0
        ELSE
          IRSET  = 0
        ENDIF
        CALL CDFRUS (LREFCD(2), LSTRCL(1), IPRECD, IRC)
        IF (IRC.NE.0) THEN
          IF (IRSET.NE.0) THEN
            IOPPCA = IOPPS
            IOPZCA = IOPZS
          ENDIF
          GO TO 50
        ENDIF
*
*  **   Compress the data if requested
*
        IF (IOPPCA.EQ.0.AND.IOPZCA.EQ.0) THEN
          LREFCL(1) = LSTRCL(1)
          IF (IRSET.NE.0) THEN
            IOPPCA = IOPPS
            IOPZCA = IOPZS
          ENDIF
        ELSE
          CALL CDCOMP (LSTRCL(1), LREFCL(1), KEYO(1), IRC)
        ENDIF
        IF (IRC.NE.0)       GO TO 50
*
*  **   Drop the uncompressed data
*
        IF (LREFCL(1).NE.LSTRCL(1)) CALL MZDROP (IDISCD, LSTRCL(1), 'L')
*
*  **   Write on to disk
*
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
        IF (IDEBCD.GT.2) CALL RZLDIR (' ', ' ')
#endif
#if !defined(CERNLIB__P3CHILD)
        CALL RZOUT (IDISCD, LREFCL(1), KEYO, ICYCLE, 'S')
        IER       = IQUEST(1)
        CALL MZDROP (IDISCD, LREFCL(1), 'L')
        IQUEST(1) = IER
*
      ENDIF
      CALL UCOPY (KEYO, KEYNCK, NWKYCK)
      IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
      NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
*
      IF (IQUEST(1).NE.0) THEN
        IRC    = 73
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
        IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error '//
     +     'in RZOUT while writing Data for '//PATHY//PATHX(1:8)//''')',
     +     IRC, 0)
#endif
#if !defined(CERNLIB__P3CHILD)
        GO TO 50
      ENDIF
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
      IF (IDEBCD.GT.1) THEN
        IARGCD(1) = IDATE
        IARGCD(2) = ITIME
        CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Data was inserted into'//
     +       '   '//PATHY//''',/,10X,''on the '',I8,'' at '',I6,'' '//
     +       'with Key-Vector '')', IARGCD, 2)
        CALL CDKEYT
        CALL CDPRKY (NWKYCK, KEYNCK, IOTYCK, IRC)
      ENDIF
#endif
#if !defined(CERNLIB__P3CHILD)
*
   50 IF (IOPTP.NE.0)  THEN
        CALL RZCDIR (PATHY, ' ')
        IF (IQUEST(1).NE.0) THEN
          IF (IRC.EQ.0) THEN
            IF (PATHL.NE.' ') THEN
              CALL RZCDIR (PATHL, ' ')
              CALL RZFREE ('CDKOUT')
            ENDIF
            IRC    = 71
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
            IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : '//
     +         'Illegal Path Name '//PATHY//''')', IARGCD, 0)
#endif
#if !defined(CERNLIB__P3CHILD)
            GO TO 999
          ENDIF
        ELSE
          LCDRCD = IQUEST(11)
          IKDRCD = IQUEST(13)
          NKEYCK = IQUEST(7)
*
*  **     Rename Keys 3 and 4 of the latest subdirectory
*
          IF (IRC.EQ.0) THEN
            CALL CDPVAL (KEYO(1))
            CALL RZRENK (KYP1CK, KYP2CK)
            IF (IQUEST(1).NE.0) THEN
              IRC    = 74
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
              IF (IDEBCD.GT.0) THEN
                CALL UCOPY (KYP1CK, IARGCD(1),        NSYSCK)
                CALL UCOPY (KYP2CK, IARGCD(NSYSCK+1), NSYSCK)
                CALL CDPRNT (LPRTCD, '(/,'' CDKOUT : Error in RZRENK '//
     +               'while writing data for '//PATHY//''',/(10X,7I12))'
     +,              IARGCD, 2*NSYSCK)
              ENDIF
#endif
#if !defined(CERNLIB__P3CHILD)
            ENDIF
          ENDIF
        ENDIF
      ENDIF
*
      IF (PATHL.NE.' ') THEN
        CALL RZCDIR (PATHL, ' ')
        CALL RZFREE ('CDKOUT')
      ENDIF
#endif
#if !defined(CERNLIB_IBM)||!defined(CERNLIB__P3CHILD)
*
 2001 FORMAT (20(I2,A1,1X))
#endif
*                                                             END CDKOUT
  999 END
