      program makedb                                                    MAKE001
c ----------------------------------------------------------------------MAKE002
c     generates a data base file (32000*a60) from a sequential          MAKE003
c     text file - needed to convert a modified database for SEXIE       MAKE004
c     into a constant record length file                                MAKE005
c ----------------------------------------------------------------------MAKE006
c     This program module is part of the PhysiSoft X-ray Library        MAKE007
c     and may not be sold or reproduced for commercial purposes.        MAKE008
c     Although it has been tested carefully, there is no warranty       MAKE009
c     regarding accuracy or freedom from side-effects.                  MAKE010
c                   (C) 1986-1990 Bernhard Rupp                         MAKE011
c ----------------------------------------------------------------------MAKE012
      parameter (ifix=0)                                                MAKE013
                                                                        MAKE014
c --- ifix is only for a temporary redesign of data base - set to zero  MAKE015
c     for all normal operations BR.                                     MAKE016
                                                                        MAKE017
      character buf*60,lbl*2,infile*12,dbfile*12,idfile*12,k*12,aline*60MAKE018
      character icomp*4                                                 MAKE019
      integer idx (3200)                                                MAKE020
      dimension buf(100)                                                MAKE021
      logical exists                                                    MAKE022
                                                                        MAKE023
c --- look for SEXIE configuration file and read the computer type --   MAKE024
      inquire (file='SEXIE.CFG',exist=exists)                           MAKE025
      if (exists) then                                                  MAKE026
         open (4,file='SEXIE.CFG',status='old')                         MAKE027
         do 8808 i=1,7                                                  MAKE028
 8808       read (4,'(8x,a4)') icomp                                    MAKE029
         read(4,'(8x,a4)')   icomp                                      MAKE030
         call upstrg (icomp,4)                                          MAKE031
         close(4,status='keep')                                         MAKE032
      else                                                              MAKE033
         write (*,'(/a)') '  Cannot find configuration file SEXIE.CFG'  MAKE034
         write (*,*) ' Resuming with 7-bit TTY terminal character set'  MAKE035
         icomp  = '7BIT'                                                MAKE036
      end if                                                            MAKE037
                                                                        MAKE038
      call clrscr (icomp)                                               MAKE039
      call mdbtit(6,icomp)                                              MAKE040
 7001 write(*,'(/a$)') '  File to be transformed into a data base : '   MAKE041
      read(*,'(a12)') infile                                            MAKE042
      call upstrg (infile,12)                                           MAKE043
      inquire (file=infile,exist=exists)                                MAKE044
      if (.not.exists) then                                             MAKE045
         write(*,'(a,a)') '  Cannot find file ',infile                  MAKE046
         goto 7001                                                      MAKE047
      end if                                                            MAKE048
      open(unit=3,file=infile, status='old', err=9901)                  MAKE049
      k=infile                                                          MAKE050
 7002 write(*,'(/a )')'  Name for data base (do not enter default file eMAKE051
     &xtension .DBF) '                                                  MAKE052
      idfile=dbfile                                                     MAKE053
      call filnam (dbfile,'.DBF',1)                                     MAKE054
      idfile=dbfile                                                     MAKE055
      call filnam (idfile,'.IDX',0)                                     MAKE056
      if (k.eq.dbfile) goto 9904                                        MAKE057
      inquire (file=dbfile,exist=exists)                                MAKE058
      if (exists) then                                                  MAKE059
         open(1,file=dbfile,status='old')                               MAKE060
         close(1,status='delete')                                       MAKE061
         write(*,*)' Discarding old data base  ',dbfile                 MAKE062
      end if                                                            MAKE063
      inquire (file=idfile,exist=exists)                                MAKE064
      if (exists) then                                                  MAKE065
         open(2,file=idfile,status='old')                               MAKE066
         close(2,status='delete')                                       MAKE067
         write(*,*)' Discarding old index file ',idfile                 MAKE068
      end if                                                            MAKE069
                                                                        MAKE070
      write(*,*)' Opening random access data base file ',dbfile         MAKE071
      write(*,*)' Opening random data base index file  ',idfile         MAKE072
                                                                        MAKE073
      open(unit=1,file=dbfile, form='formatted', recl=60,               MAKE074
     & access='direct', status='new',err=9902)                          MAKE075
      open(unit=2,file=idfile, form='formatted', recl=6,                MAKE076
     & access='direct', status='new',err=9903)                          MAKE077
                                                                        MAKE078
      inrec=1                                                           MAKE079
      idrec=1                                                           MAKE080
      ieof=0                                                            MAKE081
 2000 continue                                                          MAKE082
      do 0001 ibuf=1,100                                                MAKE083
         read(3,'(a)',end=0002) buf(ibuf)                               MAKE084
 0001 continue                                                          MAKE085
      goto 0004                                                         MAKE086
 0002 ieof=1                                                            MAKE087
 0004 continue                                                          MAKE088
      iend=ibuf-1                                                       MAKE089
      do 0003 ibuf=1,iend                                               MAKE090
         write (1,'(a60)',rec=idrec) buf(ibuf)                          MAKE091
         read(buf(ibuf),'(a2)') lbl                                     MAKE092
         if (lbl.eq.'**') then                                          MAKE093
            write(2,'(i6)',rec=inrec) idrec                             MAKE094
            idx(inrec)=idrec                                            MAKE095
            inrec=inrec+1                                               MAKE096
         end if                                                         MAKE097
         idrec=idrec+1                                                  MAKE098
 0003 continue                                                          MAKE099
      if(ieof.eq.0) goto 2000                                           MAKE100
                                                                        MAKE101
