* * $Id: rzldi1.F,v 1.3 1999/06/14 13:59:27 couet Exp $ * * $Log: rzldi1.F,v $ * Revision 1.3 1999/06/14 13:59:27 couet * - Mods for Y2K in the date/time output * * Revision 1.2 1996/04/24 17:26:58 mclareni * Extend the include file cleanup to dzebra, rz and tq, and also add * dependencies in some cases. * * Revision 1.1.1.1 1996/03/06 10:47:25 mclareni * Zebra * * #include "zebra/pilot.h" SUBROUTINE RZLDI1(IOPTA,IOPTX) * ************************************************************************ * * List current directory * Input: * IOPTA =1 to list All objects * IOPTX =1 for eXtended listing (default 80 columns) * * Called by * * Author : R.Brun DD/US/PD * Written : 19.01.89 * Last mod: 02.12.92 JDS. Increase IOFF2 to 50 * : 04.03.94 S.Banerjee (Change in cycle structure) * : 27.09.95 JDS. Increase width in format 10200 * ************************************************************************ #include "zebra/zunit.inc" #include "zebra/rzcl.inc" #include "zebra/rzdir.inc" #include "zebra/rzch.inc" #include "zebra/rzclun.inc" #include "zebra/rzk.inc" #include "zebra/rzckey.inc" #include "zebra/rzcycle.inc" CHARACTER*160 CHLD CHARACTER*1 CK DIMENSION IHTAG(40),IHDIR(4) #include "zebra/q_jbit.inc" #include "zebra/q_jbyt.inc" * *----------------------------------------------------------------------- * IOFF1 = 6 IF(IOPTX.EQ.0) THEN IOFF2 = 50 IOFF3 = 70 IOFF4 = 79 ELSE IOFF2 = 57 IOFF3 = 120 IOFF4 = 132 ENDIF * * General case * * LS=IQ(KQSP+LCDIR+KLS) IF(IQUEST(1).EQ.0)THEN CALL RZDATE(IQ(KQSP+LCDIR+KDATEC),IDATEC,ITIMEC,1) CALL RZDATE(IQ(KQSP+LCDIR+KDATEM),IDATEM,ITIMEM,1) DO 10 I=LEN(CHL),1,-1 IF(CHL(I:I).NE.' ')GO TO 20 10 CONTINUE 20 WRITE(IQPRNT,10000)CHL(1:I),IDATEC,ITIMEC,IDATEM,ITIMEM * NSDIR=IQ(KQSP+LCDIR+KNSD) IF(NSDIR.GT.0)THEN WRITE(IQPRNT,10100) DO 30 I=1,NSDIR IH=LS+7*(I-1) IF (KVSCYC.EQ.0) THEN IRECS = JBYT(IQ(KQSP+LCDIR+IH+5), 1,18) ELSE IRECS = IQ(KQSP+LCDIR+IH+5) ENDIF CALL RZDATE(IQ(KQSP+LCDIR+IH+6),IDATE,ITIME,1) CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4) WRITE(IQPRNT,10200)IHDIR,IDATE,ITIME,IRECS 30 CONTINUE ENDIF * XNUS = 0. NKEYS= IQ(KQSP+LCDIR+KNKEYS) NWKEY= IQ(KQSP+LCDIR+KNWKEY) LK = IQ(KQSP+LCDIR+KLK) NWK1 = NWKEY IF(NWKEY.GT.20)THEN WRITE(IQPRNT,11400) NWKEY NWKEY = 20 ENDIF NWK2 = 2*NWKEY KTAGS= KKDES+(NWK1-1)/10+1 CALL ZITOH(IQ(KQSP+LCDIR+KTAGS),IHTAG,NWK2) WRITE(IQPRNT,10300) CHLD=' ' IF( NWKEY .LE. 10 ) THEN WRITE(CHLD,10400)(IHTAG(I),I=1,NWK2) ELSE WRITE(CHLD,10400)(IHTAG(I),I=1,NWKEY) WRITE(IQPRNT,'(A)')CHLD(1:106) CHLD = ' ' WRITE(CHLD,10400)(IHTAG(I),I=NWKEY+1,NWK2) ENDIF IC1 = LENOCC(CHLD) + 2 IF(IC1.GT.IOFF2) THEN WRITE(IQPRNT,'(A)') CHLD(1:IC1) CHLD = ' ' ENDIF IC1 = IOFF2 IF(IOPTX.EQ.0) THEN WRITE(CHLD(IC1:IOFF4),10500) ELSE WRITE(CHLD(IC1:IOFF4),10600) ENDIF WRITE(IQPRNT,'(A)') CHLD(1:IOFF4) CHLD=' ' IF(NKEYS.GT.0)THEN DO 60 I=1,NKEYS LKC=LK+(NWK1+1)*(I-1) LCYC=IQ(KQSP+LCDIR+LKC) 40 IF (KVSCYC.EQ.0) THEN LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16) IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16) IR2 = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16) IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16) NW = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20) ELSE LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC) IR1 = IQ(KQSP+LCDIR+LCYC+KFRCYC) IR2 = IQ(KQSP+LCDIR+LCYC+KSRCYC) IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20) NW = IQ(KQSP+LCDIR+LCYC+KNWCYC) ENDIF CALL RZDATE( IQ(KQSP+LCDIR+LCYC+KFLCYC),IDATE,ITIME,1) IBIT4 = JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),4) IBIT5 = JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),5) IC = JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12) IF(IBIT5.EQ.0)THEN CK=' ' ELSE CK='*' ENDIF XNUS = XNUS+NW NLEFT=LREC-IP1+1 IF(NW.LE.NLEFT)THEN NR=0 ELSE NR=(NW-NLEFT-1)/LREC+1 ENDIF CHLD=' ' IC1=IOFF1 IFMOLD=0 DO 50 J=1,NWKEY IF(IC1.GT.IOFF3) THEN WRITE(IQPRNT,'(A)')CHLD(1:IC1) CHLD=' ' IC1=IOFF1 IFMOLD=0 ENDIF IKDES=(J-1)/10 IKBIT1=3*J-30*IKDES-2 IFORM=JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3) IF(IFORM.LT.3)THEN KEY(J)=IQ(KQSP+LCDIR+LKC+J) IF(IFMOLD.NE.0)IC1=IC1+10 IF(IFMOLD.EQ.4)IC1=IC1+6 IF(IABS(KEY(J)).LT.100000)THEN WRITE(CHLD(IC1:),'(I6)')KEY(J) ELSE WRITE(CHLD(IC1-4:),'(I10)')KEY(J) ENDIF ELSE CALL ZITOH(IQ(KQSP+LCDIR+LKC+J),KEY(J),1) IF(IFORM.EQ.3)THEN IF(IFMOLD.NE.0)IC1=IC1+10 IF(IFMOLD.EQ.4)IC1=IC1+6 WRITE(CHLD(IC1:),10700)KEY(J) ELSE IF(IFMOLD.EQ.4)IC1=IC1+4 IF(IFMOLD.NE.4.AND.IFMOLD.NE.0)IC1=IC1+10 WRITE(CHLD(IC1:),'(A4)')KEY(J) ENDIF ENDIF IFMOLD=IFORM 50 CONTINUE IC1=LENOCC(CHLD) + 2 IF(IC1.GT.IOFF2) THEN WRITE(IQPRNT,'(A)') CHLD(1:IC1) CHLD = ' ' ENDIF IC1 = IOFF2 IF(IOPTX.EQ.0) THEN WRITE(CHLD(IC1:),10800)IC,CK,IDATE,ITIME,NW ELSE IF(IR2.EQ.0)THEN WRITE(CHLD(IC1:),10900)IC,CK,IDATE,ITIME,NW,IP1, + IR1 ENDIF IF(NR.EQ.1)THEN WRITE(CHLD(IC1:),11000)IC,CK,IDATE,ITIME,NW,IP1, + IR1, IR2 ENDIF IF(NR.GT.1)THEN IRL=IR2+NR-1 WRITE(CHLD(IC1:),11100)IC,CK,IDATE,ITIME,NW,IP1, + IR1, IR2,IRL ENDIF ENDIF IF(IOPTA.NE.0.OR.IBIT4.EQ.0) + WRITE(IQPRNT,'(A)')CHLD(1:IOFF4) IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN LCYC=LCOLD GO TO 40 ENDIF 60 CONTINUE ENDIF * * Print statistics * 70 WRITE(IQPRNT,11200)IQ(KQSP+LCDIR+KRUSED),IQ(KQSP+LCDIR+KMEGA), + IQ(KQSP+LCDIR+KWUSED) XTOT =IQ(KQSP+LCDIR+KRUSED)*LREC IF(XTOT.GT.0.)THEN PERB =100.*XNUS/XTOT ELSE PERB=0. ENDIF PERD =100.*(FLOAT(IQ(KQSP+LCDIR+KRUSED)))/ + FLOAT(IQ(KQSP+LCDIR+KQUOTA)) PERF =100.*(FLOAT(IQ(KQSP+LCDIR+KRUSED)))/ + FLOAT(IQ(KQSP+LTOP +KQUOTA)) WRITE(IQPRNT,11300)PERD,PERF,PERB ENDIF * 10000 FORMAT(///,' ************** Directory ===> ',A,' <===',//, +17X,' Created ',I6.6,'/',I4.4,' Modified ',I6.6,'/',I4.4,/) 10100 FORMAT(/,' ===> List of subdirectories ') 10200 FORMAT(1X,4A4,' Created ',I6.6,'/',I4.4,' at record ',I10) 10300 FORMAT(/,' ===> List of objects ') 10400 FORMAT(5X,10(A4,A4,2X)) 10500 FORMAT(' CYCLE DATE/TIME NDATA') 10600 FORMAT(' CYCLE DATE/TIME NDATA OFFSET REC1 REC2') 10700 FORMAT(2X,A4) 10800 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6) 10900 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6,2X,I6,2X,I6) 11000 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6,2X,I6,2X,I6,2X,I6) 11100 FORMAT(4X,I4,A,2X,I6.6,'/',I4.4,1X,I6,2X,I6,2X,I6,2X,I6,' ==>',I6) 11200 FORMAT(/,' Number of records =',I5,' Number of megawords =', + I3,' +',I6,' words') 11300 FORMAT(' Per cent of directory quota used =',F8.3,/ + ' Per cent of file used =',F8.3,/ + ' Blocking factor =',F8.3) 11400 FORMAT(' RZLDI1. Cannot list more than 20 keys',/ + ' Number of keys found:',I10) 80 RETURN END