* * $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