[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzrdir.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 10:47:26  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE RZRDIR(MAXDIR,CHDIR,NDIR)
*
************************************************************************
*
*       Returns the list of subdirectories of the CWD
* Input:
*   MAXDIR  Length of the character array CHDIR
* Output:
*   CHDIR*  Character  array  which  will  contain  the  directory  names
*           attached to the CWD.  If the  length of the directory name is
*           greater then the length of one  element of CHDIR (as obtained
*           by the LEN function),  only as many characters as will fit in
*           the array element are returned, and an error code will be set
*           in IQUEST(1).
*   NDIR*   Actual number of subdirectories attached to the CWD
*           If this number is greater than MAXDIR,  only the first MAXDIR
*           directory names will be returned in CHDIR (see IQUEST(12))
*
* Called by <USER>
*
*  Author  : R.Brun DD/US/PD
*  Written : 11.04.86
*  Last mod: 19.08.86
*
************************************************************************
#include "zebra/rzcl.inc"
#include "zebra/rzk.inc"
      DIMENSION IHDIR(4)
      CHARACTER*(*) CHDIR(*)
*
*-----------------------------------------------------------------------
*
      IQUEST(1)=0
      NDIR=0
      IF(LQRS.EQ.0) GO TO 99
      IF(LCDIR.EQ.0)GO TO 99
      NCHMAX= LEN(CHDIR(1))
      NCH   = MIN(NCHMAX,16)
      LS    = IQ(KQSP+LCDIR+KLS)
      NSDIR = IQ(KQSP+LCDIR+KNSD)
      IF(NSDIR.LE.MAXDIR)THEN
         NDIR=NSDIR
      ELSE
         NDIR=MAXDIR
         IQUEST(1)=1
      ENDIF
      IQUEST(11)=NSDIR
*
      DO 10 I=1,NDIR
         CALL ZITOH(IQ(KQSP+LCDIR+LS+7*(I-1)),IHDIR,4)
         CALL UHTOC(IHDIR,4,CHDIR(I),NCH)
  10  CONTINUE
*
  99  RETURN
      END
Commit	Line	Data
fe4da5cc	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