*
* $Id: cdgetdb.F,v 1.1.1.1 1996/02/28 16:24:26 mclareni Exp $
*
* $Log: cdgetdb.F,v $
* Revision 1.1.1.1 1996/02/28 16:24:26 mclareni
* Hepdb, cdlib, etc
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
* Ignoring t=dummy
#endif
SUBROUTINE CDGETDB (PATHN, LBK, MASK,KEYS, KYSR,KYINM, CHOPT, IRC)
* ==================================================================
*
************************************************************************
* *
* SUBR. CDGETDB (PATHN, LBK*, MASK,KEYS, KYSR,KYINM, CHOPT,IRC*)*
* *
* Prepares the database data structure in memory for any required *
* Pathname and set of Keys, unless already done. Returns the *
* in memory for the corresponding Key bank(s) with a selection on *
* a range of start validity time and user keys. *
* Selects objects with validity range as specified in KEYS(NOF1CK..) *
* if the proper masks are used. It sees the object in data base has *
* the start validity period within the range specified by the user. *
* Selection on insertion time demands data base object was inserted *
* before the selected time. *
* *
* Arguments : *
* *
* PATHN Character string describing the pathname *
* LBK Address(es) of Keys bank(s) KYCD. The data bank address *
* can be obtained as LQ(LBK-1) *
* For option 'S' it is the support address of the linear *
* structure *
* MASK Integer vector indicating which elements of KEYS are *
* significant for selection. If MASK corresponding to *
* one of the fields of 'Beginning' validity range is set, *
* it will select objects with start validity larger than *
* those requested in KEYS. If MASK corresponding to one *
* of the fields of 'End' validity range is set, it will *
* select objects with start validity smaller than those *
* in the KEYS vector (in the fields corresponding to end *
* validity). If MASK corresponding to time of insertion *
* is set, objects inserted earlier than KEYS(IDHINS) are *
* selected *
* KEYS Vector of keys. Only the elements declared in CHOPT are *
* assumed to contain useful information. *
* KYSR The limits on the serial number for option R *
* KYINM The lower limit on insertion time used with option I *
* CHOPT Character string with any of the following characters *
* I ignore objects inserted before KYINM *
* K read only the keys (no data is required) *
* R select on range of serial number given in KYSR(1:2) *
* S expect multiple Key banks satisfying selection on a *
* number of keys *
* IRC Return code (see below) *
* *
* Called by user *
* *
* Error Condition : *
* *
* IRC = 0 : No error *
* = 2 : Illegal path name *
* = 32 : No keys/data in this directory *
* *
* If IRC = 0, IQUEST(2) carries information on number of data *
* objects selected by CDGETDB *
* *
************************************************************************
*
#include "hepdb/caopts.inc"
#include "hepdb/cdcblk.inc"
#include "hepdb/cinitl.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/clinks.inc"
#include "hepdb/ctpath.inc"
#if defined(CERNLIB__P3CHILD)
#include "hepdb/p3dbl3.inc"
#endif
PARAMETER (NZ=0)
DIMENSION KEYS(9), MASK(9), KYSR(2), LBK(9)
CHARACTER CHOPT*(*), PATHN*(*), PATHY*255
#include "zebra/q_jbit.inc"
* Ignoring t=pass
*
* ------------------------------------------------------------------
*
* *** Initialize options
*
CALL CDOPTS (CHOPT, IRC)
IF (IRC.NE.0) GO TO 999
CALL UCOPY (MASK, IOKYCA, MXDMCK)
IOPMCA = 0
LBK(1) = 0
*
* *** Create (or complete) database skeleton in memory
*
CALL CDNODE (PATHN, IRC)
IF (IRC.NE.0) GO TO 999
PATHY = PAT1CT
*
* ** Start from the end of the existing chain
*
IF (LQ(KOFUCD+LBNOCD-KLKYCD).NE.0) THEN
LFIXCD = LZLAST (IDIVCD, LQ(KOFUCD+LBNOCD-KLKYCD))
IF (LFIXCD.EQ.0) THEN
LFIXCD = LBNOCD
JBIAS =-KLKYCD
ELSE
JBIAS = 0
ENDIF
ELSE
LFIXCD = LBNOCD
JBIAS =-KLKYCD
ENDIF
NDK = IQ(KOFUCD+LBNOCD+MNDNWD)
CALL UCOPY (IQ(KOFUCD+LBNOCD+MNDIOF), IOKYCD, NWNOCD)
*
* *** Set the current directory
*
CALL RZCDIR (PATHY, ' ')
IF (IQUEST(1).NE.0) THEN
IRC = 2
#if defined(CERNLIB__DEBUG)
IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : Illega'//
+ 'l path name '//PATHY//''')', IARGCD, 0)
#endif
GO TO 999
ENDIF
NKEYCK = IQUEST(7)
NWKYCK = IQUEST(8)
LCDRCD = IQUEST(11)
IKDRCD = IQUEST(13)
CALL CDKEYT
*
IF (NKEYCK.LE.0) THEN
IRC = 32
#if defined(CERNLIB__DEBUG)
IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : No key'//
+ 's/data for '//PATHY//''')', IARGCD, 0)
#endif
GO TO 999
ENDIF
*
NCHR = LENOCC (PATHY)
IOPTP = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
*
* *** Now create the key bank(s) and optionally the data bank
*
NKB = 0
IPRBCA = ISIGN (IPRBCA, -1)
IPRECA = ISIGN (IPRECA, -1)
IF (IPRBCA.EQ.0.AND.IPRECA.EQ.0) THEN
IFLG = 99
ELSE
IFLG = 0
ENDIF
#if defined(CERNLIB__P3CHILD)
LCOND = (IOPSCA.NE.0.AND.IOPKCA.EQ.0)
CALL CDSTP3 (1, LCOND, NBKP3, 0)
#endif
IF (IOPTP.EQ.0) THEN
DO 20 JK = 1, NKEYCK
IK = NKEYCK + 1 - JK
CALL CDKEYR (IK, NWKYCK, KEYVCK)
CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
IF (ISEL.NE.0) GO TO 20
IF ((KEYVCK(IDHKSN).LT.KYSR(1).OR.KEYVCK(IDHKSN).GT.KYSR(2))
+ .AND.(IOPRCA.NE.0)) GO TO 20
IF (IOPICA.NE.0.AND.KEYVCK(IDHINS).LT.KYINM) GO TO 20
IF (JBIT(KEYVCK(IDHFLG),JIGNCD).NE.0) GO TO 20
CALL CDBANK (IDIVCD, LBKYCD, LFIXCD, JBIAS, 'KYCD', NLKYCD,
+ NSKYCD, NDK, IOKYCD, NZ, IRC)
IF (IRC.NE.0) GO TO 999
LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
IQ(KOFUCD+LBKYCD+NDK+MKYFRI) = 0
IQ(KOFUCD+LBKYCD+NDK+MKYCRU) = IQ(KOFUCD+LBKYCD+NDK+MKYCRU) +1
IQ(KOFUCD+LBKYCD+NDK+MKYCEV) = IQ(KOFUCD+LBKYCD+NDK+MKYCEV) +1
NKB = NKB + 1
IF (NKB.EQ.1) LBK(1) = LBKYCD
LFIXCD = LBKYCD
JBIAS = 0
IF (IOPKCA.EQ.0) THEN
#if defined(CERNLIB__P3CHILD)
IF (IPASP3.EQ.1) CALL CDSTP3 (2, LCOND, NBKYP3, 0)
#endif
CALL VZERO (KEYVCK, NWKYCK)
KEYVCK(IDHKSN) = IK
IOKYCA(IDHKSN) = 1
CALL CDKXIN (ITIME, IDIVCD, LAUXCL(9), LBKYCD, -KLDACD,
+ NWKEY, KEYVCK, IPREC, IRC)
IOKYCA(IDHKSN) = 0
LAUXCL(9) = 0
IQ(KOFUCD+LBKYCD+NDK+MKYPRE) = IPREC
IQ(KOFUCD+LBKYCD+NDK+MKYRID) = IQ(KOFUCD+LBKYCD+NDK+MKYRID)
+ + 1
ENDIF
CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LBKYCD+1), NWKYCK)
DO 10 I = 1, NPARCD-1
IQ(KOFUCD+LBKYCD+NWKYCK+I) = IQ(KOFUCD+LBKYCD+NOF1CK+2*I-1)
10 CONTINUE
IQ(KOFUCD+LBKYCD+NWKYCK+NPARCD) =
+ IQ(KOFUCD+LBKYCD+NOF1CK+2*NPARCD-1) + 1
IF (IRC.NE.0) GO TO 999
IF (IOPSCA.EQ.0) THEN
IQUEST(2) = NKB
GO TO 999
ENDIF
20 CONTINUE
*
ELSE
KST = NWKYCK + 1
NKEYS = NKEYCK
KSERL = -1
KINSL = 0
DO 40 JKK = 1, NKEYS
IKK = NKEYS + 1 - JKK
KPNT = IUHUNT (IKK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
+ NKEYS*KST, KST)
IF (KPNT.GT.0) THEN
KPNT = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
ELSE
KPNT = KOFSCD + LCDRCD + IKDRCD + (IKK - 1) * KST
ENDIF
IF (IOPICA.NE.0) THEN
IF (JKK.GT.1.AND.KINSL.LT.KYINM) GO TO 40
KINSL = IQ(KPNT+IDHINS)
ENDIF
IF (IOPRCA.NE.0) THEN
IF (IQ(KPNT+MOBJCD).GT.KYSR(2)) GO TO 40
IF (KSERL.GE.0.AND.KSERL.LT.KYSR(1)) GO TO 40
KSERL = IQ(KPNT+MOBJCD)
ENDIF
CALL CDPSEL (ITIME, KEYS, IQ(KPNT+1), IFLG, ISEL)
IF (ISEL.NE.0) GO TO 40
*
CALL CDPATH (TOP2CT, IKK)
PAT2CT = PATHY(1:NCHR)//'/'//TOP2CT
CALL RZCDIR (PAT2CT, ' ')
IF (IQUEST(1).NE.0) THEN
IQUEST(1) = 2
#if defined(CERNLIB__DEBUG)
IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : Il'//
+ 'legal path name '//PAT2CT//''')', IARGCD, 0)
#endif
GO TO 999
ENDIF
NKEYCK = IQUEST(7)
LCDRCD = IQUEST(11)
IKDRCD = IQUEST(13)
#if defined(CERNLIB__P3CHILD)
NKBP3 = 0
#endif
DO 30 JK = 1, NKEYCK
IK = NKEYCK + 1 - JK
CALL CDKEYR (IK, NWKYCK, KEYVCK)
CALL CDKSEL (ITIME, KEYS, KEYVCK, IFLG, ISEL, INBR)
IF (ISEL.NE.0) GO TO 30
IF ((KEYVCK(IDHKSN).LT.KYSR(1).OR.KEYVCK(IDHKSN).GT.KYSR(2))
+ .AND.(IOPRCA.NE.0)) GO TO 30
IF (IOPICA.NE.0.AND.KEYVCK(IDHINS).LT.KYINM) GO TO 30
IF (JBIT(KEYVCK(IDHFLG),JIGNCD).NE.0) GO TO 30
CALL CDBANK (IDIVCD, LBKYCD, LFIXCD, JBIAS, 'KYCD', NLKYCD,
+ NSKYCD, NDK, IOKYCD, NZ, IRC)
IF (IRC.NE.0) GO TO 999
LQ(KOFUCD+LBKYCD-KLNOCD) = LBNOCD
LQ(KOFUCD+LBKYCD-KLUPCD) = LBUPCD
IQ(KOFUCD+LBKYCD+NDK+MKYFRI) = 0
IQ(KOFUCD+LBKYCD+NDK+MKYCRU) = IQ(KOFUCD+LBKYCD+NDK+MKYCRU)
+ + 1
IQ(KOFUCD+LBKYCD+NDK+MKYCEV) = IQ(KOFUCD+LBKYCD+NDK+MKYCEV)
+ + 1
NKB = NKB + 1
IF (NKB.EQ.1) LBK(1) = LBKYCD
LFIXCD = LBKYCD
JBIAS = 0
IF (IOPKCA.EQ.0) THEN
#if defined(CERNLIB__P3CHILD)
IF (IPASP3.EQ.1) CALL CDSTP3 (2, LCOND, NBKYP3, 0)
#endif
CALL VZERO (KEYVCK, NWKYCK)
KEYVCK(IDHKSN) = IK
IOKYCA(IDHKSN) = 1
CALL CDKXIN (ITIME, IDIVCD, LAUXCL(9), LBKYCD, -KLDACD,
+ NWKEY, KEYVCK, IPREC, IRC)
IOKYCA(IDHKSN) = 0
LAUXCL(9) = 0
IQ(KOFUCD+LBKYCD+NDK+MKYPRE) = IPREC
IQ(KOFUCD+LBKYCD+NDK+MKYRID) =IQ(KOFUCD+LBKYCD+NDK+MKYRID)
+ + 1
ENDIF
CALL UCOPY (KEYVCK(1), IQ(KOFUCD+LBKYCD+1), NWKYCK)
DO 25 I = 1, NPARCD-1
IQ(KOFUCD+LBKYCD+NWKYCK+I) =IQ(KOFUCD+LBKYCD+NOF1CK+2*I-1)
25 CONTINUE
IQ(KOFUCD+LBKYCD+NWKYCK+NPARCD) =
+ IQ(KOFUCD+LBKYCD+NOF1CK+2*NPARCD-1) + 1
IOKYCA(IDHKSN) = 0
IF (IRC.NE.0) GO TO 999
IF (IOPSCA.EQ.0) THEN
IQUEST(2) = NKB
GO TO 999
ENDIF
30 CONTINUE
CALL RZCDIR (PATHY, ' ')
IF (IQUEST(1).NE.0) THEN
IRC = 2
#if defined(CERNLIB__DEBUG)
IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDGETDB : Il'//
+ 'legal path name '//PATHY//''')', IARGCD, 0)
#endif
GO TO 999
ENDIF
LCDRCD = IQUEST(11)
IKDRCD = IQUEST(13)
40 CONTINUE
*
ENDIF
*
998 IQUEST(2) = NKB
#if defined(CERNLIB__P3CHILD)
*
CALL CDUSP3 ('CDGETDB', ITIME, IRC)
#endif
*
999 CONTINUE
#if defined(CERNLIB__P3CHILD)
IF (LNK3P3.NE.0) CALL MZDROP (IXDBP3, LNK3P3, '....')
LNK3P3 = 0
LNK4P3 = 0
LNK5P3 = 0
NBKYP3 = 0
NDIRP3 = 0
IPASP3 = 0
#endif
* END CDGETDB
END