*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/02 09:52:57  jamie
* save LOLD - crash on HP
*
* Revision 1.1.1.1  1996/03/07 15:18:05  mclareni
* Fatmen
*
*
#include "fatmen/pilot.h"
      SUBROUTINE FMLDIR(PATH,FILES,NFOUND,MAXFIL,ICONT,IRC)
*
************************************************************************
*
*        To traverse the FATMEN directory tree starting from
*        the specified pathname.
*        Modified from the RZ routine RZSTAT / RZSCAN
*
************************************************************************
#include "fatmen/faust.inc"
#include "fatmen/slate.inc"
#include "zebra/rzcl.inc"
#include "zebra/rzdir.inc"
#include "zebra/rzch.inc"
#include "zebra/rzk.inc"
      CHARACTER*(*) PATH,FILES(MAXFIL)
      CHARACTER*255 CHPATH
      PARAMETER     (MAXLEV=20)
      CHARACTER*16  DIRNAM(MAXLEV),CHDIR
      DIMENSION     ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
      DIMENSION     IOPTV(2)
      EQUIVALENCE   (IOPTQ,IOPTV(1)), (IOPTX,IOPTV(2))
#include "fatmen/farnge.inc"
#include "fatmen/fatbug.inc"
      SAVE          CHPATH,LPATH,LPATHI,DIRNAM,ISD,NSD,ITIME,LOLD
*
*-----------------------------------------------------------------------
*
*
      NFLDIR     = NFLDIR + 1
      IRC        = 0
      IQUEST(1)  = 0
      IQUEST(11) = 0
      LPATH      = LENOCC(PATH)
      LPATHI     = LPATH
 
      NLEV       = 99
      NFOUND     = 0
      IF(ICONT.NE.0) GOTO 10
 
      CHPATH     = PATH(1:LPATH)
      CALL CLTOU(CHPATH(1:LPATH))
*
      ITEMP  = 0
      CALL FACDIR(CHWOLD,'R')
      LOLD   = LENOCC(CHWOLD)
      ITIME  = 0
*
*     Split input path name into its component pieces
*     (this is the opposite of RZPAFF which glues them together)
*
      CALL FMPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
*
*     Find first wild card in generic name
*
      IF(IDEBFA.GE.3)
     +PRINT *,'FMLDIR. enter for PATH = ',CHPATH(1:LPATH)
      CALL FMNWRD('/',CHPATH(3:LPATHI),NLEV0)
      IWILD  = ICFMUL('*%(<>',CHPATH,1,LPATH)
      IF(IWILD.LE.LPATH) THEN
         LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
         CALL FMNWRD('/',CHPATH(LPATH+2:LPATHI),NLEV1)
         NLEV  = MIN(99,NLEV+NLEV1)
      ELSE
         LPATHI = LPATHI + 2
*   G.Folger                         "/*" would fool the cpp, so split it...
         CHPATH(LPATHI-1:LPATHI-1) = '/'
         CHPATH(LPATHI:LPATHI) = '*'
      ENDIF
 
      IF(IDEBFA.GE.3) PRINT *,'FMLDIR. show directories ',
     +   'below ',CHPATH(1:LPATH),' down ',NLEV,' levels'
*
*            Set CWD to the current level
*
   10 CONTINUE
      IF(ITIME.NE.0)THEN
         CALL RZPAFF(CHPAT,NLPAT,CHL)
         IF(IQUEST(1).NE.0) THEN
            NLPAT = NLPAT -1
            GOTO 50
         ENDIF
         CALL FACDIR(CHL,' ')
      ELSE
         CALL FACDIR(CHPATH(1:LPATH),' ')
         IF(IQUEST(1).NE.0) THEN
            IRC = 1
            GOTO 80
         ENDIF
         NLPAT0=NLPAT
         CHL = CHPATH(1:LPATH)
      ENDIF
      IF(IQUEST(1).NE.0) THEN
         NLPAT = NLPAT -1
         GOTO 50
      ENDIF
*
*     Ensure that entire path name matches before calling UROUT
*
      CALL FMATCH(CHL,CHPATH(1:LPATHI),IRC)
      IF(IRC.EQ.0) THEN
         NFOUND = NFOUND + 1
         IF(NFOUND.LE.MAXFIL) THEN
            FILES(NFOUND) = CHL
         ELSE
            IRC    = -1
            ICOUNT = 0
            NFOUND = MAXFIL
            RETURN
         ENDIF
      ENDIF
 
      ISD(NLPAT)=0
      NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
*
*     If there is a <> at this level, perform matching
*     and follow only that path
*
      ILT = INDEX(DIRNAM(NLPAT+1),'<')
      IGT = INDEX(DIRNAM(NLPAT+1),'>')
      NFRNGE(NLPAT+1) = 0
 
      IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
         IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. invalid wild-carding ',
     +      'at level ',NLPAT,' in pathname - ',DIRNAM(NLPAT+1)
         IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. only one of < or > ',
     +      'may be specified'
         IQUEST(1) = -1
         GOTO 60
      ENDIF
 
      IF(ILT+IGT.NE.0) THEN
