      program makedb                                                    MAKE001
c ----------------------------------------------------------------------MAKE002
c     This program module is part of the PhysiSoft X-ray Library        MAKE003
c     and may not be sold or reproduced for commercial purposes.        MAKE004
c     Although it has been tested carefully, there is no warranty       MAKE005
c     regarding accuracy or freedom from side-effects.                  MAKE006
c                   (C) 1986-1994 Bernhard Rupp                         MAKE007
c ----------------------------------------------------------------------MAKE008
c     update 5-95 to create a SEXIE database 5.0 - new format :         MAKE009
c           Format of atom line is now :                                MAKE010
c           (a2,2x,a4,5f8.5,i3)                                         MAKE011
c           elem(ic),seq(ic),(xyz(ic,i),i=1,3),foc(ic),bf(ic),icalc(ic) MAKE012
c           XYZ are fractional coordinates, foc and bf can be anything  MAKE013
c           depending on what is to be calculated, and icalc is a flag  MAKE014
c                                                                       MAKE015
c     Affected routines : SEXIE (getinp.for)                            MAKE016
c                         MAKEDB                                        MAKE017
c                         INSHELL                                       MAKE018
c                         LPREP                                         MAKE019
c                                                                       MAKE020
c     databases previous version include following first line :         MAKE021
c     %% SEXIE data base file - contains input files for SEXIE          MAKE022
c     changed automatically to                                          MAKE023
c     %% SEXIE 4.0 data base file - contains input files for SEXIE      MAKE024
c     if detected and charge values of 0.0 added                        MAKE025
c                                                                       MAKE026
c ----------------------------------------------------------------------MAKE027
                                                                        MAKE028
c --- ifix is for a redesign of data base format                        MAKE029
                                                                        MAKE030
      character buf*60,lbl*2,infile*12,dbfile*12,idfile*12,k*12,aline*60MAKE031
      character icomp*4, backup*12,elem*2,ide*4                         MAKE032
      integer idx (3200), ifix                                          MAKE033
      real newver                                                       MAKE034
      dimension buf(100)                                                MAKE035
      logical exists                                                    MAKE036
                                                                        MAKE037
c --- default is no action, set the latest version number here          MAKE038
      ifix=0                                                            MAKE039
      newver=5.0                                                        MAKE040
                                                                        MAKE041
c --- look for SEXIE configuration file and read the computer type --   MAKE042
      inquire (file='SEXIE.CFG',exist=exists)                           MAKE043
      if (exists) then                                                  MAKE044
         open (4,file='SEXIE.CFG',status='old')                         MAKE045
         do 8808 i=1,7                                                  MAKE046
 8808       read (4,'(8x,a4)') icomp                                    MAKE047
         read(4,'(8x,a4)')   icomp                                      MAKE048
         call upstrg (icomp,4)                                          MAKE049
         close(4,status='keep')                                         MAKE050
      else                                                              MAKE051
         write (*,'(/a)') '  Cannot find configuration file SEXIE.CFG'  MAKE052
         write (*,*) ' Resuming with 7-bit TTY terminal character set'  MAKE053
         icomp  = '7BIT'                                                MAKE054
      end if                                                            MAKE055
                                                                        MAKE056
      call clrscr (icomp)                                               MAKE057
      call mdbtit(6,icomp,newver)                                       MAKE058
 7001 write(*,'(/a,a$)')'  File to be transformed into a data base (in',MAKE059
     &                  'clude extension): '                            MAKE060
      read(*,'(a12)') infile                                            MAKE061
      call upstrg (infile,12)                                           MAKE062
      inquire (file=infile,exist=exists)                                MAKE063
      if (.not.exists) then                                             MAKE064
         write(*,'(a,a)') '  Cannot find file ',infile                  MAKE065
         goto 7001                                                      MAKE066
      end if                                                            MAKE067
      open(unit=3,file=infile, status='old', err=9901)                  MAKE068
      k=infile                                                          MAKE069
 7002 write(*,'( a$)')'  Name for data base (extension will be .DBF) : 'MAKE070
      read(*,'(a12)') dbfile                                            MAKE071
      call upstrg (dbfile,12)                                           MAKE072
      call filnam (dbfile,'.DBF',0)                                     MAKE073
      idfile=dbfile                                                     MAKE074
      call filnam (idfile,'.IDX',0)                                     MAKE075
                                                                        MAKE076
