                          PROGRAM INSHELL                               INSH001
C-----------------------------------------------------------------------INSH002
C     This smart program creates an input file for SEXIE                INSH003
C                        (B.Rupp, 1990)                                 INSH004
C                    Generic FORTRAN VERSION                            INSH005
C               (C) Copyright Bernhard Rupp 1990-1991                   INSH006
C     Uses routines of the XLIB Library (C) Physisoft Corp, Austria     INSH007
C-----------------------------------------------------------------------INSH008
C                    Version 3.0 as submitted to CPC                    INSH009
C          Uses the XLIB library (PhysiSoft Corp., Austria, DE)         INSH010
C-----------------------------------------------------------------------INSH011
                                                                        INSH012
      parameter (iat=20,iidx=3200)                                      INSH013
                                                                        INSH014
      character answ,bra,seq*4,elem*2,infile*25,icomp*4                 INSH015
      character*8 xyz(3),dbname,nlbl,revdat                             INSH016
      character spcgrp*10,title*60, ans2 ,dbfile*25, idfile*25          INSH017
      character ili*60,junk*60                                          INSH018
      integer idx(iidx), icalc(iat)                                     INSH019
      real u(iat,3),uu(3),vv(3)                                         INSH020
      logical exists,convrt,open                                        INSH021
      dimension seq(iat),elem(iat),ili(5+iat)                           INSH022
                                                                        INSH023
c --- last revision date and computer version --                        INSH024
      revdat='02/07/94'                                                 INSH025
                                                                        INSH026
c --- look for configuration file --                                    INSH027
      inquire (file='SEXIE.CFG',exist=exists)                           INSH028
      if (exists) then                                                  INSH029
         open (4,file='SEXIE.CFG',status='old')                         INSH030
         read(4,'(8x,a)') dbfile                                        INSH031
         read(4,'(8x,a)') idfile                                        INSH032
         read(4,'(8x,f8.4)') ddmax                                      INSH033
         read(4,'(8x,f8.4)') cconv                                      INSH034
         read(4,'(8x,f8.4)') ccona                                      INSH035
         read(4,'(8x,i8)')   iisear                                     INSH036
         read(4,'(8x,i8)')   ipr                                        INSH037
         read(4,'(8x,a4)')   icomp                                      INSH038
         call upstrg (icomp,4)                                          INSH039
         close(4,status='keep')                                         INSH040
      else                                                              INSH041
         print*,' Cannot find configuration file SEXIE.CFG'             INSH042
         print*,' Hit enter to resume with internal default set'        INSH043
         call inkey (answ)                                              INSH044
         dbfile = 'SEXIE.DBF'                                           INSH045
         idfile = 'SEXIE.IDX'                                           INSH046
         ddmax  = 10.0                                                  INSH047
         cconv  = 0.01                                                  INSH048
         ccona  = 0.5                                                   INSH049
         iisear = 1                                                     INSH050
         ipr    = 6                                                     INSH051
         icomp  = '7BIT'                                                INSH052
      end if                                                            INSH053
                                                                        INSH054
 8001 call clrscr (icomp)                                               INSH055
c --- call routine for header insert ---                                INSH056
      call inhead (revdat,icomp)                                        INSH057
      call nulify (spcgrp,seq,elem,dbname,title,ili,u)                  INSH058
      do 6999 i=1,iat                                                   INSH059
         icalc(i)=0                                                     INSH060
 6999 continue                                                          INSH061
