* * $Id: cdeali.F,v 1.1.1.1 1996/02/28 16:24:08 mclareni Exp $ * * $Log: cdeali.F,v $ * Revision 1.1.1.1 1996/02/28 16:24:08 mclareni * Hepdb, cdlib, etc * * #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