c --- backup database if same name --                                   MAKE077
      if (k.eq.dbfile) then                                             MAKE078
         backup=k                                                       MAKE079
         call filnam(backup,'.OLD',0)                                   MAKE080
         write (*,'(a,a)') '  Backing up old database ',k               MAKE081
         write (*,'(a,a)') '  Creating backup file ',backup             MAKE082
         open(8,file=backup,status='unknown')                           MAKE083
         do 7007 i=1,32000                                              MAKE084
            read (3,'(a60)',end=7008)buf(1)                             MAKE085
            write(8,'(a60)')buf(1)                                      MAKE086
 7007    continue                                                       MAKE087
 7008    continue                                                       MAKE088
         close(3)                                                       MAKE089
         close(8)                                                       MAKE090
         open(3,file=backup,status='old')                               MAKE091
      end if                                                            MAKE092
      inquire (file=dbfile,exist=exists)                                MAKE093
      if (exists) then                                                  MAKE094
         open(1,file=dbfile,status='old')                               MAKE095
         close(1,status='delete')                                       MAKE096
         write(*,*)' Discarding old data base  ',dbfile                 MAKE097
      end if                                                            MAKE098
      inquire (file=idfile,exist=exists)                                MAKE099
      if (exists) then                                                  MAKE100
         open(2,file=idfile,status='old')                               MAKE101
         close(2,status='delete')                                       MAKE102
         write(*,*)' Discarding old index file ',idfile                 MAKE103
      end if                                                            MAKE104
                                                                        MAKE105
      write(*,*)' Opening random access data base file ',dbfile         MAKE106
      write(*,*)' Opening random data base index file  ',idfile         MAKE107
                                                                        MAKE108
      open(unit=1,file=dbfile, form='formatted', recl=60,               MAKE109
     & access='direct', status='new',err=9902)                          MAKE110
      open(unit=2,file=idfile, form='formatted', recl=6,                MAKE111
     & access='direct', status='new',err=9903)                          MAKE112
                                                                        MAKE113
      inrec=1                                                           MAKE114
      idrec=1                                                           MAKE115
      ieof=0                                                            MAKE116
c --- read the first 8 lines extra to find version of database          MAKE117
      do 6001 i=1,8                                                     MAKE118
         read(3,'(a)') buf(i)                                           MAKE119
 6001 continue                                                          MAKE120
                                                                        MAKE121
      read(buf(1),'(9x,f3.1)',err=6003) versio                          MAKE122
      goto 6004                                                         MAKE123
 6003 versio=1.0                                                        MAKE124
 6004 if (versio.ne.newver) then                                        MAKE125
         write(*,'(a,f3.1,a,f3.1)') '  Old database version ',versio,   MAKE126
     &                         ' - will be updated to version ',newver  MAKE127
         ifix=1                                                         MAKE128
         write(buf(1),'(a9,f3.1,a48)') '%% SEXIE ',newver,              MAKE129
     &         ' data base file - contains input files for SEXIE     '  MAKE130
         write(buf(8),'(a60)')                                          MAKE131
     &'%% 6. atom lines (a2,2x,a4,5f8.5,i3) atom,id,x,y,x,f,b,ical '    MAKE132
      else                                                              MAKE133
         write(*,'(a,f3.1)') '  Database is current version ', versio   MAKE134
         ifix=0                                                         MAKE135
      end if                                                            MAKE136
c --- write first 8 lines                                               MAKE137
      do 6002 ibuf=1,8                                                  MAKE138
         write (1,'(a60)',rec=idrec) buf(ibuf)                          MAKE139
         idrec=idrec+1                                                  MAKE140
 6002 continue                                                          MAKE141
                                                                        MAKE142
c --- read the rest in blocks of hundred                                MAKE143
 2000 continue                                                          MAKE144
      do 0001 ibuf=1,100                                                MAKE145
         read(3,'(a)',end=0002) buf(ibuf)                               MAKE146
 0001 continue                                                          MAKE147
      goto 0004                                                         MAKE148
 0002 ieof=1                                                            MAKE149
 0004 continue                                                          MAKE150
      iend=ibuf-1                                                       MAKE151
      do 0003 ibuf=1,iend                                               MAKE152
         write (1,'(a60)',rec=idrec) buf(ibuf)                          MAKE153
         read(buf(ibuf),'(a2)') lbl                                     MAKE154
         if (lbl.eq.'**') then                                          MAKE155
            write(2,'(i6)',rec=inrec) idrec                             MAKE156
            idx(inrec)=idrec                                            MAKE157
            inrec=inrec+1                                               MAKE158
         end if                                                         MAKE159
         idrec=idrec+1                                                  MAKE160
 0003 continue                                                          MAKE161
      if(ieof.eq.0) goto 2000                                           MAKE162
                                                                        MAKE163
c --- this passage for fixes in record structure --                     MAKE164
      if (ifix.eq.1) then                                               MAKE165
c ---    for each entry record do                                       MAKE166
         do 1003 i=1,inrec-1                                            MAKE167
c ---       read the atom lines --                                      MAKE168
            j=1                                                         MAKE169
            if ((i+1).gt.(inrec-1)) then                                MAKE170
               iend=idrec-1                                             MAKE171
            else                                                        MAKE172
               iend=idx(i+1)-1                                          MAKE173
            end if                                                      MAKE174
c ---       change the control parameter line to include disoct --      MAKE175
            write(1,'(a30,30x)',rec=idx(i)+2)                           MAKE176
     &            ' 10.0  .010   1   1.0  6.0  0'                       MAKE177
            do 1004 irec=idx(i)+5,iend                                  MAKE178
               read (1,'(a60)',rec=irec) buf(j)                         MAKE179
               j=j+1                                                    MAKE180
 1004       continue                                                    MAKE181
