*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:07  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
* Ignoring t=dummy
#endif
      SUBROUTINE CDEALI (PATHN, ALIAS, IFLAG, IRC)
*     ============================================
*
************************************************************************
*                                                                      *
*        SUBR. CDEALI (PATHN, ALIAS, IFLAG, IRC*)                      *
*                                                                      *
*   Enter the alias name of a given directory either only for this     *
*   session or permanently in the data base.                           *
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     PATHN    Character string specifying the directory path name     *
*     ALIAS    Character string specifying the alias name              *
*     IFLAG    Flag (0 if to be entered only for this session;         *
*                    1 if to be entered for this session and D.B.)     *
*     IRC      Return Code (See below)                                 *
*                                                                      *
*   Called by CDALIA, CDFZUP                                           *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IRC       =  0 : No error                                        *
*               =146 : Illegal path name                               *
*               =147 : Dictionary directory not found in memory        *
*               =148 : FZOUT fails to write on the sequential file     *
*               =149 : Error in RZ for writing to the R.A. file        *
*                                                                      *
************************************************************************
*
#include "hepdb/cdcblk.inc"
#include "hepdb/cfzlun.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/ctpath.inc"
#if defined(CERNLIB__P3CHILD)
#include "hepdb/p3dbl3.inc"
#endif
      CHARACTER       PATHN*(*), ALIAS*(*), CALI*8, PATHY*80, PATHL*80
*
*     ------------------------------------------------------------------
*
* *** Load the top directory information
*
      CALL CDLDUP (PATHN, 0, IRC)
      IF (IRC.NE.0)       GO TO 999
      CALI   = ALIAS
      PATHL  = ' '
      PATHY  = PAT1CT
      NCHAR  = LENOCC (PATHY)
*
* *** Find the unique directory identifier from the pathname
*
      CALL CDGPID (PATHY, IDN)
      IF (IDN.LE.0) THEN
        IRC    = 146
#if defined(CERNLIB__DEBUG)
        IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : Illegal'//
     +  ' pathname '//PATHY//''')', IARGCD, 0)
#endif
        GO TO 999
      ENDIF
*
* *** Modify in memory
*
      LUFZCF = LUFZCD
      LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
      IF (LFIXCD.EQ.0) THEN
        IRC    = 147
#if defined(CERNLIB__DEBUG)
        IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : DICTION'//
     +  'ARY not found for '//TOPNCD//''')', IARGCD, 0)
#endif
        GO TO 999
      ENDIF
*
      IPNT   = KOFUCD + LFIXCD + (IDN - 1) * NWITCD + 1
      CALL UCTOH (CALI, IQ(IPNT+MDCALI), 4, 8)
      IF (IFLAG.EQ.0)  THEN
        LFIXCD = 0
        GO TO 999
      ENDIF
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
*
      IF (IOPPCD.NE.0) THEN
        LFIXCD = 0
        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
*
* *** Get the name of the correct DICTIONARY directory
*
      PAT2CT = '//'//TOPNCD(1:NCHRCD)//'/DICTIONARY'
      NCHRD  = NCHRCD + 13
*
      IF (LUFZCF.GT.0) THEN
*
*  **   Prepare the header containing all the information
*
        NCHD   = (NCHRD + 3) / 4
        NCHP   = (NCHAR + 3) / 4
        CALL MZIOCH (IOFMCF, NWFMCF, '6I -H')
        IHEDCF(MACTCF) = 7
        IHEDCF(MNKYCF) = 0
        IHEDCF(MOPTCF) = 0
        IHEDCF(MPATCF) = NCHD
        IHEDCF(MFLGCF) = IFLAG
        IHEDCF(MWDPCF) = NCHP
        NPNT1  = NCHD  + MWDPCF + 1
        NPNT2  = NPNT1 + 2
        CALL UCTOH (PAT2CT, IHEDCF(MWDPCF+1), 4, 4*NCHD)
        CALL UCTOH (CALI,   IHEDCF(NPNT1),    4, 8)
        CALL UCTOH (PATHY,  IHEDCF(NPNT2),    4, 4*NCHP)
        NWDH   = NPNT2 + NCHP - 1
