MINICERN/packlib/zebra/rz/rzscan.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 RZSCAN(CHPATH,UROUT)
  11 *
  12 ************************************************************************
  13 *
  14 *       Scan all directories from CHPATH and call user routine UROUT
  15 *       for directory CHPATH and for every subdirectory.
  16 * Input:
  17 *   CHPATH  Character variable specifying the directory pathname.
  18 *           '  ' means  the CWD.
  19 *   UROUT   EXTERNAL user routine to be called for each directory
  20 *
  21 * Called by <USER>
  22 *
  23 *  Author  : R.Brun DD/US/PD
  24 *  Written : 17.07.91
  25 *  Last mod: 22.10.92 JDS - return immediately if cannot cd to CHPATH
  26 *
  27 ************************************************************************
  28 #include "zebra/rzcl.inc"
  29 #include "zebra/rzdir.inc"
  30 #include "zebra/rzch.inc"
  31 #include "zebra/rzk.inc"
  32       CHARACTER *(*) CHPATH
  33       EXTERNAL UROUT
  34       DIMENSION ISD(NLPATM),NSD(NLPATM),IHDIR(4)
  35 *
  36 *-----------------------------------------------------------------------
  37 *
  38       IQUEST(1)=0
  39       IF(LQRS.EQ.0)GO TO 99
  40 *
  41 *            General case
  42 *
  43       IF(LCDIR.EQ.0)GO TO 99
  44       CALL RZCDIR(CHWOLD,'R')
  45       CALL RZCDIR(CHPATH,' ')
  46       IF(IQUEST(1).NE.0) GOTO 99
  47       CALL RZPAFF(CHPAT,NLPAT,CHL)
  48       NLPAT0=NLPAT
  49       ITIME=0
  50 *
  51 *
  52 *            Set CWD to the current level
  53 *
  54   10  CONTINUE
  55       IF(ITIME.NE.0)THEN
  56          CALL RZPAFF(CHPAT,NLPAT,CHL)
  57       IF(IQUEST(1).NE.0)THEN
  58          NLPAT=NLPAT-1
  59          GO TO 20
  60       ENDIF
  61          CALL RZCDIR(CHL,' ')
  62       ENDIF
  63       IF(IQUEST(1).NE.0)THEN
  64          NLPAT=NLPAT-1
  65          GO TO 20
  66       ENDIF
  67       ISD(NLPAT)=0
  68       NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
  69 *
  70 *            List current directory
  71 *
  72       CALL UROUT(CHL)
  73 *
  74 *            Process possible down directories
  75 *
  76   20  ISD(NLPAT)=ISD(NLPAT)+1
  77       IF(ISD(NLPAT).LE.NSD(NLPAT))THEN
  78          NLPAT=NLPAT+1
  79          LS=IQ(KQSP+LCDIR+KLS)
  80          IH=LS+7*(ISD(NLPAT-1)-1)
  81          CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
  82          CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
  83          ITIME=ITIME+1
  84          GO TO 10
  85       ELSE
  86          NLPAT=NLPAT-1
  87          IF(NLPAT.GE.NLPAT0)THEN
  88             LUP=LQ(KQSP+LCDIR+1)
  89             CALL MZDROP(JQPDVS,LCDIR,' ')
  90             LCDIR=LUP
  91             GO TO 20
  92          ENDIF
  93       ENDIF
  94 *
  95 *            Reset CWD
  96 *
  97   90  CALL RZCDIR(CHWOLD,' ')
  98 *
  99   99  RETURN
 100       END