c --- data base or interactive --                                       INSH062
 7000 write(ipr,'(/a)')'  Search (D)ata base      (D)'                  INSH063
      write(ipr,'( a)')'  Create a new (I)nput    (I)'                  INSH064
      write(ipr,'( a)')'  E(x)it to System        (X)'                  INSH065
      write(ipr,'(/a$)')'  Your choice > '                              INSH066
      call inkey (answ)                                                 INSH067
      ierr=0                                                            INSH068
      ilabel=0                                                          INSH069
      index=0                                                           INSH070
      idata=0                                                           INSH071
      ifirst=0                                                          INSH072
      if (answ.eq.'D') then                                             INSH073
         call dbase (ili,ierr,index,iol,dbfile,idfile,idx,ndx,icomp)    INSH074
         if(ierr.eq.1) goto 7000                                        INSH075
         if(ierr.eq.9) goto 8001                                        INSH076
         ilabel=1                                                       INSH077
         idata=1                                                        INSH078
         ifirst=1                                                       INSH079
         goto 2000                                                      INSH080
      elseif (answ.eq.'I') then                                         INSH081
         goto 1111                                                      INSH082
      elseif (answ.eq.'X') then                                         INSH083
         write (ipr,'(/a/)')'  Have a nice day. See you again. '        INSH084
         goto 9999                                                      INSH085
      else                                                              INSH086
         write(ipr,'(2x,a1,a)') answ,' ??'                              INSH087
         goto 7000                                                      INSH088
      end if                                                            INSH089
                                                                        INSH090
c --- get title - ENTRY point after satisfied with input --             INSH091
1111  if (ilabel.eq.1) then                                             INSH092
         read(ili(2),'(a60)') title                                     INSH093
      else                                                              INSH094
         call clrscr (icomp)                                            INSH095
         call intert (ipr,icomp)                                        INSH096
         write (ipr,'(/a)')'  Please enter a title for this input (eg., INSH097
     &Nickel Metal fcc) :'                                              INSH098
         write(ipr,'(a$)') '  > '                                       INSH099
         read(*,'(a60)') title                                          INSH100
      end if                                                            INSH101
                                                                        INSH102
c --- control parameters - default -                                    INSH103
      if (1.eq.1) then                                                  INSH104
         call clrscr (icomp)                                            INSH105
         call ctrtit (ipr,icomp)                                        INSH106
 1112   write(ipr,'(/a,i2,a,f6.4,a)')                                   INSH107
     &  '  (Y) Use default values : shells to ',                        INSH108
     &  int(ddmax),' A, shell width ', cconv,' A'                       INSH109
      write(ipr,'(a)')'  (I) Enter individual control parameters'       INSH110
      write(ipr,'(a)')'  (S) Space group decoding only (no shells calc)'INSH111
      write(ipr,'(/a$)')'  Your choice > '                              INSH112
         call inkey (ans2)                                              INSH113
c ---    valid answer --                                                INSH114
         if (ans2.ne.'Y'.and.ans2.ne.'I'.and.ans2.ne.'S') then          INSH115
            write(ipr,*)' Ehh ??'                                       INSH116
            goto 1112                                                   INSH117
         end if                                                         INSH118
         if (ans2.eq.'Y') then                                          INSH119
            dmax=ddmax                                                  INSH120
            cona=ccona                                                  INSH121
            conv=cconv                                                  INSH122
            isearc=iisear                                               INSH123
         elseif (ans2.eq.'S') then                                      INSH124
            dmax=0.0                                                    INSH125
            cona=0.0                                                    INSH126
            conv=0.0                                                    INSH127
            isearc=0                                                    INSH128
         else                                                           INSH129
            call clrscr (icomp)                                         INSH130
            call getctr (dmax,cona,conv,isearc)                         INSH131
         end if                                                         INSH132
      end if                                                            INSH133
      write (ili(3),'(f6.2,f8.3,i4,f8.3)') dmax,conv,isearc,cona        INSH134
                                                                        INSH135
c --- read spacegroup symbol --                                         INSH136
      if (ilabel.eq.1) then                                             INSH137
         read (ili(5),'(a10,1x,i3)') spcgrp,ispa                        INSH138
      else                                                              INSH139
         call clrscr (icomp)                                            INSH140
         call spctit (ipr,icomp)                                        INSH141
         call space (bra,nsy,spcgrp,ispa,icomp)                         INSH142
c ---    if a rhombohedral spacegroup were detected, we ask if convert -INSH143
         if (bra.eq.'R') then                                           INSH144
            call clrscr (icomp)                                         INSH145
            call rhotit (ipr,spcgrp,icomp)                              INSH146
            write(ipr,'(/a$)')'  Do you intend to use the rhombohedral sINSH147
     &etting of this space group (Y/N) : '                              INSH148
            call inkey (answ)                                           INSH149
            convrt=.false.                                              INSH150
            if (answ.eq.'Y') convrt=.true.                              INSH151
         end if                                                         INSH152
      end if                                                            INSH153
                                                                        INSH154
