* A program to generate datafiles for zeolite beta
* The user is prompted for a stacking fault probability.
* betafiles opens 'beta.dat' and generates the relevant data,
* and saves as 'betaxxx.dat'
      program generate
      implicit none
*
      character*32 fname, newfname, rootname
      character*80 line
      integer i, alfa, rootlen
      real prob, prob1, prob2, prob_inc, alpha , eps
      parameter (eps = 1.0E-5)
*
      call HEADER()
*
      write(6,*) 'Enter name of basis file'
      read(5,'(a)') fname
      rootlen = index(fname,'.')
      if(rootlen.eq.0) rootlen = index(fname,' ')
      if(rootlen.le.0) rootlen = 25
      rootname = fname(1:rootlen)
*
   10 write(6,*) 'Enter starting probability'
      read(5,*) prob1
      if(prob1 .lt. 0.0 .or. prob1 .gt. 1.0) then
        write(6,*)'Illegal value'
        goto 10
      endif
*
   20 write(6,*) 'Enter ending probability'
      read(5,*) prob2
      if(prob2 .lt. 0.0 .or. prob2 .gt. 1.0) then
        write(6,*)'Illegal value'
        goto 20
      endif
*
   30 write(6,*) 'Enter probability increment'
      read(5,*) prob_inc
      if(prob_inc .lt. 0.0 .or. prob_inc .gt. 1.0) then
        write(6,*)'Illegal value for increment'
        goto 30
      endif
*
      open (unit = 12, file = fname, status = 'old')
*
      do 200 prob = prob1, prob2 + eps, prob_inc
*
      newfname = rootname
      alfa = nint(prob*1000.0)
      alpha = prob
      if(alfa .eq. 0) then
        alfa = 1
        alpha = 0.001
      endif
      if(alfa .eq. 1000) then
        alfa = 999
        alpha = 0.999
      endif
      if(alfa .lt. 10) then
        write(newfname(rootlen:rootlen+1),'(2a)') '00'
        write(newfname(rootlen+2:rootlen+2),'(i1)') alfa
      endif
      if(alfa .ge. 10 .and. alfa .lt. 100) then
        write(newfname(rootlen:rootlen),'(a)') '0'
        write(newfname(rootlen+1:rootlen+2),'(i2)') alfa
      endif
      if(alfa .ge. 100 .and. alfa .lt. 1000) then
        write(newfname(rootlen:rootlen+2),'(i3)') alfa
      endif
      write(newfname(rootlen+3:rootlen+6),'(4a)') '.dat'
      write(6,*) 'Creating ',newfname
*
      open (unit = 13, file = newfname, status = 'new')
*
   40 read(12, '(a)', end = 100) line
      i = index(line,'xxxxx')
      if(i .ne. 0) then
        write(line(i:i+4),'(f5.3)') alpha
        write(line(i:i),'(a)') '0'
      endif
      i = index(line,'yyyyy')
      if(i .ne. 0) then
        write(line(i:i+4),'(f5.3)') 1.0 - alpha
        write(line(i:i),'(a)') '0'
      endif
*
      i = 80
   50 if(line(i:i) .eq. ' ' .and. i.gt.1) then
        i = i - 1
        goto 50
      endif
*
      write(13,'(a)') line(1:i)
      goto 40
  100 continue
      rewind(unit = 12)
      close(unit = 13)
  200 continue
*
      close(unit = 12)
*
      end
*
      subroutine HEADER()
      implicit none
*
      write(6,*)'fmaker is a utility program used to generate a'
      write(6,*)'series of versions of a DIFFaX structure file'
      write(6,*)'whose stacking probabilities you wish to vary.'
      write(6,*)'The probabilities that you wish to be treated'
      write(6,*)'as variable must appear in the TRANSITIONS section'
      write(6,*)'of the data file in a mnemonic form, i.e.'
      write(6,*)' '
      write(6,*)'TRANSITIONS        {a hypothetical data set}'
      write(6,*)'{Transitions from layer 1}'
      write(6,*)'xxxxx   0.666666   0.333333  1.0    {1 to 1}'
      write(6,*)'0.000   0.0        0.0       1.0    {1 to 2}'
      write(6,*)'yyyyy   0.0        0.0       1.0    {1 to 3}'
      write(6,*)' '
      write(6,*)'{Transitions from layer 2}'
      write(6,*)'yyyyy   0.0        0.0       1.0    {2 to 1}'
      write(6,*)'xxxxx  -0.666666  -0.333333  1.0    {2 to 2}'
      write(6,*)'0.000   0.0        0.0       1.0    {2 to 3}'
      write(6,*)' '
      write(6,*)'{Transitions from layer 3}'
      write(6,*)'0.000   0.0        0.0       1.0    {3 to 1}'
      write(6,*)'yyyyy  -0.666666  -0.333333  1.0    {3 to 2}'
      write(6,*)'xxxxx   0.0        0.0       1.0    {3 to 3}'
      write(6,*)' '
      write(6,*)
     |'You will be prompted for a range of xxxxx values to use,'
      write(6,*)
     |'between 0 and 1, and an increment. yyyyy equals 1 - xxxxx.'
      write(6,*)
     |'fmaker will replace all occurrences of the strings xxxxxx'
	write(6,*)
     |'and yyyyy with probability values within the range'
      write(6,*)'specified. Files will be saved as ''namezzz.dat'''
      write(6,*)'where zzz = 1000*xxxxx'
      write(6,*)' '
      write(6,*)' '
*
      return
      end