*
*  **   Now write on the sequential output
*
#if defined(CERNLIB__P3CHILD)
        RNDBP3 = 'CDEALI '
        NWDBP3 = 2
        CALL UCTOH ('JOURNAL ',IWDBP3, 4, 8)
        CALL CDCHLD
        IRC    = IQDBP3
        IF (IRC.NE.0) GO TO 999
#endif
        CALL FZOUT (LUFZCF, IDIVCD, 0, 1, 'Z', IOFMCF, NWDH, IHEDCF)
        IF (IQUEST(1).NE.0) THEN
          LFIXCD = 0
          IRC    = 148
#if defined(CERNLIB__DEBUG)
          IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : FZOUT'//
     +    ' error for path name '//PATHY//''')', IARGCD, 0)
#endif
          GO TO 999
        ENDIF
      ENDIF
*
      IRC    = 0
#if (defined(CERNLIB_UNIX)||defined(CERNLIB_IBMVM)||defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))
*
* *** Server environment, Public mode
*
      IF (IOPPCD.NE.0) THEN
#endif
#if (defined(CERNLIB_VAX))&&(defined(CERNLIB__SERVER))&&(!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__ONLINE))
        IOPBCA = 0
        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)
*
* *** Now save this information in the data base
*
      CALL RZCDIR (PAT2CT, ' ')
      IF (IQUEST(1).NE.0) THEN
        LFIXCD = 0
        IRC    = 147
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
        IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : DICTION'//
     +  'ARY not found for '//TOPNCD//''')', IARGCD, 0)
#endif
#if !defined(CERNLIB__P3CHILD)
        GO TO 999
      ENDIF
      NKEYCK = IQUEST(7)
      NWKYCK = IQUEST(8)
      LCDRCD = IQUEST(11)
      IKDRCD = IQUEST(13)
      ISTP   = NWKYCK + 1
*
* *** Lock the directory if necessary
*
      IF (IOPSCD.NE.0) THEN
        CALL RZCDIR (PAT2CT, ' ')
        LCDRCD = IQUEST(11)
        IKDRCD = IQUEST(13)
        CALL RZLOCK ('CDEALI')
        PATHL  = PAT2CT
      ENDIF
*
      IF (NKEYCK.GT.0) THEN
        IPNT   = KOFSCD + LCDRCD + IKDRCD
        IMIN   = IUHUNT (-1, IQ(IPNT+IDHKSN), NKEYCK*ISTP, ISTP)
        IF (IMIN.GT.0) THEN
          IMIN   = (IMIN - IDHKSN) / ISTP + 1
          CALL CDKEYT
          CALL CDKEYR (IMIN, NWKYCK, KEYNCK)
          ISTEP  = 1
          CALL RZOUT (IDIVCD, LFIXCD, KEYNCK, ICYCLE, 'S')
          LFIXCD = 0
          IF (IQUEST(1).NE.0) THEN
            IRC        = 149
            IQUEST(11) = ISTEP
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
            IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : RZ '//
     +      'error in step '',I3,'' for path name '//PAT2CT//''')',
     +      IQUEST(11), 1)
#endif
#if !defined(CERNLIB__P3CHILD)
            GO TO 998
          ENDIF
          IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
          NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
          ISTEP  = 2
          CALL RZPURG (0)
          IF (IQUEST(1).NE.0) THEN
            IRC        = 149
            IQUEST(11) = ISTEP
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
            IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : RZ '//
     +      'error in step '',I3,'' for path name '//PAT2CT//''')',
     +      IQUEST(11), 1)
#endif
#if !defined(CERNLIB__P3CHILD)
            GO TO 998
          ENDIF
        ENDIF
      ELSE
        IMIN   = 0
      ENDIF
      LFIXCD = 0
      IF (IMIN.EQ.0) THEN
        IRC    = 147
#endif
#if (defined(CERNLIB__DEBUG))&&(!defined(CERNLIB__P3CHILD))
        IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDEALI : DICTION'//
     +  'ARY not found for '//TOPNCD//''')', IARGCD, 0)
#endif
#if !defined(CERNLIB__P3CHILD)
      ELSE
        IRC    = 0
      ENDIF
*
* *** Free the locked directory
*
  998 IF (PATHL.NE.' ') THEN
        CALL RZCDIR (PATHL, ' ')
        LCDRCD = IQUEST(11)
        IKDRCD = IQUEST(13)
        CALL RZFREE ('CDEALI')
      ENDIF
#endif
*                                                             END CDEALI
  999 END