c --- now the crystal data are sufficient to inquire cell constants -   INSH155
      if (ilabel.eq.1) then                                             INSH156
         read(ili(4),'(6(f9.4))') alatta,alattb,alattc,alpha,beta,gamma INSH157
      else                                                              INSH158
         call clrscr (icomp)                                            INSH159
         call celinp (nsy,alatta,alattb,alattc,alpha,beta,gamma,convrt, INSH160
     &   ispa)                                                          INSH161
      end if                                                            INSH162
                                                                        INSH163
c --- assemble first part of input data if not from database --         INSH164
      if (ilabel.lt.1) then                                             INSH165
         write (ili(2),'(a60)') title                                   INSH166
         write (ili(3),'(f6.2,f8.3,i4,f8.3)') dmax,conv,isearc,cona     INSH167
         write(ili(4),'(6(f9.4))') alatta,alattb,alattc,alpha,beta,gammaINSH168
         write (ili(5),'(a10,1x,i3)') spcgrp,ispa                       INSH169
      end if                                                            INSH170
                                                                        INSH171
c --- read atom lines from database or start to inquire atom lines --   INSH172
      if (ilabel.eq.1) then                                             INSH173
         do 0003 ic=1,iol-5                                             INSH174
            read (ili(5+ic),'(a2,2x,a4,3f8.4)')                         INSH175
     &      elem(ic),seq(ic),(u(ic,i),i=1,3)                            INSH176
 0003    continue                                                       INSH177
         ic=ic-1                                                        INSH178
      else                                                              INSH179
         call clrscr (icomp)                                            INSH180
         call atotit (ipr,icomp)                                        INSH181
         write(*,'(/a$)')'  Ready (Y/N) ? '                             INSH182
         call inkey(answ)                                               INSH183
         if (answ.eq.'N') then                                          INSH184
            print*,' '                                                  INSH185
            print*,' Maybe a cup of tea ??'                             INSH186
            call inkey (answ)                                           INSH187
         end if                                                         INSH188
                                                                        INSH189
c ---    here we loop over ic ATOM cards --                             INSH190
         ic=0                                                           INSH191
 0001    ic=ic+1                                                        INSH192
         call clrscr (icomp)                                            INSH193
         write(*,'(/a,i2,a)')' Atom number ',ic,':'                     INSH194
                                                                        INSH195
c ---    get the element symbol --                                      INSH196
 7006    write(*,'(/a$)')' Element symbol : '                           INSH197
         read (*,'(a2)') elem(ic)                                       INSH198
         call upstrg (elem(ic),2)                                       INSH199
c --     check, if symbol is ok --                                      INSH200
         iatom=ielect(elem(ic))                                         INSH201
         if (iatom.eq.0) then                                           INSH202
            write (ipr,'(a,a)')' Unable to interpret element symbol ',  INSH203
     &                           elem(ic)                               INSH204
            goto 7006                                                   INSH205
         end if                                                         INSH206
                                                                        INSH207
c ---    get mandatory label -                                          INSH208
 2812    write(*,'(/a$)')' Enter a unique atom label (up to four charactINSH209
     &ers, site from Tables) : '                                        INSH210
         read (*,'(a4)') seq(ic)                                        INSH211
         if ((seq(ic).eq.char(13)).or.(seq(ic).eq.' ')) goto 2812       INSH212
c ---    get atom coordinates ---                                       INSH213
         do 0721, i=1,3                                                 INSH214
 0721       call xyzko (i,xyz(i))                                       INSH215
                                                                        INSH216
c ---    check coordinate string & transform fractionals to rationals  -INSH217
         do 722 i=1,3                                                   INSH218
            call dslash (xyz(i),u(ic,i),ierr)                           INSH219
            if (ierr.eq.1) then                                         INSH220
               print*,' To repeat input of this card hit <cr>'          INSH221
               call inkey (answ)                                        INSH222
               ic=ic-1                                                  INSH223
               goto 0001                                                INSH224
            end if                                                      INSH225
 0722    continue                                                       INSH226
         write(ipr,'(/a,3(1x,f8.5))')'  Atom parameters are ok :'       INSH227
     &   ,(u(ic,i),i=1,3)                                               INSH228
                                                                        INSH229
