*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:15  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
* Ignoring t=dummy
#endif
      SUBROUTINE CDSDIR (PATHN, NWKEY, CHFOR, CHTAG, MXKP, IPREC, DELTA,
     +                   CHOPT, IRC)
*     ==================================================================
*
************************************************************************
*                                                                      *
*        SUBR. CDSDIR (PATHN, NWKEY, CHFOR, CHTAG, MXKP, IPREC, DELTA, *
*                      CHOPT, IRC*)                                    *
*                                                                      *
*   Saves the directory creation information in the Journal file.      *
*   It creates a header record (with data bank containing IPREC and    *
*   DELTA) for each entry.                                             *
*   The header contains Action Code (2), Number of keys, numbers of    *
*   charcaters for option and pathname, MXKP, followed by Character    *
*   option, CHFOR, CHTAG and the pathname                              *
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     PATHN    Character string describing the pathname                *
*     NWKEY    Number of key elements                                  *
*     CHFOR    Character variable describing each element of the key   *
*              vector                                                  *
*     CHTAG    Character array defined as CHARACTER*8 (NWKEY)          *
*     MXKP     Maximum number of objects in each partition             *
*     IPREC    Precision word sepcifying the number of significant     *
*              digits to be stored; (If IPREC > 0, data are stored     *
*              with IPREC significant digits right to the decimal      *
*              points; if IPREC < 0, data are stored with IPREC        *
*              insignificant digits left to the decimal point.)        *
*     DELTA    Variable specifying the absolute value below which data *
*              is treated as zero                                      *
*     CHOPT    Character string with any of the following characters   *
*          C   Data in the directory will be compressed by default     *
*          P   Create partitioned subdirectories for the pathname      *
*     IRC      Return code (see below)                                 *
*                                                                      *
*   Called by CDMKDI                                                   *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IRC       =  0 : No error                                        *
*               = 49 : FZOUT fails to write on the sequential file     *
*                                                                      *
************************************************************************
*
#include "hepdb/cdcblk.inc"
#include "hepdb/cfzlun.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/clinks.inc"
#include "hepdb/ctpath.inc"
#if defined(CERNLIB__P3CHILD)
#include "hepdb/p3dbl3.inc"
#endif
      PARAMETER       (JBIAS=2)
      CHARACTER       CTAG*8, PATHN*(*), CHFOR*(*), CHOPT*(*)
      CHARACTER*(*)   CHTAG(*)
*
*     ------------------------------------------------------------------
*
* *** Find the logical unit number of the Journal file
*
      KEY7   = KEY7CK
      KEY7CK = 0
      IRC    = 0
      LUFZCF = LUFZCD
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
*
      IF (IOPPCD.NE.0) THEN
        IRC    = 0
#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
#endif
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
        IF (IRC.NE.0) GO TO 999
      ENDIF
#endif
*
      IF (LUFZCF.GT.0) THEN
*
*  **   Prepare the header containing all the information
*
        NCH    = LENOCC (PATHN)
        NCHD   = (NCH  + 3) / 4
        NCHP   = LENOCC (CHOPT)
        NCHPD  = (NCHP + 3) / 4
        CALL MZIOCH (IOFMCF, NWFMCF, '7I -H')
        IHEDCF(MACTCF) = 2
        IHEDCF(MNKYCF) = NWKEY
        IHEDCF(MPATCF) = NCHD
        IHEDCF(MOPTCF) = NCHPD
        IHEDCF(MXKPCF) = MXKP
*       IF (NCHPD.GT.0) CALL UCTOH (CHOPT, IHEDCF(MRECCF+1), 4, 4*NCHPD)
        IF (NCHPD.GT.0) CALL UCTOH (CHOPT, IHEDCF(MRECCF+1), 4, NCHP)
        IF (KEY7.LE.0) THEN
          CALL DATIME (IDATE, ITIME)
          CALL CDPKTM (IDATE, ITIME, KEY7, IRC)
        ENDIF
        IHEDCF(MINSCF) = KEY7
        IHEDCF(MRECCF) = 0
        NCFO   = (NWKEY + 3) / 4
        NPNT   = IHEDCF(MOPTCF) + MRECCF + 1
        CALL UCTOH (CHFOR, IHEDCF(NPNT), 4, NWKEY)
        NPNT   = NPNT + NCFO
        DO 10 I = 1, NWKEY
          CTAG   = CHTAG(I)
          CALL UCTOH (CTAG, IHEDCF(NPNT), 4, 8)
          NPNT   = NPNT + 2
   10   CONTINUE
        CALL UCTOH (PATHN, IHEDCF(NPNT), 4, 4*NCHD)
        NWDH   = NPNT + NCHD - 1
*
*  **   Now write on the sequential output
*
#if defined(CERNLIB__P3CHILD)
        RNDBP3 = 'CDSDIR '
        NWDBP3 = 2
        CALL UCTOH ('JOURNAL ', IWDBP3, 4, 8)
        CALL CDCHLD
        IRC    = IQDBP3
        IF (IRC.NE.0) GO TO 999
#endif
        IF (LSTRCL(3).NE.0) CALL MZDROP (IDISCD, LSTRCL(3), ' ')
        CALL CDBANK (IDISCD, LSTRCL(3), LSTRCL(3), JBIAS, 'SAME', 0, 0,
     +               1, 3, 0, IRC)
        IF (IRC.NE.0) GO TO 999
        IQ(KOFUCD+LSTRCL(3)-5) = IPREC
         Q(KOFUCD+LSTRCL(3)+1) = DELTA
        CALL FZOUT (LUFZCF, IDISCD, LSTRCL(3), 1, 'S', IOFMCF, NWDH,
     +              IHEDCF)
        IERR   = IQUEST(1)
        CALL MZDROP (IDISCD, LSTRCL(3), ' ')
        IF (IERR.NE.0) THEN
          IRC    = 49
#if defined(CERNLIB__DEBUG)
          IF (IDEBCD.GT.0) THEN
            PAT3CT = PATHN
            CALL CDPRNT (LPRTCD, '(/,'' CDSDIR : FZOUT error for path'//
     +           ' name '//PAT3CT//''')', IARGCD, 0)
          ENDIF
#endif
          GO TO 999
        ENDIF
      ENDIF
#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
*
* *** Server environment, Public mode
*
      IF (IOPPCD.NE.0) THEN
        IOPBCA = 0
        CALL CDCWSV (IRC)
        GO TO 999
      ENDIF
#endif
*                                                             END CDSDIR
  999 END