*
*     Is there a [mm:nn] syle range?
*
         JR  = LENOCC(DIRNAM(NLPAT+1))
         ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
         IF(ISQ.NE.0) THEN
            ILOW   = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
            IF(IS(1).EQ.0) THEN
               IRC = 2
               IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. error reading ',
     +            'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
               IF(IDEBFA.GE.-3) PRINT *,'        Only integer ranges ',
     +            'are supported between [] characters, e.g. [10:20]'
               GOTO 80
             ENDIF
            IHIGH  = ICDECI(DIRNAM(NLPAT+1),
     +               INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
            IF(IS(1).EQ.0) THEN
               IRC = 3
               IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. error reading ',
     +            'decimal value from ',DIRNAM(NLPAT+1)(ISQ:JR)
               IF(IDEBFA.GE.-3) PRINT *,'        Only integer ranges ',
     +            'are supported between [] characters, e.g. [10:20]'
               GOTO 80
             ENDIF
            IF(IDEBFA.GE.3) PRINT *,'FMLDIR. ilow/ihigh = ',ILOW,IHIGH
            NFRNGE(NLPAT+1) = 0
            IF(IHIGH-ILOW+1.GT.100) THEN
               IF(IDEBFA.GE.-3) PRINT *,'FMLDIR. maximum range is 100',
     +            ' - excess elements will be ignored'
               IHIGH = ILOW + 99
            ENDIF
            DO 20 JJ=ILOW,IHIGH
            NFRNGE(NLPAT+1) = NFRNGE(NLPAT+1) + 1
            IFRNGE(NFRNGE(NLPAT+1),NLPAT+1) = JJ
            IFELEM(NFRNGE(NLPAT+1),NLPAT+1) = -1
            IF(ILT.NE.0) THEN
               IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = 999999
            ELSE
               IFVAL(NFRNGE(NLPAT+1),NLPAT+1) = -1
            ENDIF
   20       CONTINUE
         ENDIF
*
*     Loop over all subdirectories at this level
*
         DO 30 JJ=1,NSD(NLPAT)
            LS=IQ(KQSP+LCDIR+KLS)
            IH=LS+7*(JJ-1)
            CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
            CALL UHTOC(IHDIR,4,CHDIR,16)
*
*     Set IQUEST(13) to number of elements in directory name
*
            IQUEST(13) = NLPAT
            CALL FASELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
   30       CONTINUE
         IF(JINDEX.GT.0) THEN
            IF(NFRNGE(NLPAT+1).EQ.0) THEN
               IF(IDEBFA.GE.3) THEN
                  LS=IQ(KQSP+LCDIR+KLS)
                  IH=LS+7*(JINDEX-1)
                  CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
                  CALL UHTOC(IHDIR,4,CHDIR,16)
                  PRINT *,'FMLDIR. selected subdirectory ',CHDIR
               ENDIF
               NSD(NLPAT) = JINDEX
               ISD(NLPAT) = JINDEX - 1
            ELSE
               LS=IQ(KQSP+LCDIR+KLS)
               IF(IDEBFA.GE.3)
     +            PRINT *,'FMLDIR. selected following subdirectories...'
               JMIN = 999999
               JMAX = 0
               DO 40 II=1,NFRNGE(NLPAT+1)
                  JJ=IFELEM(II,NLPAT+1)
                  IF(JJ.LE.0) GOTO 40
                  IF(JJ.LT.JMIN) JMIN = JJ
                  IF(JJ.GT.JMAX) JMAX = JJ
                  IF(IDEBFA.GE.3) THEN
                     IH=LS+7*(JJ-1)
                     CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
                     CALL UHTOC(IHDIR,4,CHDIR,16)
                     PRINT *,CHDIR
                  ENDIF
   40          CONTINUE
               NSD(NLPAT) = JMAX
               ISD(NLPAT) = JMIN - 1
            ENDIF
         ELSE
               IF(IDEBFA.GE.2)
     +         PRINT *,'FMLDIR. no subdirectory matches'
            NSD(NLPAT) = 0
         ENDIF
      ELSE
         JINDEX = -1
      ENDIF
*
*            Process possible down directories
*
   50 ISD(NLPAT)=ISD(NLPAT)+1
      IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
     +   (NLPAT.LT.(NLPAT0+NLEV))) THEN
         IF(NFRNGE(NLPAT+1).NE.0
     +      .AND.IUFIND(ISD(NLPAT),
     +         IFELEM(1,NLPAT+1),1,NFRNGE(NLPAT+1)).GT.
     +         NFRNGE(NLPAT+1)) GOTO 50
         NLPAT=NLPAT+1
         LS=IQ(KQSP+LCDIR+KLS)
         IH=LS+7*(ISD(NLPAT-1)-1)
         CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
         CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
         ITIME=ITIME+1
         GO TO 10
      ELSE
*
*            Write information on current directory
*
         CALL RZPAFF(CHPAT,NLPAT,CHL)
*        IF(NLPAT.LE.(NLPAT0+NLEV))THEN
*           NFOUND = NFOUND + 1
*        ENDIF
         NLPAT=NLPAT-1
         IF(NLPAT.GE.NLPAT0)THEN
            LUP=LQ(KQSP+LCDIR+1)
            CALL MZDROP(JQPDVS,LCDIR,' ')
            LCDIR=LUP
            GO TO 50
         ENDIF
      ENDIF
*
*            Reset CWD
*
   60 CALL FACDIR(CHWOLD(1:LOLD),' ')
*
   70 CONTINUE
      IRC        = 0
   80 CONTINUE
      IQUEST(11) = NFOUND
      RETURN
      END