c ---    transform, if rhombohedral --                                  INSH230
         if (bra.eq.'R'.and.convrt) then                                INSH231
            do 4001 j=1,3                                               INSH232
 4001          uu(j)=u(ic,j)                                            INSH233
            call potran (uu,vv,ierr)                                    INSH234
            if (ierr.eq.1) then                                         INSH235
               write(*,'(/a,a,3(1x,f8.5))')'  Error transforming atomic'INSH236
     &         , ' positions - ',(vv(i), i=1,3)                         INSH237
               print*,' To repeat input of this card hit <cr>'          INSH238
               call inkey (answ)                                        INSH239
               ic=ic-1                                                  INSH240
               goto 0001                                                INSH241
            else                                                        INSH242
               write(*,'(/a,3(1x,f8.5))')'  Transformed parameters :',  INSH243
     &         (vv(i),i=1,3)                                            INSH244
               do 0744 i=1,3                                            INSH245
                  call mslash (vv(i),xyz(i),ierr)                       INSH246
                  u(ic,i)=vv(i)                                         INSH247
 0744          continue                                                 INSH248
               write (*,'(a,3(1x,a8))') '  Fractional coordinates : ',  INSH249
     &         (xyz(i),i=1,3)                                           INSH250
            end if                                                      INSH251
         end if                                                         INSH252
c ---    ask if atom should be used as a central atom for shell calc    INSH253
         write (*,'(a,a,a2,a4,a,a$)')'  Calculate coordination',        INSH254
     &   ' shell around atom ',elem(ic),' ',seq(ic),' (Y/N) : '         INSH255
         call inkey (answ)                                              INSH256
         if (answ.eq.'Y') icalc(ic)=1                                   INSH257
                                                                        INSH258
c ---    we write each atom card now - with exception of icalc(ic)      INSH259
         write(ili(5+ic),'(a2,2x,a4,3f8.4)')                            INSH260
     &   elem(ic),seq(ic),(u(ic,i),i=1,3)                               INSH261
                                                                        INSH262
c ---    another atom card ? --                                         INSH263
         write(*,'(/a$)')'  Does the unit cell contain another non equivINSH264
     1alent atom (Y/N) ? '                                              INSH265
         call inkey (answ)                                              INSH266
         if (answ.eq.'Y') goto 0001                                     INSH267
      end if                                                            INSH268
                                                                        INSH269
c --- if not new input, ask for icalc only --                           INSH270
      if (ilabel.eq.1) then                                             INSH271
         call clrscr (icomp)                                            INSH272
         write(*,*)' '                                                  INSH273
         do 1003 ic=1,iol-5                                             INSH274
            write (*,'(a,a,a2,a,a4,a$)')'  Calculate coordination',     INSH275
     &      ' shell around atom ',elem(ic),' ',seq(ic),' (Y/N) : '      INSH276
            call inkey (answ)                                           INSH277
            if (answ.eq.'Y') icalc(ic)=1                                INSH278
 1003    continue                                                       INSH279
         ic=ic-1                                                        INSH280
         ilabel=0                                                       INSH281
      end if                                                            INSH282
                                                                        INSH283
c --- entry point for input listing --                                  INSH284
      iol=ic+5                                                          INSH285
 2000 call clrscr (icomp)                                               INSH286
      write(ipr,'(a/)')'  Your input data : '                           INSH287
      if (ifirst.eq.0) then                                             INSH288
         do 0002 i=2,iol                                                INSH289
            if (i.lt.6) then                                            INSH290
               write (*,'(1x,a)') ili(i)                                INSH291
            else                                                        INSH292
               write (*,'(1x,a32,i3)') ili(i),icalc(i-5)                INSH293
            end if                                                      INSH294
            if (mod(i,20).eq.0) then                                    INSH295
               print*,' Hit <cr> to continue'                           INSH296
               call inkey (answ)                                        INSH297
            end if                                                      INSH298
 0002    continue                                                       INSH299
         write (*,'(/a$)')'  Satisfied with input data (Y/N) : '        INSH300
      else                                                              INSH301
