      subroutine spcdir (idx,ndx,icomp)                                 SPCD001
c ----------------------------------------------------------------------SPCD002
c     retrieves space group partial dir in SEXIE.DBF via SEXIE.IDX      SPCD003
c ----------------------------------------------------------------------SPCD004
c     This program module is part of the PhysiSoft X-ray Library        SPCD005
c     and may not be sold or reproduced for commercial purposes.        SPCD006
c     Although it has been tested carefully, there is no warranty       SPCD007
c     regarding accuracy or freedom from side-effects.                  SPCD008
c                   (C) 1986-1990 Bernhard Rupp                         SPCD009
c ----------------------------------------------------------------------SPCD010
      parameter (iat=20,iidx=3200)                                      SPCD011
                                                                        SPCD012
      character answ,title*60,spcgrp*10,spg*10,nlbl*8,icomp*4           SPCD013
      integer idx (iidx)                                                SPCD014
c     logical exists                                                    SPCD015
   22 format (a60)                                                      SPCD016
      ipr=6                                                             SPCD017
      ilines=0                                                          SPCD018
      ifi=0                                                             SPCD019
 0001 write (ipr,'(/a$)')'  Enter the space group to be searched : '    SPCD020
      read (*,'(a10)') spcgrp                                           SPCD021
      call upstrg(spcgrp,10)                                            SPCD022
      if(spcgrp.eq.' ') goto 0001                                       SPCD023
      call clrscr (icomp)                                               SPCD024
      print*,' Searching........'                                       SPCD025
      do 0005 i=1,ndx                                                   SPCD026
         if (idx(i).gt.0) then                                          SPCD027
         irec=idx(i)+4                                                  SPCD028
         read(1,'(a10)',rec=irec) spg                                   SPCD029
         if (spcgrp.eq.spg) then                                        SPCD030
            irec=idx(i)                                                 SPCD031
            read(1,'(2x,a8)',rec=irec) nlbl                             SPCD032
            read(1,22,rec=irec+1) title                                 SPCD033
            write(ipr,'(a,a)')  '  LABEL : ',nlbl                       SPCD034
            write(ipr,'(a,a)')  '  TITLE : ',title                      SPCD035
            write(ipr,'(a,a)')  '  SPCGR : ',spcgrp                     SPCD036
            ilines=ilines+3                                             SPCD037
            if (mod(ilines,21).eq.0) then                               SPCD038
               write(ipr,'(a$)') '  More (Y/N) : '                      SPCD039
               call inkey(answ)                                         SPCD040
               if (answ.ne.'Y') goto 0007                               SPCD041
               ilines=0                                                 SPCD042
            end if                                                      SPCD043
            ifi=1                                                       SPCD044
         end if                                                         SPCD045
         end if                                                         SPCD046
 0005 continue                                                          SPCD047
      if (ifi.eq.0) then                                                SPCD048
          print*,' Search string not found - ',spcgrp                   SPCD049
          print*,' Hit enter to continue'                               SPCD050
          call inkey (answ)                                             SPCD051
          call clrscr (icomp)                                           SPCD052
          return                                                        SPCD053
      end if                                                            SPCD054
      write(ipr,*)' '                                                   SPCD055
      write(ipr,*)' No more matching entries - hit enter to continue'   SPCD056
      call inkey (answ)                                                 SPCD057
 0007 call clrscr (icomp)                                               SPCD058
      return                                                            SPCD059
      end                                                               SPCD060
                                                                        SPCD061
