MINICERN/packlib/zebra/rz/rzrdir.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:26  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE RZRDIR(MAXDIR,CHDIR,NDIR)
  11 *
  12 ************************************************************************
  13 *
  14 *       Returns the list of subdirectories of the CWD
  15 * Input:
  16 *   MAXDIR  Length of the character array CHDIR
  17 * Output:
  18 *   CHDIR*  Character  array  which  will  contain  the  directory  names
  19 *           attached to the CWD.  If the  length of the directory name is
  20 *           greater then the length of one  element of CHDIR (as obtained
  21 *           by the LEN function),  only as many characters as will fit in
  22 *           the array element are returned, and an error code will be set
  23 *           in IQUEST(1).
  24 *   NDIR*   Actual number of subdirectories attached to the CWD
  25 *           If this number is greater than MAXDIR,  only the first MAXDIR
  26 *           directory names will be returned in CHDIR (see IQUEST(12))
  27 *
  28 * Called by <USER>
  29 *
  30 *  Author  : R.Brun DD/US/PD
  31 *  Written : 11.04.86
  32 *  Last mod: 19.08.86
  33 *
  34 ************************************************************************
  35 #include "zebra/rzcl.inc"
  36 #include "zebra/rzk.inc"
  37       DIMENSION IHDIR(4)
  38       CHARACTER*(*) CHDIR(*)
  39 *
  40 *-----------------------------------------------------------------------
  41 *
  42       IQUEST(1)=0
  43       NDIR=0
  44       IF(LQRS.EQ.0) GO TO 99
  45       IF(LCDIR.EQ.0)GO TO 99
  46       NCHMAX= LEN(CHDIR(1))
  47       NCH   = MIN(NCHMAX,16)
  48       LS    = IQ(KQSP+LCDIR+KLS)
  49       NSDIR = IQ(KQSP+LCDIR+KNSD)
  50       IF(NSDIR.LE.MAXDIR)THEN
  51          NDIR=NSDIR
  52       ELSE
  53          NDIR=MAXDIR
  54          IQUEST(1)=1
  55       ENDIF
  56       IQUEST(11)=NSDIR
  57 *
  58       DO 10 I=1,NDIR
  59          CALL ZITOH(IQ(KQSP+LCDIR+LS+7*(I-1)),IHDIR,4)
  60          CALL UHTOC(IHDIR,4,CHDIR(I),NCH)
  61   10  CONTINUE
  62 *
  63   99  RETURN
  64       END