c --- omit control parameters upon first listing from data base ----    INSH302
         do 0202 i=2,iol                                                INSH303
            if (i.eq.3) then                                            INSH304
               write (*,'(a)') ' Control parameters not yet defined'    INSH305
            elseif (i.lt.6) then                                        INSH306
               write (*,'(1x,a)') ili(i)                                INSH307
            else                                                        INSH308
               write (*,'(1x,a32)') ili(i)                              INSH309
            end if                                                      INSH310
            if (mod(i,20).eq.0) then                                    INSH311
               print*,' Hit <cr> to continue'                           INSH312
               call inkey (answ)                                        INSH313
            end if                                                      INSH314
 0202    continue                                                       INSH315
         write (*,'(/a$)')'  Satisfied with structure data (Y/N) : '    INSH316
      end if                                                            INSH317
      ifirst=0                                                          INSH318
      call inkey (answ)                                                 INSH319
c --- not ok block --                                                   INSH320
      if (answ.ne.'Y') then                                             INSH321
c ---    entry point for parser --                                      INSH322
 7700    write(ipr,'(/a)') '  Scrap this data and restart   (S)'        INSH323
         write(ipr,'( a)') '  or edit this input data       (E)'        INSH324
         write(ipr,'(a$)') '  Your choice > '                           INSH325
                                                                        INSH326
         call inkey (ans2)                                              INSH327
c ---    valid answer --                                                INSH328
         if (ans2.ne.'S'.and.ans2.ne.'E')   then                        INSH329
            write(ipr,*)' Huh ??'                                       INSH330
            goto 7700                                                   INSH331
         elseif (ans2.eq.'S') then                                      INSH332
            write(ipr,'(a$)') '  Are you sure (Y/N) : '                 INSH333
            call inkey (ans2)                                           INSH334
            if (ans2.ne.'Y') then                                       INSH335
               goto 2000                                                INSH336
            else                                                        INSH337
              inquire(file=dbfile,exist=exists,opened=open)             INSH338
              if (open) close (1,status='keep')                         INSH339
              inquire(file=idfile,exist=exists,opened=open)             INSH340
              if (open) close (2,status='keep')                         INSH341
              goto 8001                                                 INSH342
            end if                                                      INSH343
         else                                                           INSH344
            ichang=0                                                    INSH345
            iolold=iol                                                  INSH346
            call edit (ili,iol)                                         INSH347
            if(iolold.ne.iol) ichang=1                                  INSH348
            goto 2000                                                   INSH349
         end if                                                         INSH350
c --- input ok block ---                                                INSH351
      else                                                              INSH352
c ---    get the data from database if first run --                     INSH353
         if (ilabel.eq.1) goto 1111                                     INSH354
 7770    write(ipr,'(/a)')'  Save input into individual input file (I)' INSH355
         write(ipr,'( a)')'  Append input to current data base     (A)' INSH356
         write(ipr,'( a)')'  Start calculation             <cr> or (Y)' INSH357
         write(ipr,'(a$)')'  Your choice > '                            INSH358
         call inkey (ans2)                                              INSH359
c ---    write external sequential file ---                             INSH360
         if (ans2.eq.'I') then                                          INSH361
 9003       write(ipr,'(a)')'  Name for the output file (do not enter thINSH362
     &e default extension .INP)'                                        INSH363
            call filnam (infile,'.INP',1)                               INSH364
            open (unit=4,file=infile,err=9901,status='unknown')         INSH365
            goto 9902                                                   INSH366
 9901       print*,' Cannot open file ',infile                          INSH367
            goto 9003                                                   INSH368
 9902       continue                                                    INSH369
            write(ipr,*)' Writing input file ',infile                   INSH370
            do 5009 i=2,iol                                             INSH371
               if (i.lt.6) then                                         INSH372
                  write (4,'(a)') ili(i)                                INSH373
               else                                                     INSH374
                  write (4,'(a32,i3)') ili(i),icalc(i-5)                INSH375
               end if                                                   INSH376
 5009       continue                                                    INSH377
            close (unit=4, status='keep')                               INSH378
                                                                        INSH379
