C PROGRAM TO SET UP AN COMMAND FILE FOR RIETVELD XRAY PATTERN
C REFINEMENT USING S. HOWARD'S 3/90 VERSION RIETVELD
C
C  PROGRAMMED BY R. L. SNYDER
C  		 ALFRED UNIVERSITY
C      		 ALFRED, N.Y. 14802
*  MODIFIED   BY DAVID MATHEIS  5/90
C
      CHARACTER*80 Q
      CHARACTER KFILE*32
      IREAD = 5
      ITP1 = 20
      ITYP = 6
      WRITE(ITYP,1)
 1	FORMAT(//' Program RTD to set up a command file for rietveld'/
     1' xray refinement using S. Howards 3/90 version rietveld'/
     2' All filenames should have same rootname')
40	WRITE(ITYP,2)
 2	FORMAT(/,' ENTER the root name of the output batch file to be ',
     1' created'/'$(Default file name = RIET.COM): ')
	READ(IREAD,3) KFILE(7:32)
 3	FORMAT(A32)
	IF(KFILE(7:8) .EQ. '  ') KFILE(7:14) = 'riet'
      OPEN(UNIT=20, NAME=KFILE(7:32), STATUS='new', FORM='FORMATTED', 
     1 defaultfile='.com', carriagecontrol='list', err=998)
c
c  add the default directory to the .com file
c
	INQUIRE(UNIT=20,NAME=Q)
	J=INDEX(Q,']')
	WRITE(20,4) Q(:J)
 4	FORMAT('$ SET DEF ',A<J>)
C
C  ADD THE DEFAULT ASSIGNMENT TO THE KFILE ARRAY TO GET PRINT FILE NAME
C
	DO I=1,32
	  IF(KFILE(I:I) .EQ. ' ')GO TO 72
        enddo
72	NEXT = I
	KFILE(NEXT:NEXT+4) = '.tmp'
        write(20,7,err=997)kfile(7:next+4)
 7       format('$ assign ',a,' for099'/'$ run powder:rietveld')
	KFILE(NEXT:NEXT+4) = '.new'
        write(20,5,err=997)kfile(7:next+4)
 5       format(a/)
        kfile(next:next+4) = '.xda'
        write(20,6,err=997)kfile(7:next+4)
        kfile(next:next+4) = '.bkg'
        write(20,6,err=997)kfile(7:next+4)
        kfile(next:next+4) = '.plt'
        write(20,6,err=997)kfile(7:next+4)
        kfile(next:next+4) = '.lis'
        write(20,6,err=997)kfile(7:next+4)
        kfile(next:next+4) = '.new'
        write(20,6,err=997)kfile(7:next+4)
        kfile(next:next+4) = '.sta'
        write(20,6,err=997)kfile(7:next+4)
 6       format(a)
      close(unit=20)
      go to 999
 997  print*,'Error writing to command file'
      go to 999
 998  print*,'Error opening command file'
 999  stop
      end