c --- this passage for fixes in record structure --                     MAKE102
      if (ifix.eq.1) then                                               MAKE103
c ---    for each entry record do                                       MAKE104
         do 1003 i=1,inrec-1                                            MAKE105
c ---       read the atom lines --                                      MAKE106
            j=1                                                         MAKE107
            if ((i+1).gt.(inrec-1)) then                                MAKE108
               iend=idrec-1                                             MAKE109
            else                                                        MAKE110
               iend=idx(i+1)-1                                          MAKE111
            end if                                                      MAKE112
            do 1004 irec=idx(i)+5,iend                                  MAKE113
               read (1,'(a60)',rec=irec) buf(j)                         MAKE114
               j=j+1                                                    MAKE115
 1004       continue                                                    MAKE116
c ---       modify the atom lines --                                    MAKE117
            do 1005 ii=1,j-1                                            MAKE118
               read (buf(ii),'(a)') aline                               MAKE119
               write(buf(ii),'(a32,f6.3,22x)') aline,1.0                MAKE120
 1005       continue                                                    MAKE121
c ---       write the new atom lines --                                 MAKE122
            j=1                                                         MAKE123
            do 1006 irec=idx(i)+5,iend                                  MAKE124
               write (1,'(a60)',rec=irec) buf(j)                        MAKE125
               j=j+1                                                    MAKE126
 1006       continue                                                    MAKE127
 1003    continue                                                       MAKE128
      end if                                                            MAKE129
                                                                        MAKE130
       close (unit=1,status='keep')                                     MAKE131
       close (unit=2,status='keep')                                     MAKE132
       close (unit=3,status='keep')                                     MAKE133
       goto 9999                                                        MAKE134
 9901  write(*,'(a,a)')'  Unable to access input file ',infile          MAKE135
       goto 9999                                                        MAKE136
 9902  write(*,'(a,a)')'  Unable to access data base  ',dbfile          MAKE137
       goto 9999                                                        MAKE138
 9903  write(*,'(a,a)')'  Unable to access index file ',idfile          MAKE139
       goto 9999                                                        MAKE140
 9904  write (*,*) ' Can''t open the same file for simultaneous read andMAKE141
     & write: ',k                                                       MAKE142
       write (*,*) ' Please rename the input data file '                MAKE143
       goto 9999                                                        MAKE144
                                                                        MAKE145
 9999  end                                                              MAKE146
                                                                        MAKE147
      subroutine mdbtit (ipr,icomp)                                     MDBT001
c -----------------------------------                                   MDBT002
c     interactive header                                                MDBT003
c -----------------------------------                                   MDBT004
      character lv,icomp*4                                              MDBT005
                                                                        MDBT006
      if (icomp.eq.'IBM ') then                                         MDBT007
         lv=char(179)                                                   MDBT008
      else                                                              MDBT009
         lv='|'                                                         MDBT010
      end if                                                            MDBT011
      call frames (ipr,1,icomp)                                         MDBT012
      write(ipr,'(1x,a1,25x,a,25x,a1)')                                 MDBT013
     & lv,' SEXIE Data Base Generator ',lv                              MDBT014
      call frames (ipr,2,icomp)                                         MDBT015
      write(ipr,'(1x,a1,1x,a,a,4x,a1)')lv,'This utility program genera',MDBT001
     & 'tes a data base file (which has a constant   ',lv               MDBT002
      write(ipr,'(1x,a1,1x,a,a,4x,a1)')lv,'record length structure in ',MDBT003
     & 'order to allow random access) from a standard',lv               MDBT004
      write(ipr,'(1x,a1,1x,a,a,4x,a1)')lv,'sequential text file (as yo',MDBT005
     & 'u would generate using an ASCII text editor).',lv               MDBT006
      write(ipr,'(1x,a1,1x,a,a,1x,a1)')lv,'Although the data base has ',MDBT007
     & 'a non binary text format, always remember :     ',lv            MDBT008
      write(ipr,'(1x,a1,1x,a,a,2x,a1)')lv,'You HAVE TO RUN MAKEDB afte',MDBT009
     & 'r any changes you made in the data base file   ',lv             MDBT010
      write(ipr,'(1x,a1,1x,a,a,1x,a1)')lv,'using anything other than th'MDBT011
     & ,'e data base manager of the interactive input   ',lv            MDBT012
      write(ipr,'(1x,a1,1x,a,a,2x,a1)')lv,'generating program for SEXI',MDBT001
     & 'E !!                                           ',lv             MDBT002
      call frames (ipr,3,icomp)                                         MDBT003
      return                                                            MDBT004
      end                                                               MDBT005