c ---    append to data base ---                                        INSH380
         elseif (ans2.eq.'A') then                                      INSH381
c ---       check whether databases open and ok --                      INSH382
            inquire(file=dbfile,exist=exists,opened=open)               INSH383
            if (.not.exists) then                                       INSH384
               print*,' Can''t find the data base file ',dbfile,'in thisINSH385
     & directory'                                                       INSH386
               print*,' Please select another option'                   INSH387
               goto 7700                                                INSH388
            end if                                                      INSH389
            if (.not.open) then                                         INSH390
               open(unit=1,file=dbfile, form='formatted', recl=60,      INSH391
     &         access='direct', status='old')                           INSH392
            end if                                                      INSH393
 22         format (a60)                                                INSH394
 23         format (i6)                                                 INSH395
            inquire(file=idfile,exist=exists,opened=open)               INSH396
            if (.not.exists) then                                       INSH397
               print*,' Can''t find the index file ',idfile,    'in thisINSH398
     & directory'                                                       INSH399
               print*,' Please select another option'                   INSH400
               goto 7700                                                INSH401
            end if                                                      INSH402
c ---       read the index file, if not yet opened ---                  INSH403
            if (.not.open) then                                         INSH404
               open(unit=2,file=idfile, form='formatted', recl=6,       INSH405
     &         access='direct', status='old')                           INSH406
               do 2200 i=1,iidx                                         INSH407
                  read(2,23,rec=i,err=2209) idx(i)                      INSH408
 2200          continue                                                 INSH409
 2209          ndx=i-1                                                  INSH410
            end if                                                      INSH411
                                                                        INSH412
c ---       if not read from data base, inquire the a label             INSH413
            if (idata.ne.1) then                                        INSH414
               write(ipr,'(/a)') '  We need a label for this entry. The INSH415
     &compound name or any descriptive name '                           INSH416
               write(ipr,'(a)') '  up to 8 characters is acceptable (e.gINSH417
     &. LAF3, NIFCC, TI)'                                               INSH418
 7771          write(ipr,'(a$)')'  Enter the label for this entry : '   INSH419
               read(*,'(a)') dbname                                     INSH420
               call upstrg (dbname,8)                                   INSH421
c ---          need a label --                                          INSH422
               if (dbname.eq.' ') then                                  INSH423
                  goto 7771                                             INSH424
               endif                                                    INSH425
c ---          check, if exists ---                                     INSH426
               print*,' Checking for duplicate entry label.......'      INSH427
               ierr=0                                                   INSH428
               do 2600 i=1,ndx                                          INSH429
                  irec=abs(idx(i))                                      INSH430
                  read(1,'(2x,a8)',rec=irec,err=2600) nlbl              INSH431
                  if ((nlbl.eq.dbname).and.(idx(i).gt.0)) ierr=1        INSH432
 2600          continue                                                 INSH433
               if (ierr.gt.0) then                                      INSH434
                  print*, ' This label exists already - select another nINSH435
     &ame'                                                              INSH436
                  goto 7771                                             INSH437
               else                                                     INSH438
                  print*,' Label ok - appending new entry ',dbname      INSH439
                  write(ili(1),'(a2,a8,a2,67x)')'**',dbname,'**'        INSH440
               end if                                                   INSH441
c ---          find the end of the data base --                         INSH442
               do 2400 i=abs(idx(ndx)),abs(idx(ndx))+10+iat             INSH443
 2400              read(1,22,rec=i,err=2409) junk                       INSH444
 2409          continue                                                 INSH445
               nrec=i                                                   INSH446
c ---          write a new last index entry and append                  INSH447
               ndx=ndx+1                                                INSH448
               idx(ndx)=nrec                                            INSH449
               write(2,23,rec=ndx) idx(ndx)                             INSH450
               ibuf=0                                                   INSH451
               do 2410 i=nrec,nrec+iol-1                                INSH452
                  ibuf=ibuf+1                                           INSH453
 2410             write(1,22,rec=i) ili(ibuf)                           INSH454
