       subroutine dbase (ili,ierr,index,iol,dbasef,indexf,idx,ndx,icomp)DBAS001
c ----------------------------------------------------------------------DBAS002
c     data base management for INSEXIE - interactive routine            DBAS003
c     all info in ili input lines                                       DBAS004
c ----------------------------------------------------------------------DBAS005
c     This program module is part of the PhysiSoft X-ray Library        DBAS006
c     and may not be sold or reproduced for commercial purposes.        DBAS007
c     Although it has been tested carefully, there is no warranty       DBAS008
c     regarding accuracy or freedom from side-effects.                  DBAS009
c                   (C) 1986-1990 Bernhard Rupp                         DBAS010
c ----------------------------------------------------------------------DBAS011
                                                                        DBAS012
      parameter (iat=20,iidx=3200)                                      DBAS013
                                                                        DBAS014
      character answ,ili*60,indexf*25,dbasef*25,icomp*4                 DBAS015
      integer idx (iidx)                                                DBAS016
      logical exists                                                    DBAS017
      dimension ili(5*iat)                                              DBAS018
                                                                        DBAS019
      ipr=6                                                             DBAS020
      ierr=0                                                            DBAS021
      ic=0                                                              DBAS022
      inquire (file=dbasef,exist=exists)                                DBAS023
c --- return on error --                                                DBAS024
      if (.not.exists) then                                             DBAS025
         write(ipr,'(/a,a,/a)')'  Can''t find the data base file ',     DBAS026
     & dbasef,'  in current directory'                                  DBAS027
         print*,' Hit return to continue - select another option'       DBAS028
         call inkey (answ)                                              DBAS029
         ierr=1                                                         DBAS030
         return                                                         DBAS031
      end if                                                            DBAS032
      inquire (file=indexf,exist=exists)                                DBAS033
c --- return on error --                                                DBAS034
      if (.not.exists) then                                             DBAS035
         write(ipr,'(/a,a,/a)')'  Can''t find the index file ',         DBAS036
     & indexf,'  incurrent directory'                                   DBAS037
         print*,' Hit return to continue - select another option'       DBAS038
         call inkey (answ)                                              DBAS039
         ierr=1                                                         DBAS040
         return                                                         DBAS041
      end if                                                            DBAS042
                                                                        DBAS043
      open(unit=2,file=indexf, form='formatted', recl=6,                DBAS044
     & access='direct', status='old')                                   DBAS045
      open(unit=1,file=dbasef, form='formatted', recl=60,               DBAS046
     & access='direct', status='old')                                   DBAS047
                                                                        DBAS048
 22   format (a60)                                                      DBAS049
 23   format (i6)                                                       DBAS050
                                                                        DBAS051
c --- read index file                                                   DBAS052
 7999 write(ipr,'(/a)')'  Reading index file ..........'                DBAS053
      do 0001 i=1,iidx                                                  DBAS054
 0001    read(2,23,rec=i,err=0091) idx(i)                               DBAS055
 0091 ndx=i-1                                                           DBAS056
      do 0011 j=i,iidx                                                  DBAS057
         idx(j)=0                                                       DBAS058
 0011 continue                                                          DBAS059
c --- check index file on error                                         DBAS060
c      do 12 i=1,100                                                    DBAS061
c   12    print*,idx(i)                                                 DBAS062
c --- end error ---------------                                         DBAS063
      call clrscr (icomp)                                               DBAS064
      call dbtit(ipr,icomp)                                             DBAS065
c --- entry point for parser --                                         DBAS066
 7700 write(ipr,'(/a)')'  Full (D)irectory of Data Base (D)'            DBAS067
      write(ipr,'( a)')'  Search entry (L)abel          (L)'            DBAS068
      write(ipr,'( a)')'  Search (S)pace Group          (S)'            DBAS069
      write(ipr,'( a)')'  Retrieve (I)nput by Label     (I)'            DBAS070
      write(ipr,'( a)')'  D(e)lete an entry             (E)'            DBAS071
      write(ipr,'( a)')'  (P)ack the data base file     (P)'            DBAS072
      write(ipr,'( a)')'  Return to main menu           (X)'            DBAS073
      write(ipr,'(/a$)')'  Your choice > '                              DBAS074
      call inkey (answ)                                                 DBAS075
c --- valid answer --                                                   DBAS076
      if (answ.ne.'D'.and.answ.ne.'L'.and.answ.ne.'S'.and.answ.ne.'I'.anDBAS077
     &d.answ.ne.'X'.and.answ.ne.'E'.and.answ.ne.'P')   then             DBAS078
         write(ipr,*)' Ehh ??'                                          DBAS079
         call clrscr (icomp)                                            DBAS080
         goto 7700                                                      DBAS081
      end if                                                            DBAS082
                                                                        DBAS083
c --- exit ---                                                          DBAS084
      if (answ.eq.'X') then                                             DBAS085
         ierr=9                                                         DBAS086
         return                                                         DBAS087
c --- full directory ---                                                DBAS088
      elseif (answ.eq.'D') then                                         DBAS089
         call clrscr (icomp)                                            DBAS090
         call direct (idx,ndx)                                          DBAS091
                                                                        DBAS092
c --- partial directory --                                              DBAS093
      elseif (answ.eq.'L') then                                         DBAS094
         call pardir (idx,ndx,icomp)                                    DBAS095
                                                                        DBAS096
c --- space group search ---                                            DBAS097
      elseif (answ.eq.'S') then                                         DBAS098
         call spcdir (idx,ndx,icomp)                                    DBAS099
                                                                        DBAS100
c --- retrieve label ---                                                DBAS101
      elseif (answ.eq.'I') then                                         DBAS102
         call retriv (idx,ndx,ili,index,iol,ierr,icomp)                 DBAS103
         if (ierr.eq.0) return                                          DBAS104
c --- delete the entry --                                               DBAS105
      elseif (answ.eq.'E') then                                         DBAS106
         call delete (idx,ndx,icomp)                                    DBAS107
                                                                        DBAS108
c --- pack data base  --                                                DBAS109
      elseif (answ.eq.'P') then                                         DBAS110
         call packdb (idx,ndx,dbasef,indexf,icomp)                      DBAS111
         call clrscr (icomp)                                            DBAS112
         goto 7999                                                      DBAS113
      end if                                                            DBAS114
      call clrscr (icomp)                                               DBAS115
      goto 7700                                                         DBAS116
      end                                                               DBAS117
