*
* $Id: cdls.F,v 1.1.1.1 1996/02/28 16:24:39 mclareni Exp $
*
* $Log: cdls.F,v $
* Revision 1.1.1.1 1996/02/28 16:24:39 mclareni
* Hepdb, cdlib, etc
*
*
#include "hepdb/pilot.h"
SUBROUTINE CDLS(CHPATH,IRC)
CHARACTER*(*) CHPATH
CHARACTER*80 CHLINE
#include "hepdb/nwpaw.inc"
COMMON /PAWC/ NWPAWC,IXPAWC,IHBOOK,IXHIGZ,IXKU,IFENCE(5)
+, LMAIN, IPAW(NWPAW)
#include "zebra/zunit.inc"
#include "zebra/rzcl.inc"
#include "zebra/rzdir.inc"
#include "zebra/rzch.inc"
#include "zebra/rzk.inc"
DIMENSION IHTAG(2)
CHARACTER*8 CHTAG(KNMAX)
DIMENSION KEYS(KNMAX),KEYT(KNMAX)
CHARACTER*36 CHOPT
CHARACTER*4 CHID
INTEGER IDATE,ITIME
PARAMETER (JBIAS=2)
DIMENSION MINVAL(10),MAXVAL(10)
#include "hepdb/cdtime.inc"
#include "hepdb/cdkeys.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/cdunit.inc"
#include "hepdb/cdulnk.inc"
#include "hepdb/hdbkeys.inc"
#include "hepdb/cdlscm.inc"
#include "hepdb/hdbopt.inc"
#include "hepdb/hdboptd.inc"
#include "zebra/q_jbit.inc"
* Ignoring t=pass
CHOPT = CHOPTT
#include "hepdb/hdboptc.inc"
*
* C - display object count
* D - display key definitions
* E - display the experiment keys
* G - display keys using generic routine (RZPRNK)
* K - display all keys
* L - list only lowest level (end node) directories (D)
* M - show maxima and minima of validity ranges
* N - display number of data words
* P - display pathname (D)
* S - display the system keys
* T - display insertion date and time (RZ value)
* U - display user keys
* V - display validity range pairs
* Z - dump ZEBRA bank with DZSHOW.
*
IRC = 0
LPATH = LENOCC(CHPATH)
IDATE = 0
ITIME = 0
NSHOW = 0
DO 10 I=1,NPAICD
MINVAL(I) = 999999999
MAXVAL(I) = -999999999
10 CONTINUE
*
* Bump directory & object count
*
NOBJ = IQ(LCDIR+KQSP+KNKEYS)
NWKEY = IQ(LCDIR+KQSP+KNWKEY)
NDIRT = NDIRT + 1
NOBJT = NOBJT + NOBJ
*
* Lowest level directory?
*
IF(IOPTL.NE.0.AND.IQ(KQSP+LCDIR+KNSD).NE.0) RETURN
*
* Keys
*
IF(IOPTK.NE.0) THEN
IOPTE = 1
IOPTS = 1
IOPTU = 1
IOPTV = 1
ENDIF
WRITE(LOUTCD,*)
*
* Pathname
*
IF(IOPTP.NE.0) WRITE(LOUTCD,*) 'Directory: ',CHPATH(1:LPATH)
*
* Get tags
*
NWKEY=IQ(KQSP+LCDIR+KNWKEY)
KTAGS=KKDES+(NWKEY-1)/10+1
DO 20 J=1,NWKEY
CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*J-2),IHTAG,2)
CALL UHTOC(IHTAG,4,CHTAG(J),8)
20 CONTINUE
*
* Select and display specified objects
*
IF(IOPTC.NE.0) WRITE(LOUTCD,*) 'Objects : ',NOBJ
*
* Key definitions
*
IF(IOPTD.NE.0) THEN
WRITE(LOUTCD,*) ' Tags :'
WRITE(LOUTCD,9001) (CHTAG(J),J=1,NWKEY)
9001 FORMAT(8(2X,A8))
ENDIF
LK = IQ(KQSP+LCDIR+KLK)
*
* Loop over objects
*
DO 60 I=1,NOBJ
*
* Extract KEYS vector for this object
*
K = LK+(NWKEY+1)*(I-1)
*
* Selection on key serial number
*
IF(IOPTM.EQ.0.AND.
+ NKEYSN.NE.0.AND.IQ(KQSP+LCDIR+K+1).NE.NKEYSN) GOTO 60
DO 30 J=1,NWKEY
IKDES=(J-1)/10
IKBIT1=3*J-30*IKDES-2
IKTYPE = JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3)
KEYT(J) = IKTYPE
IF(IKTYPE.LT.3)THEN
KEYS(J)=IQ(KQSP+LCDIR+K+J)
ELSE
CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS(J),1)
ENDIF
30 CONTINUE
*
* Selection on validity ranges
*
J = 0
DO 40 K=KOFVAL,NSYSCK,2
J = J + 1
IF(KEYS(K) .LT.MINVAL(J)) MINVAL(J) = KEYS(K)
IF(KEYS(K+1).GT.MAXVAL(J)) MAXVAL(J) = KEYS(K+1)
40 CONTINUE
*
* Selection on key serial number
*
IF(NKEYSN.NE.0.AND.KEYS(1).NE.NKEYSN) GOTO 60
*
* Selection on insertion date and time
*
CALL CDUPTM(IDATE,ITIME,KEYS(KOFINS),IRC)
*
* Insertion date outside range
*
IF(IDATE.LT.IDATCD.OR.
+ (IDATE.GT.JDATCD.AND.JDATCD.NE.0)) GOTO 60
*
* Insertion date matches - check insertion time
*
IF(IDATE.EQ.IDATCD) THEN
IF(ITIME.LT.ITIMCD) GOTO 60
IF(ITIME.GT.JTIMCD.AND.JTIMCD.NE.0) GOTO 60
ENDIF
IF(IOPTZ.NE.0) THEN
CALL RZIN(IXPAWC,LINK01,JBIAS,KEYS,ICYCLE,' ')
CALL UHTOC(IQ(KQSP+LINK01-4),4,CHID,4)
*
* Check bank name
*
LNAME = LENOCC(CHBANK)
IF(LNAME.EQ.0.OR.CHBANK.EQ.CHID) THEN
CALL DZSHOW('HEPDB',IXPAWC,LINK01,'LV',ILNK1,ILNK2,
+ IDAT1,IDAT2)
NOBJM = NOBJM + 1
ENDIF
CALL MZDROP(IXPAWC,LINK01,'L')
LINK01 = 0
ELSE
NOBJM = NOBJM + 1
ENDIF
*
* Pointer to cycles
*
LKC=LK+(NWKEY+1)*(I-1)
LCYC=IQ(KQSP+LCDIR+LKC)
*
* Generic
*
IF(IOPTG.NE.0) THEN
IQPRSV = IQPRNT
IQPRNT = LOUTCD
ICYC = JBYT(IQ(KQSP+LCDIR+LCYC+3),21,12)
CALL RZPRNK(CHPATH,I,ICYC,' ')
IQPRNT = IQPRSV
ENDIF
*
* System keys
*
IF(IOPTS.NE.0) THEN
*
* Unpack insertion time
*
WRITE(LOUTCD,9002) (CHTAG(K),KEYS(K),K=KOFSYS,KOFPTR),
+ CHTAG(KOFFLG),KEYS(KOFFLG), CHTAG(KOFINS),IDATE,ITIME,
+ CHTAG(KOFSY1),KEYS(KOFSY1)
9002 FORMAT(' System keys: ',2(A8,1X,I11,1X),A8,1X,Z8/
+ 18X,A8,1X,I6,1X,I4,1X,A8,1X,I11)
ENDIF
*
* Experiment keys
*
IF(IOPTE.NE.0) THEN
WRITE(LOUTCD,9003) (CHTAG(K),KEYS(K),K=KOFEXP, KOFEXP+
+ NOFEXP-1)
9003 FORMAT(' Experiment keys: ',3(A8,1X,I11,1X)/
+ ' ',2(A8,1X,I11,1X))
ENDIF
*
* Validity range pairs
*
IF(IOPTV.NE.0) THEN
WRITE(LOUTCD,9004) (CHTAG(K),KEYS(K),K=KOFVAL,NSYSCK)
9004 FORMAT(' Validity pairs : ',2(A8,1X,I11,1X)/
+ (' ',2(A8,1X,I11,1X)))
ENDIF
*
* User keys
*
KOFUSR = NSYSCK + 1
IF(IOPTU.NE.0) THEN
IF(KOFUSR.LE.NWKEY) THEN
* WRITE(LOUTCD,9005) (CHTAG(K),KEYS(K),K=KOFUSR,NWKEY)
*9005 FORMAT(' User keys : ',2(A8,1X,I11,1X)/
* + (' ',2(A8,1X,I11,1X)))
CHLINE = ' User keys : '
IOFF = 19
DO 50 K=KOFUSR,NWKEY
IF(KEYT(K).LT.3) THEN
WRITE(CHLINE(IOFF:),'(A8,1X,I11)') CHTAG(K),
+ KEYS(K)
ELSE
WRITE(CHLINE(IOFF:),'(A8)') CHTAG(K)
CALL UHTOC(KEYS(K),4,CHLINE(IOFF+10:),4)
ENDIF
IOFF = IOFF + 21
IF(IOFF.GT.60) THEN
WRITE(LOUTCD,'(A)') CHLINE(1:IOFF-1)
CHLINE = ' '
IOFF = 19
ENDIF
50 CONTINUE
IF(IOFF.GT.19) WRITE(LOUTCD,'(A)') CHLINE(1:IOFF-1)
ELSE
IF(NSHOW.EQ.0) THEN
WRITE(LOUTCD,9005) CHPATH(1:LPATH)
9005 FORMAT(' No user keys in directory : ',A)
NSHOW = 1
ENDIF
ENDIF
ENDIF
*
* Number of data words
*
IF(IOPTN.NE.0) THEN
NW = JBYT(IQ(KQSP+LCDIR+LCYC+3),1,20)
WRITE(LOUTCD,*) '# words : ',NW
ENDIF
*
* Insertion date & time
*
IF(IOPTT.NE.0) THEN
CALL RZDATE(IQ(KQSP+LCDIR+LCYC+1),IDATE,ITIME,1)
WRITE(LOUTCD,*) 'Inserted : ',IDATE,ITIME
ENDIF
60 CONTINUE
IF(IOPTM.NE.0) THEN
DO 70 I=1,NPAICD
WRITE(LOUTCD,9006) I,MINVAL(I),MAXVAL(I)
9006 FORMAT(' Minimum/maximum values for validity pair # ',I3,
+ ' = ',I10,' / ',I10)
70 CONTINUE
ENDIF
END