      subroutine pardir (idx,ndx,icomp)                                 PARD001
c ----------------------------------------------------------------------PARD002
c     retrieves partial directory in SEXIE.DBF via SEXIE.IDX            PARD003
c ----------------------------------------------------------------------PARD004
c     This program module is part of the PhysiSoft X-ray Library        PARD005
c     and may not be sold or reproduced for commercial purposes.        PARD006
c     Although it has been tested carefully, there is no warranty       PARD007
c     regarding accuracy or freedom from side-effects.                  PARD008
c                   (C) 1986-1990 Bernhard Rupp                         PARD009
c ----------------------------------------------------------------------PARD010
                                                                        PARD011
      parameter (iat=20,iidx=3200)                                      PARD012
                                                                        PARD013
      character answ,title*60,s(8),ss(8),icomp*4                        PARD014
      integer idx (iidx)                                                PARD015
                                                                        PARD016
   22 format (a60)                                                      PARD017
      ipr=6                                                             PARD018
      ilines=0                                                          PARD019
      ifi=0                                                             PARD020
 0001 write (ipr,'(/a$)')'  Enter the (partial) entry label string to bePARD021
     & searched : '                                                     PARD022
      read  (*,'(8a1)') (s(j),j=1,8)                                    PARD023
      do 0002 j=1,8                                                     PARD024
         call upstrg(s(j),1)                                            PARD025
         if(s(j).eq.char(32)) goto 0003                                 PARD026
 0002 continue                                                          PARD027
 0003 izap=j-1                                                          PARD028
      if (izap.lt.1) goto 0001                                          PARD029
      call clrscr (icomp)                                               PARD030
      print*,' Searching........'                                       PARD031
      do 0005 i=1,ndx                                                   PARD032
         if(idx(i).gt.0) then                                           PARD033
         irec=idx(i)                                                    PARD034
         read(1,'(2x,8a1)',rec=irec) (ss(j),j=1,8)                      PARD035
         isok=1                                                         PARD036
         do 0006 j=1,izap                                               PARD037
            if (s(j).ne.ss(j)) isok=0                                   PARD038
 0006    continue                                                       PARD039
         if (isok.eq.1) then                                            PARD040
            read(1,22,rec=irec+1) title                                 PARD041
            write(ipr,'(a,8a1)')  '  LABEL : ',(ss(j),j=1,8)            PARD042
            write(ipr,'(a,a)')  '  TITLE : ',title                      PARD043
            ilines=ilines+2                                             PARD044
            if (mod(ilines,22).eq.0) then                               PARD045
               write(ipr,'(a$)') '  More (Y/N) : '                      PARD046
               call inkey(answ)                                         PARD047
               if (answ.ne.'Y') goto 0007                               PARD048
               ilines=0                                                 PARD049
            end if                                                      PARD050
            ifi=1                                                       PARD051
         end if                                                         PARD052
         end if                                                         PARD053
 0005 continue                                                          PARD054
      if (ifi.eq.0) then                                                PARD055
          print*,' Search string not found - ',(s(j),j=1,8)             PARD056
          print*,' Hit enter to continue '                              PARD057
          call inkey (answ)                                             PARD058
          call clrscr (icomp)                                           PARD059
          return                                                        PARD060
      end if                                                            PARD061
      write(ipr,'(a,/a)') ' ',                                          PARD062
     & '  No more matching entries found - hit enter to continue '      PARD063
      call inkey (answ)                                                 PARD064
 0007 call clrscr (icomp)                                               PARD065
      return                                                            PARD066
      end                                                               PARD067
                                                                        PARD068