c ---          done with that task --                                   INSH455
               goto 9990                                                INSH456
            end if                                                      INSH457
c ---       simple replace ---                                          INSH458
            if (ichang.eq.0) then                                       INSH459
               write(ipr,'(a)')'  Updating entry ......'                INSH460
               ibuf=0                                                   INSH461
               do 2300 i=idx(index),idx(index)+iol-1                    INSH462
                  ibuf=ibuf+1                                           INSH463
                  write(1,22,rec=i) ili(ibuf)                           INSH464
 2300          continue                                                 INSH465
            else                                                        INSH466
c ---       delete index, make new index, write records --              INSH467
c              find end of database                                     INSH468
c              print*,'index,ndx,idx(ndx)',index,ndx,idx(ndx)           INSH469
               do 2701 i=idx(ndx),idx(ndx)+5+iat                        INSH470
                  read(1,22,rec=i,err=2791) junk                        INSH471
 2701          continue                                                 INSH472
 2791          nrec=i                                                   INSH473
               write(ipr,'(a)')'  Appending entry ......'               INSH474
               idx(index)=-idx(index)                                   INSH475
               ndx=ndx+1                                                INSH476
               idx(ndx)=nrec                                            INSH477
               ibuf=0                                                   INSH478
               write(2,23,rec=ndx) idx(ndx)                             INSH479
               write(2,23,rec=index) idx(index)                         INSH480
               do 2330 i=idx(ndx),idx(ndx)+iol-1                        INSH481
                  ibuf=ibuf+1                                           INSH482
                  write(1,22,rec=i) ili(ibuf)                           INSH483
 2330          continue                                                 INSH484
            end if                                                      INSH485
         elseif (ans2.eq.'Y') then                                      INSH486
            answ=ans2                                                   INSH487
            goto 9912                                                   INSH488
         else                                                           INSH489
c ---       invalid answer --                                           INSH490
            write(ipr,*)' Say again, please ??'                         INSH491
            goto 7770                                                   INSH492
         end if                                                         INSH493
c ---    end of append block --                                         INSH494
      end if                                                            INSH495
c --- end of input ok block --                                          INSH496
                                                                        INSH497
c --- start calculation with current dataset ---                        INSH498
 9990 continue                                                          INSH499
 7009 write(ipr,'(/a )') '  Create another input                   (I)' INSH500
      write(ipr,'( a )') '  or start calculation with current data (Y)' INSH501
      write(ipr,'( a$)') '  Your choice > '                             INSH502
      call inkey (answ)                                                 INSH503
 9912 if (answ.eq.'I') then                                             INSH504
         inquire(file=dbfile,exist=exists,opened=open)                  INSH505
         if (open) close (1,status='keep')                              INSH506
         inquire(file=idfile,exist=exists,opened=open)                  INSH507
         if (open) close (2,status='keep')                              INSH508
         goto 8001                                                      INSH509
      elseif (answ.eq.'Y') then                                         INSH510
         open(4,file='sexie.inp',status='unknown')                      INSH511
         do 9911 i=2,iol                                                INSH512
            if (i.lt.6) then                                            INSH513
               write (4,'(a)') ili(i)                                   INSH514
            else                                                        INSH515
               write (4,'(a32,i3)') ili(i),icalc(i-5)                   INSH516
            end if                                                      INSH517
 9911    continue                                                       INSH518
         close(4,status='keep')                                         INSH519
      else                                                              INSH520
         write(ipr,'(a)')'  Sorry ??'                                   INSH521
         goto 9990                                                      INSH522
      end if                                                            INSH523
c --- say good bye ---                                                  INSH524
      write(*,*) ' '                                                    INSH525
      write (*,'(/a/)')'  So long and good luck for your calculation'   INSH526
      if (icomp.eq.'IBM ') then                                         INSH527
         stop 9                                                         INSH528
c --- uncomment if using a VAX under VMS                                INSH529
c      elseif (icomp.eq.'VAX ') then                                    INSH530
c         call exit (3)                                                 INSH531
      else                                                              INSH532
         stop 9                                                         INSH533
      end if                                                            INSH534
                                                                        INSH535
 9999 end                                                               INSH536