c ---       modify the atom lines --                                    MAKE182
            do 1005 ii=1,j-1                                            MAKE183
c ---       add standard charge to atoms for less that version 4.2 ---  MAKE184
               read (buf(ii),'(a)') aline                               MAKE185
               if (versio.lt.4.1) then                                  MAKE186
                  read(buf(ii),'(a2,2x,a4,3f8.4)') elem,ide,x,y,z       MAKE187
                  charge=getchg(elem)                                   MAKE188
c ---             old format was a2,2x,a4,3f8.4                         MAKE189
                  write(buf(ii),'(a2,2x,a4,5f8.4,i3,9x)')               MAKE190
     &                 elem,ide,x,y,z,1.0,charge,0                      MAKE191
               else if (versio.lt.5.0) then                             MAKE192
c ---         v4.2 atom lines, fmt a2,2x,a4,4f8.4 (atom,id,x,y,x,charge)MAKE193
                  read(buf(ii),'(a2,2x,a4,4f8.4)') elem,ide,x,y,z,chargeMAKE194
                  write(buf(ii),'(a2,2x,a4,5f8.4,i3,9x)')               MAKE195
     &                 elem,ide,x,y,z,1.0,charge,0                      MAKE196
               else                                                     MAKE197
                  write(buf(ii),'(a)') aline                            MAKE198
               end if                                                   MAKE199
 1005       continue                                                    MAKE200
c ---       write the new atom lines --                                 MAKE201
            j=1                                                         MAKE202
            do 1006 irec=idx(i)+5,iend                                  MAKE203
               write (1,'(a60)',rec=irec) buf(j)                        MAKE204
               j=j+1                                                    MAKE205
 1006       continue                                                    MAKE206
 1003    continue                                                       MAKE207
      end if                                                            MAKE208
                                                                        MAKE209
       close (unit=1,status='keep')                                     MAKE210
       close (unit=2,status='keep')                                     MAKE211
       close (unit=3,status='keep')                                     MAKE212
       goto 9999                                                        MAKE213
 9901  write(*,'(a,a)')'  Unable to access input file ',infile          MAKE214
       goto 9999                                                        MAKE215
 9902  write(*,'(a,a)')'  Unable to access data base  ',dbfile          MAKE216
       goto 9999                                                        MAKE217
 9903  write(*,'(a,a)')'  Unable to access index file ',idfile          MAKE218
       goto 9999                                                        MAKE219
                                                                        MAKE220
 9999  end                                                              MAKE221
                                                                        MAKE222
      subroutine mdbtit (ipr,icomp,newver)                              MDBT001
c -----------------------------------                                   MDBT002
c     interactive header                                                MDBT003
c -----------------------------------                                   MDBT004
      character lv,icomp*4                                              MDBT005
      real newver                                                       MDBT006
                                                                        MDBT007
      if (icomp.eq.'IBM ') then                                         MDBT008
         lv=char(179)                                                   MDBT009
      else                                                              MDBT010
         lv='|'                                                         MDBT011
      end if                                                            MDBT012
      call frames (ipr,1,icomp)                                         MDBT013
      write(ipr,'(1x,a1,23x,a,f3.1,24x,a1)')                            MDBT014
     & lv,' SEXIE Data Base Generator ',newver,lv                       MDBT015
      call frames (ipr,2,icomp)                                         MDBT016
      write(ipr,'(1x,a1,1x,a,a,4x,a1)')lv,'This utility program genera',MDBT017
     & 'tes a data base file (which has a constant   ',lv               MDBT018
      write(ipr,'(1x,a1,1x,a,a,4x,a1)')lv,'record length structure in ',MDBT019
     & 'order to allow random access) from a standard',lv               MDBT020
      write(ipr,'(1x,a1,1x,a,a,4x,a1)')lv,'sequential text file (as yo',MDBT021
     & 'u would generate using an ASCII text editor).',lv               MDBT022
      write(ipr,'(1x,a1,1x,a,a,1x,a1)')lv,'Although the data base has ',MDBT023
     & 'a non binary text format, always remember :     ',lv            MDBT024
      write(ipr,'(1x,a1,1x,a,a,2x,a1)')lv,'You HAVE TO RUN MAKEDB afte',MDBT025
     & 'r any changes you made in the data base file   ',lv             MDBT026
      write(ipr,'(1x,a1,1x,a,a,1x,a1)')lv,'using anything other than th'MDBT027
     & ,'e data base manager of the interactive input   ',lv            MDBT028
      write(ipr,'(1x,a1,1x,a,a,2x,a1)')lv,'generating program for SEXI',MDBT029
     & 'E !!                                           ',lv             MDBT030
      call frames (ipr,3,icomp)                                         MDBT031
      return                                                            MDBT032
      end                                                               MDBT033
