MINICERN/packlib/zebra/rz/rzldir.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:25  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE RZLDIR(CHPATH,CHOPT)
  11 *
  12 ************************************************************************
  13 *
  14 *       List directory CHPATH
  15 * Input:
  16 *   CHPATH  Character variable specifying the directory pathname.
  17 *           '  ' means list information for the CWD.
  18 *   CHOPT   Character variable specifying the options:
  19 *           default
  20 *           'A' List also Keys entered with option 'A'
  21 *           'T' List also subdirectory tree
  22 *           'X' eXtended listing - show also OFFSET,REC1,REC2
  23 *
  24 * Called by <USER>
  25 *
  26 *  Author  : R.Brun DD/US/PD
  27 *  Written : 06.04.86
  28 *  Last mod: 18.11.92 JDS - add option X
  29 *
  30 ************************************************************************
  31 #include "zebra/zunit.inc"
  32 #include "zebra/rzcl.inc"
  33 #include "zebra/rzdir.inc"
  34 #include "zebra/rzch.inc"
  35 #include "zebra/rzk.inc"
  36       CHARACTER *(*) CHPATH,CHOPT
  37       DIMENSION    IOPTV(3)
  38       EQUIVALENCE (IOPTA,IOPTV(1)), (IOPTT,IOPTV(2)), (IOPTX,IOPTV(3))
  39       DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
  40 *
  41 *-----------------------------------------------------------------------
  42 *
  43       IQUEST(1)=0
  44       IF(LQRS.EQ.0)GO TO 99
  45 *
  46 *            List TOP directory only
  47 *
  48       IF(CHPATH.EQ.'//')THEN
  49          WRITE(IQPRNT,7000)
  50          LRZ=LQRS
  51    2     IF(LRZ.NE.0)THEN
  52             LUNT   = IQ(KQSP+LRZ-5)
  53             IF(LUNT.EQ.0)GO TO 99
  54             CALL RZDATE(IQ(KQSP+LRZ+KDATEC),IDATEC,ITIMEC,1)
  55             CALL RZDATE(IQ(KQSP+LRZ+KDATEM),IDATEM,ITIMEM,1)
  56             CALL ZITOH(IQ(KQSP+LRZ+1),IHDIR,4)
  57             WRITE(IQPRNT,8000)IHDIR,LUNT,IDATEC,ITIMEC,IDATEM,ITIMEM
  58             LRZ=LQ(KQSP+LRZ)
  59             GO TO 2
  60          ENDIF
  61          GO TO 99
  62       ENDIF
  63 *
  64 *            General case
  65 *
  66       IF(LCDIR.EQ.0)GO TO 99
  67       CALL UOPTC (CHOPT,'ATX',IOPTV)
  68       CALL RZCDIR(CHWOLD,'R')
  69       CALL RZCDIR(CHPATH,' ')
  70       CALL RZPAFF(CHPAT,NLPAT,CHL)
  71       NLPAT0=NLPAT
  72       ITIME=0
  73 *
  74 *
  75 *            Set CWD to the current level
  76 *
  77   10  CONTINUE
  78       IF(ITIME.NE.0)THEN
  79          CALL RZPAFF(CHPAT,NLPAT,CHL)
  80          IF(IQUEST(1).NE.0)THEN
  81             NLPAT=NLPAT-1
  82             GO TO 20
  83          ENDIF
  84          CALL RZCDIR(CHL,' ')
  85       ENDIF
  86       IF(IQUEST(1).NE.0)THEN
  87          NLPAT=NLPAT-1
  88          GO TO 20
  89       ENDIF
  90       ISD(NLPAT)=0
  91       NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
  92 *
  93 *            List current directory
  94 *
  95       CALL RZLDI1(IOPTA,IOPTX)
  96       IF(IOPTT.EQ.0)GO TO 90
  97 *
  98 *            Process possible down directories
  99 *
 100   20  ISD(NLPAT)=ISD(NLPAT)+1
 101       IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
 102          NLPAT=NLPAT+1
 103          LS=IQ(KQSP+LCDIR+KLS)
 104          IH=LS+7*(ISD(NLPAT-1)-1)
 105          CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
 106          CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
 107          ITIME=ITIME+1
 108          GO TO 10
 109       ELSE
 110          NLPAT=NLPAT-1
 111          IF(NLPAT.GE.NLPAT0)THEN
 112             LUP=LQ(KQSP+LCDIR+1)
 113             CALL MZDROP(JQPDVS,LCDIR,' ')
 114             LCDIR=LUP
 115             GO TO 20
 116          ENDIF
 117       ENDIF
 118 *
 119 *            Reset CWD
 120 *
 121   90  CALL RZCDIR(CHWOLD,' ')
 122 *
 123  7000 FORMAT(///,' ************** List of TOP directories',/)
 124  8000 FORMAT(' //',4A4,'   LUN=',I6,
 125      +' Created ',I6,'/',I4,'  Modified ',I6,'/',I4)
 126   99  RETURN
 127       END