*
* $Id: cdrdic.F,v 1.1.1.1 1996/02/28 16:24:10 mclareni Exp $
*
* $Log: cdrdic.F,v $
* Revision 1.1.1.1 1996/02/28 16:24:10 mclareni
* Hepdb, cdlib, etc
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
* Ignoring t=dummy
#endif
SUBROUTINE CDRDIC (TOPN, IRC)
* =============================
*
************************************************************************
* *
* SUBR. CDRDIC (TOPN, IRC*) *
* *
* Recreates the dictionary information and stores it into database *
* *
* Arguments : *
* *
* TOPN Name of the top directory *
* IRC Return code (see below) *
* *
* Called by user, CDFZUP *
* *
* Error Condition : *
* *
* IRC = 0 : No error *
* =141 : Error in creating the DICTIONARY directory *
* =142 : Error in RZ in writing the dictionary object *
* =143 : Error in RZ in purging the dictionary directory *
* =148 : Error in FZOUT for saving the journal file *
* *
************************************************************************
*
#include "hepdb/caopti.inc"
#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 TOPN*(*), PATHN*80, CFOR*32
* ------------------------------------------------------------------
*
* *** Load the directory information
*
CALL CDOPTS (' ', IRC)
PATHN = '//'//TOPN
CALL CDLDUP (PATHN, 0, IRC)
IF (IRC.NE.0) GO TO 999
PATHN = PAT1CT
NCHR = LENOCC (PAT1CT)
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))&&(defined(CERNLIB__SERVER))
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
*
* *** Prepare the journal file if needed
*
IF (LUFZCF.GT.0) THEN
NWDP = (NCHR + 3) / 4
IHEDCF(MACTCF) = 10
IHEDCF(MNKYCF) = 0
IHEDCF(MOPTCF) = 0
IHEDCF(MPATCF) = NWDP
NWDH = MPATCF
CALL UCTOH (PATHN, IHEDCF(NWDH+1), 4, 4*NWDP)
NWDH = NWDH + NWDP
CALL MZIOCH (IOFMCF, NWFMCF, '4I -H')
*
* ** Now write on the sequential output
*
#if defined(CERNLIB__P3CHILD)
RNDBP3 = 'CDRDIC '
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
IRC = 148
#if defined(CERNLIB__DEBUG)
IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : FZOUT'//
+ ' error for path name '//PATHN(1:NCHR)//''')', 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))
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)
IF (IOUTCD.EQ.0) GO TO 999
PAT1CT = PATHN(1:NCHR)//'/DICTIONARY'
*
* *** Try to load the dictionary information if it exists
*
CALL RZCDIR (PAT1CT, 'Q')
IF (IQUEST(1).NE.0) THEN
CFOR = CHFTCK(1:NSYSCK)
DO I = 1, NSYSCK
CTAGCK(I) = CHTGCK(I)
ENDDO
DO I = 1, NPARCD
CFOR(NOF1CK+2*I-1:NOF1CK+2*I-1) = 'I'
CFOR(NOF1CK+2*I :NOF1CK+2*I ) = 'I'
CTAGCK(NOF1CK+2*I-1) = 'STR_VAL'//CALFCA(27+I)
CTAGCK(NOF1CK+2*I) = 'END_VAL'//CALFCA(27+I)
ENDDO
CALL RZCDIR (PATHN, ' ')
IF (IOPSCD.NE.0) CALL RZLOCK ('CDRDIC')
CALL RZMDIR ('DICTIONARY', NSYSCK, CFOR, CTAGCK)
IERR = IQUEST(1)
IF (IOPSCD.NE.0) THEN
CALL RZCDIR (PATHN, ' ')
CALL RZFREE ('CDRDIC')
ENDIF
IF (IERR.NE.0) THEN
IRC = 141
#endif
#if (!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
IF (IDEBCD.GT.0) THEN
NCHD = LENOCC (PAT1CT)
CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : RZMDIR error for pat'//
+ 'h name '//PAT1CT(1:NCHD)//''')', IARGCD, 0)
ENDIF
#endif
#if !defined(CERNLIB__P3CHILD)
GO TO 999
ENDIF
CALL RZCDIR (PAT1CT, 'Q')
ENDIF
NKEYCK = IQUEST(7)
NWKYCK = IQUEST(8)
LCDRCD = IQUEST(11)
IKDRCD = IQUEST(13)
*
IF (NKEYCK.GT.0) THEN
IPNT = KOFSCD + LCDRCD + IKDRCD
ISTP = NWKYCK + 1
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)
ENDIF
ELSE
IMIN = 0
ENDIF
IF (IMIN.LE.0) THEN
CALL VZERO (KEYNCK, NSYSCK)
KEYNCK(IDHKSN) = -1
KEYNCK(IDHFLG) = 1
CALL DATIME (IDATE, ITIME)
CALL CDPKTM (IDATE, ITIME, KEYNCK(IDHINS), IRC)
ENDIF
CALL CDMDIC (TOPN, LBUPCD, -KLDICD, IRC)
IF (IRC.NE.0) GO TO 999
LFIXCD = LQ(KOFUCD+LBUPCD-KLDICD)
*
* *** All subdirectories looked at; now store dictionary if permitted
*
IF (IOUTCD.NE.0) THEN
CALL RZCDIR (PAT1CT, 'Q')
LCDRCD = IQUEST(11)
IF (IOPSCD.NE.0) CALL RZLOCK ('CDRDIC')
CALL RZOUT (IDIVCD, LFIXCD, KEYNCK, ICYCLE, 'S')
IKDRCD = IQ(KOFSCD+LCDRCD+KLKDCD)
NKEYCK = IQ(KOFSCD+LCDRCD+KNKDCD)
IF (IQUEST(1).NE.0) THEN
IF (IOPSCD.NE.0) CALL RZFREE ('CDRDIC')
IRC = 142
#endif
#if (!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
IF (IDEBCD.GT.0) THEN
NCHD = LENOCC (PAT1CT)
CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : RZOUT error for path'//
+ ' name '//PAT1CT(1:NCHD)//''')', IARGCD, 0)
ENDIF
#endif
#if !defined(CERNLIB__P3CHILD)
GO TO 999
ENDIF
CALL RZPURG (0)
IERR = IQUEST(1)
IF (IOPSCD.NE.0) CALL RZFREE ('CDRDIC')
IF (IERR.NE.0) THEN
IRC = 143
#endif
#if (!defined(CERNLIB__P3CHILD))&&(defined(CERNLIB__DEBUG))
IF (IDEBCD.GT.0) THEN
NCHD = LENOCC (PAT1CT)
CALL CDPRNT (LPRTCD, '(/,'' CDRDIC : RZPURG error for pat'//
+ 'h name '//PAT1CT(1:NCHD)//''')', IARGCD, 0)
ENDIF
#endif
#if !defined(CERNLIB__P3CHILD)
GO TO 999
ENDIF
ENDIF
*
IRC = 0
#endif
* END CDRDIC
999 END