C PROGRAM TO SET UP AN INPUT FILE FOR COMPUTER CALCULATION AND
C PLOT SIMULATION OF A POWDER PATTERN USING DEAN SMITHS POWD10
C
C  PROGRAMMED BY R. L. SNYDER
C  		 ALFRED UNIVERSITY
C      		 ALFRED, N.Y. 14802
C
	CHARACTER*80 Q

      CHARACTER KFILE*32
C       CHARACTER*4 XSCAT1(449), XSCAT2(397), ESCAT(204), ASCAT(97)
       CHARACTER*4 XSCAT1(352), XSCAT2(352), ESCAT(204), ASCAT(97),
     &             XSCAT1A(97),XSCAT2A(45)
	CHARACTER*2 ARAD(9), ISENT, WL, JSENT, JBL
	CHARACTER*4 TYPE(100), BL, T
	CHARACTER*1 NEG,YES,YE, CFORM(40), MINAM(40), SYS(12), SYM(9),
     1 REF(80), TITLE(80), MINLOC(50), IBL, ICOM
      DIMENSION CON(6), BETA(6), REST(5), NK(100), LOG(3)
      DATA YES/'Y'/,BL/'    '/,IBL/' '/,ICOM/','/,ISENT/'%*'/,JBL/'  '/
       DATA NEG/'N'/
C
C  X-RAY ORFLS FORMAT ATOMIC SCATTERING FACTORS
C
       Data XSCAT1
     */'H   ','H -1','HE  ','HE-1','LI  ','LI+1','LI-1','BE  ','BE+1',
     * 'BE+2','B   ','B +1','B +2','B +3','C   ','C +3','C +4','N   ',
     * 'N +3','N +4','O   ','OX-2','OH-1','H20 ','F -1','NE  ','NA  ',
     * 'NA-1','MG  ','MG+2','AL  ','AL+2','AL+3','SI  ','SI+4','P   ',
     * 'S   ','S -1','S -2','CL  ','CL-1','AR  ','K   ','K +1','CA  ',
     * 'CA+1','CA+2','SC  ','SC+1',
     * 'SC+2','SC+3','TI  ','TI+1','TI+2','TI+3',
     * 'V   ','V +1','V +2','V +3','CR  ','CR+1','CR+2','CR+3','MN  ',
     * 'MN+1','MN+2','MN+3','MN+4','FE  ','FE+1','FE+2','FE+3','FE+4',
     * 'CO  ','CO+1','CO+2','CO+3','NI  ','NI+1','NI+2','NI+3','CU  ',
     * 'CU+1','CU+2','CU+3','ZN  ','ZN+2','GA  ','GA+1','GA+3','GE  ',
     * 'GE+2','GE+4','CA  ','CA+1','CA+2','SC  ','SC+1','SC+2','SC+3',
     * 'TI  ','TI+1','TI+2','TI+3','V   ','V +1','V +2','V +3','CR  ',
     * 'CR+1','CR+2','CR+3','MN  ','MN+1','MN+2','MN+3','MN+4','FE  ',
     * 'FE+1','FE+2','FE+3','FE+4','CO  ','CO+1','CO+2','CO+3','NI  ',
     * 'NI+1','NI+2','NI+3','CU  ','CU+1','CU+2','CU+3','ZN  ','ZN+2',
     * 'GA  ','GA+1','GA+3','GE  ','GE+2','GE+4','AS  ','AS+1','AS+2',
     * 'AS+3','SE  ','BR  ','KR  ','RB  ','RB+1','SR  ','Y   ','ZR  ',
     * 'ZR+4','NB  ','MO  ','MO+1','TC  ','RU  ','RH  ','PD  ','AG  ',
     * 'AG+1','CD  ','IN  ','SN  ','SB  ','TE  ','I   ','XE  ','CS  ',
     * 'BA  ','LA  ','CE  ','PR  ','ND  ','PM  ','SM  ','EU  ','GD  ',
     * 'TB  ','DY  ','HO  ','ER  ','TM  ','YB  ','LU  ','HF  ','TA  ',
     * 'W   ','RE  ','OS  ','IR  ','PT  ','AU  ','AU+1','HG  ','HG+2',
     * 'TL  ','TL+1','TL+3','PB  ','PB+3','BI  ','PO  ','AT  ','RN  ',
     * 'FR  ','RA  ','AC  ','TH  ','PA  ','U   ','NP  ','PU  ','AM  ',
     * 'CM  ','BK  ','CF  ','ES  ','H   ','H   ','H   ','H -1','HE  ',
     * 'LI  ','LI+1','BE+2','B   ','C   ','C V ','N   ','N -3','N -3',
     * 'N -3','N -3','N -3','N -3','N -3','O   ','O -1','O -2','O -2',
     * 'O -2','O -2','O -2','O -2','O -2','OH  ','H20 ','F   ','F -1',
     * 'NE  ','NA  ','NA+1','MG  ','MG+2','AL  ','AL+3','SI  ','SI V',
     * 'SI+4','P   ','S   ','CL  ','CL-1','AR  ','K   ','K +1','CA  ',
     * 'CA+2','SC  ','SC+3','TI  ','TI+2','TI+3','TI+4','V   ','V +2',
     * 'V +3','V +5','CR  ','CR+2','CR+3','MA  ','MN+2','MN+3','MN+4',
     * 'FE  ','FE+2','FE+3','CO  ','CO+2','CO+3','NI  ','NI+2','NI+3',
     * 'CU  ','CU+1','CU+2','ZN  ','ZN+2','GA  ','GA+3','GE  ','GE+4',
     * 'AS  ','SE  ','BR  ','BR-1','KR  ','RB  ','RB+1','SR  ','SR+2',
     * 'Y   ','Y +3','ZR  ','ZR+4','NB  ','NB+3','NB+5','MO  ','MO+3',
     * 'MO+5','MO+6','TC  ','RU  ','RU+3','RU+4','RH  ','RH+3','RH+4',
     * 'PD  ','PD+2','PD+4','AG  ','AG+1','AG+2','CD  ','CD+2','IN  ',
     * 'IN+3','SN  ','SN+2','SN+4','SB  ','SB+3','SB+5','TE  ','I   '/

       DATA XSCAT1A/
     * 'I -1','XE  ','CS  ','CS+1','BA  ','BA+2','LA  ','LA+3','CE  ',
     * 'CE+3','CE+4','PR  ','PR+3','PR+4','ND  ','ND+3','PM  ','PM+3',
     * 'SM  ','SM+3','EU  ','EU+2','EU+3','GD  ','GD+3','TB  ','TB+3',
     * 'DY  ','DY+3','HO  ','HO+3','ER  ','ER+3','TM  ','TM+3','YB  ',
     * 'YB+2','YB+3','LU  ','LU+3','HF  ','HF+4','TA  ','TA+5','W   ',
     * 'W +6','RE  ','OS  ','OS+4','IR  ','IR+3','IR+4','PT  ','PT+2',
     * 'PT+4','AU  ','AU+1','AU+3','HG  ','HG+1','HG+2','TL  ','TL+1',
     * 'TL+3','PB  ','PB+2','PB+4','BI  ','BI+3','BI+5','PO  ','AT  ',
     * 'RN  ','FR  ','RA  ','RA+2','AC  ','AC+3','TH  ','TH+4','PA  ',
     * 'U   ','U +3','U +4','U +6','NP  ','NP+3','NP+4','NP+6','PU  ',
     * 'PU+3','PU+4','PU+6','AM  ','CM  ','BK  ','CF  '/
C
C  X-RAY POLYNOMIAL FORMAT ATOMIC SCATTERING FACTORS
C
       DATA XSCAT2
     */'H   ','HE  ','LI  ','LI+1','BE  ','BE+2','B   ','C   ','N   ',
     * 'O   ','O -1','OH-1','H2O ','F   ','F -1','NE  ','NA  ','NA+1',
     * 'MG  ','MG+2','AL  ','AL+3','SI  ','SI+4','P   ','S   ','CL  ',
     * 'CL-1','AR  ','K   ','K +1','CA  ','CA+2','SC  ','SC+3','TI  ',
     * 'TI+3','TI+4','V   ','V +2','V +3','V +5','CR  ','CR+2','CR+3',
     * 'MN  ','MN+2','MN+3','MN+4','FE  ','FE+2','FE+3','CO  ','CO+2',
     * 'CO+3','NI  ','NI+2','NI+3','CU  ','CU+1','CU+2','ZN  ','ZN+2',
     * 'GA  ','GA+3','GE  ','AS  ','SE  ','BR  ','BR-1','KR  ','RB  ',
     * 'RB+1','SR  ','SR+2','Y   ','Y +3','ZR  ','ZR+4','NB  ','NB+3',
     * 'NB+5','MO  ','MO+3','MO+5','MO+6','TC  ','RU  ','RU+3','RU+4',
     * 'RH  ','RH+3','RH+4','PD  ','PD+2','PD+4','AG  ','AG+1','AG+2',
     * 'CD  ','CD+2','IN  ','IN+3','SN  ','SN+2','SN+4','SB  ','SB+3',
     * 'SB+5','TE  ','I   ','I -1','XE  ','CS  ','CS+1','BA  ','BA+2',
     * 'LA  ','LA+3','CE  ','CE+3','CE+4','PR  ','PR+3','PR+4','ND  ',
     * 'ND+3','PM  ','PM+3','SM  ','SM+3','EU  ','EU+2','EU+3','GD  ',
     * 'GD+3','TB  ','TB+3','DY  ','DY+3','HO  ','HO+3','ER  ','ER+3',
     * 'TM  ','TM+3','YB  ','YB+2','YB+3','LU  ','LU+3','HF  ','TA  ',
     * 'W   ','RE  ','OS  ','IR  ','PT  ','AU  ','HG  ','TL  ','PB  ',
     * 'BI  ','PO  ','AT  ','RN  ','FR  ','RA  ','AC  ','TH  ','PA  ',
     * 'U   ','NP  ','PU  ','AM  ','CM  ','BK  ','CF  ','ES  ','FM  ',
     * 'MD  ','NO  ','LW  ','H   ','H   ','H -1','HE  ','LI  ','LI+1',
     * 'BE  ','BE+2','B   ','C   ','C V ','N   ','O   ','O -1','OH-1',
     * 'H2O ','F   ','F -1','NE  ','NA  ','NA+1','MG  ','MG+2','AL  ',
     * 'AL+3','SI  ','SI V','SI+4','P   ','S   ','CL  ','CL-1','AR  ',
     * 'K   ','K +1','CA  ','CA+2','SC  ','SC+3','TI  ','TI+2','TI+3',
     * 'TI+4','V   ','V +2','V +3','V +5','CR  ','CR+2','CR+3','MN  ',
     * 'MN+2','MN+3','MN+4','FE  ','FE+2','FE+3','CO  ','CO+2','CO+3',
     * 'NI  ','NI+2','NI+3','CU  ','CU+1','CU+2','ZN  ','ZN+2','GA  ',
     * 'GA+3','GE  ',
     * 'GE+4','AS  ','SE  ','BR  ','BR-1','KR  ','RB  ','RB+1',
     * 'SR  ','SR+2','Y   ','Y +3','ZR  ','ZR+4','NB  ','NB+3','NB+5',
     * 'MO  ','MO+3','MO+5','MO+6','TC  ','RU  ','RU+3','RU+4','RH  ',
     * 'RH+3','RH+4','PD  ','PD+2','PD+4','AG  ','AG+1','AG+2','CD  ',
     * 'CD+2','IN  ','IN+3','SN  ','SN+2','SN+4','SB  ','SB+3','SB+5',
     * 'TE  ','I   ','I -1','XE  ','CS  ','CS+1','BA  ','BA+2','LA  ',
     * 'LA+3','CE  ','CE+3','CE+4','PR  ','PR+3','PR+4','ND  ','ND+3',
     * 'PM  ','PM+3','SM  ','SM+3','EU  ','EU+2','EU+3','GD  ','GD+3',
     * 'TB  ','TB+3','DY  ','DY+3','HO  ','HO+3','ER  ','ER+3','TM  ',
     * 'TM+3','YB  ','YB+2','YB+3','LU  ','LU+3','HF  ','HF+4','TA  ',
     * 'TA+5','W   ','W +6','RE  ','OS  ','OS+4','IR  ','IR+3','IR+4'/

       DATA XSCAT2A/
     * 'PT  ','PT+2','PT+4','AU  ','AU+1','AU+3','HG  ','HG+1','HG+2',
     * 'TL  ','TL+1','TL+3','PB  ','PB+2','PB+4','BI  ','BI+3','BI+5',
     * 'PO  ','AT  ','RN  ','FR  ','RA  ','RA+2','AC  ','AC+3','TH  ', 
     * 'TH+4','PA  ','U   ','U +3','U +4','U +6','NP  ','NP+3','NP+4',
     * 'NP+6','PU  ','PU+3','PU+4','PU+6','AM  ','CM  ','BK  ','CF  '/
C
C  ELECTRON ATOMIC SCATTERING FACTORS
C
       DATA ESCAT 
     */'H   ','H -1','HE  ','LI  ','LI+1','BE  ','BE+2','B   ','C   ',
     * 'N   ','O   ','O -1','OH-1','H2O ','F   ','F -1','NE  ',
     * 'NA  ','NA+1','MG  ','MG+2','AL  ','AL+3','SI  ','SI+4',
     * 'P   ','S   ','CL  ','CL-1','AR  ',
     * 'K   ','K +1','CA  ','CA+2','SC  ','SC+3','TI  ','TI+2','TI+3',
     * 'TI+4','V   ','V +2','V +3','V +5','CR  ','CR+2','CR+3','MN  ',
     * 'MN+2','MN+3','MN+4','FE  ','FE+2','FE+3','CO  ','CO+2','CO+3',
     * 'NI  ','NI+2','NI+3','CU  ','CU+1','CU+2','ZN  ','ZN+2','GA  ',
     * 'GA+3','GE  ',
     * 'GE+4','AS  ','SE  ','BR  ','BR-1','KR  ','RB  ','RB+1',
     * 'SR  ','SR+2','Y   ','Y +3','ZR  ','ZR+4','NB  ','NB+3','NB+5',
     * 'MO  ','MO+3','MO+5','MO+6','TC  ','RU  ','RU+3','RU+4','RH  ',
     * 'RH+3','RH+4','PD  ','PD+2','PD+4','AG  ','AG+1','AG+2','CD  ',
     * 'CD+2','IN  ','IN+3','SN  ','SN+2','SN+4','SB  ','SB+3','SB+5',
     * 'TE  ','I   ','I -1','XE  ','CS  ','CS+1','BA  ','BA+2','LA  ',
     * 'LA+3','CE  ','CE+3','CE+4','PR  ','PR+3','PR+4','ND  ','ND+3',
     * 'PM  ','PM+3','SM  ','SM+3','EU  ','EU+2','EU+3','GD  ','GD+3',
     * 'TB  ','TB+3','DY  ','DY+3','HO  ','HO+3','ER  ','ER+3','TM  ',
     * 'TM+3','YB  ','YB+2','YB+3','LU  ','LU+3','HF  ','HF+4','TA  ',
     * 'TA+5','W   ','W +6','RE  ','OS  ','OS+4','IR  ','IR+3','IR+4', 
     * 'PT  ','PT+2','PT+4','AU  ','AU+1','AU+3','HG  ','HG+1','HG+2',
     * 'TL  ','TL+1','TL+3','PB  ','PB+2','PB+4','BI  ','BI+3','BI+5',
     * 'PO  ','AT  ','RN  ','FR  ','RA  ','RA+2','AC  ','AC+3','TH  ', 
     * 'PA  ','U   ','U +3','U +4','U +6','NP  ','PU  ','AM  ',
     * 'CM  ','BK  ','CF  '/
C
C  ANOMALOUS DISPERSION CORRECTIONS FOR CU, MO, CR, AG AND FE RADIATION
C
      DATA ASCAT/'LI','BE','B ','C ','N ','O ','F ','NE','NA',
     1'MG','AL','SI','P ','S ','CL','AR','K ','CA','SC','TI',
     2'V ','CR','MN','FE','CO','NI','CU','ZN','GA','GE','AS',
     3'SE','BR','KR','RB','SR','Y ','ZR','NB','MO','TC','RU',
     4'RH','PD','AG','CD','IN','SN','SB','TE','I ','XE','CS',
     5'BA','LA','CE','PR','ND','PM','SM','EU','GD','TB','DY',
     9'HO','ER','TM','YB','LU',
     6'HF','TA','W ','RE','OS','IR','PT','AU','HG','TL','PB',
     7'BI','PO','AT','RN','FR','RA','AC','TH',
     8'DD','PA','U ','NP',
     8'PU','AM','CM','BK','CF'/
C  DD IN ABOVE LIST IS A DUMMY TO MAKE THE NUMBERING COME OUT
C  FOR SOME REASON 977 WAS OMITTED IN SMITH'S LIST
	DATA ARAD/'CU','MO','FE','CR','AG','CO','NI','ED','ND'/


      IREAD = 5
      ITP1 = 20
      ITYP = 5
      WRITE(ITYP,50)
50	FORMAT(//' Program SUPOWD to set up an input file for computer'/
     1' calculation of a powder pattern using Deane Smith''s POWD10'//
     2' *** SET "CAPS LOCK" ON YOUR TERMINAL***'/)
40	WRITE(ITYP,60)
60	FORMAT(/,' ENTER the name of the output batch file to be ',
     1 'created'/'$(Default file name = POWD10.COM): ')
	READ(IREAD,70) KFILE(7:32)
70	FORMAT(A32)
	IF(KFILE(7:8) .EQ. '  ') KFILE(7:16) = 'POWD10.COM'
	OPEN( UNIT=20, NAME=KFILE(7:32), STATUS='unknown', 
     1 FORM='FORMATTED')
c
c  add the default directory to the .com file
c
	INQUIRE(UNIT=20,NAME=Q)
	J=INDEX(Q,']')
	WRITE(20,1) Q(:J)
1	FORMAT('$ SET DEF ',A<J>)
C
C  ADD THE DEFAULT ASSIGNMENT TO THE KFILE ARRAY TO GET PRINT FILE NAME
C
	DO 71 I=1,32
	IF(KFILE(I:I) .EQ. '.')GO TO 72
71	CONTINUE
72	NEXT = I + 1
	KFILE(NEXT:NEXT+3) = 'POW'
	KFILE(1:6) = '$!ASS '
	DO 73 I=32,1,-1
	IF(KFILE(I:I) .NE. IBL) GO TO 75
73	CONTINUE
75	KFILE(I+2:I+7) = 'FOR006'
	MEXT = I + 7
	WRITE(ITYP,80)
80	FORMAT(/' The next 7 questions are for title information only',/
     1 ' and will not affect the calculation.'//
     2 ' ENTER title information identifing this run')
	READ(IREAD,100)TITLE
100	FORMAT(80A1)
	WRITE(ITYP,110)
110	FORMAT(/'$ENTER the chemical formula of this phase: ')
	READ(IREAD,100) CFORM
	WRITE(ITYP,120)
120	FORMAT(/'$ENTER the mineral name if any: ')
	READ(IREAD,100)MINAM
	WRITE(ITYP,130)
130	FORMAT('$ENTER the mineral locality if applicable: ')
	READ(IREAD,100)MINLOC
	WRITE(ITYP,140)
140	FORMAT('$ENTER the name of the crystal system (eg. cubic etc.): ')
	READ(IREAD,100) SYS
	WRITE(ITYP,145)
145	FORMAT('$ENTER the space group symbol: ')
	READ(IREAD,100)SYM
	WRITE(ITYP,150)
150	FORMAT(' ENTER the reference to the crystal structure article')
	READ(IREAD,100) REF
155	WRITE(ITYP,160)
160	FORMAT(' ENTER the type of radiation desired (CU,MO,NI,FE,CO,CR',
     1 ' or AG)'/' (ENTER ED for electron diffraction or ND for neutron',
     2 ' diffraction)'/'$ Default = CU: ')
	READ(IREAD,165)WL
165	FORMAT(40A2)
	if(wl .eq. '  ') wl = 'CU'
C
C  CHECK TO SEE IF ITS A LEGAL RADIATION
C
	IF(WL .EQ. 'EX')GO TO 999
	XLAMDA = 0.0
	DO 170 I=1,9
	IF(WL .EQ. ARAD(I)) GO TO 190
170	CONTINUE
	WRITE(ITYP,180)WL
180	FORMAT(/' ****** ',A2,' ****** Is not allowed in SUPOWD, ',
     1'allowed radiations are:'/9(1X,A2)/' If you wish a radiation',
     2' other than one of these, ENTER "EXIT" and use the'/
     3' instruction manual for POWD10 to manually set up a run')
	GO TO 155
190	IF(I .LT. 8) GO TO 200
	WRITE(ITYP,195)
195	FORMAT(/'$ENTER the wavelength of electrons or neutrons: ')
	READ(IREAD,196) XLAMDA
196	FORMAT(8G)
	NAA = -1
	GO TO 210
200	WRITE(ITYP,203)
203	FORMAT(/' ENTER <0> - d spacing based on K alpha 1 OR'/
     1'       <1> - d spacing based on unresolved K alpha 1 and 2')
	READ(IREAD,205)NAA
205	FORMAT(6I)
210	WRITE(ITYP,215)
215	FORMAT(' ENTER the number of the space group as given in the Int',
     1'ernational Tables, Vol 1.'/' If two descriptions are given for',
     2' the same space group (ie two with the same #)'/
     3' The first one is selected by entering the space group number',
     2' as positive'/' The second by entering it as a negative',
     3' number'/' (e.g.  Monoclinic P21/b = +14,  P21/c = -14'//
     4'$Do you wish to see the list of non-standard space',
     5' groups available? (Y/N): ')
      ITRANS = 0
      READ(IREAD,100)YE
      IF(YE .NE. YES) GO TO 250
	WRITE(ITYP,220)
220	FORMAT(/' The number following each space group is',
     1' the number to be entered to'/' select one of these groups.'/
     2' For monoclinic groups with the Y axis unique:'/
     3' Pn   231     P2/n  232     P21/n  233     P2/a  234'/
     4' I2   235     Im    236     Ic     237     I2/m  238'/
     5' I2/c 239     A2/a  240     Pbnm   241'//
     6' For non-standard orthormobic settings (other than Pbnm above)',
     7' you must supply'/' the axis transform as given on'
     8' p. 546 of Vol. 1 of the International Tables'/
     8/' For very Odd-Ball space groups use program CRYSET and see'/
     8' the POWD10 manual for instructions on entry of symmetrys'//
     9 '$Do you have a non-standard orthorombic space group? (Y/N): ')
      READ(IREAD,100)YE
      IF(YE.NE.YES) GO TO 250
      WRITE(ITYP,230)
230	FORMAT(/' For non-standard orthorombic space groups, input the',
     1' standard group number'/' when asked and the program will auto',
     2'maticlly transform according to the'/' following',
     3' code (obtained from p.546 of the International Tables'//
     4' 0 = abc (do not transform)'/
     4' 1 = cab'/' 2 = bca'/' 3 = a-cb'/' 4 = ba-c'/' 5 = -cab'//
     5'$ENTER number of transformation desired: ')
	READ(IREAD,205) ITRANS
250	WRITE(ITYP,260)
260	FORMAT(/'$ENTER space group number with sign: ')
	READ(IREAD,205) NSG
270	WRITE(ITYP,280)
280	FORMAT(' ENTER the number of atoms in the asymmetric unit'/
     1,'$(ie. the number of atom positions to be entered later: ')
	READ(IREAD,205) NB
	IF(NB .LT. 100) GO TO 300
	WRITE(ITYP,290) NB
290	FORMAT(1X,I6,' Is too many( 99 max). try again')
	GO TO 270
300	WRITE(ITYP,305)
305	FORMAT('$ENTER the number of assymetric units in the unit cell',
     1' (ie. Z): ')
	READ(IREAD,205) IZ
	write(itp1,609) kfile
C  NULL OUT THE NORMAL OUTPUT
	WRITE(ITP1,306)
306	FORMAT('$ ASSIGN NL: FOR006')
	KFILE(2:2) = ' '
	KFILE(NEXT:NEXT+3) = 'BIN'
	KFILE(MEXT:MEXT) = '8'
	WRITE(ITYP,310)KFILE(6:NEXT+3)
310	FORMAT('$Do you wish a plottable file to be written to ',
     1A14/'$(Y/N) (Default = Y): ')
	READ(IREAD,100)YE
	NPLOT = 1
	IF(YE .EQ. 'N')NPLOT = 0
C
C  WHAT TYPE OF TEMPERATURE FACTORS ARE TO BE ENTERED?
C
	WRITE(ITYP,330)
330	FORMAT('$Do you have thermal parameters in a form '
     1 'other than B or beta? (Y/N): ')
      IBETA = 0
      READ(IREAD,100) YE
      IF(YE.NE.YES)GO TO 350
      WRITE(ITYP,340)
340	FORMAT(/' ENTER the appropriate code:'/
     1 ' 0 = beta''s to be input'/
     2 ' 1 = beta''s to be corrected for 2 factor in cross terms'/
     3 ' 2 = Bij''s to be input'/
     4 ' 3 = Bij''s to be corrected for 2 factor in cross terms'/
     5 ' 4 = Bij''s in vector dot product form'/
     6 ' 5 = Bij''s as vector dot products without 2 in x terms'/
     7 ' 6 = Uij''s to be entered'/
     8 ' 7 = Uij''s without 2 in cross terms'/
     9 ' 8 = Uij''s as vector dot products'/
     a ' 9 = Uij''s as vector dot products without 2 in x terms'/
     b ' 1x - where x=0 to 9, means take any of the above forms'/
     c '      and convert to an isotropic B value'//
     d '$ENTER the code: ')
      READ(IREAD,205) IBETA
350	WRITE(ITYP,360)
360	FORMAT(' ENTER <0> - Fixed 1 degree divergence slit OR'/
     1'       <1> - Theta compensating slit used')
	READ(IREAD,205) NTCS
	WRITE(ITYP,370)
370	FORMAT(/' ***** Bond Angle and Distance Input Parameter',
     1' for Program DINT9 *****'//' The x,y,z atomic coordinates',
     2' published and, to be typed by you in a moment,'/' are',
     3' notoriously prone to typographical errors. In order to'/
     4' check for errors the same batch file currently being',
     5' written can be used as input'/' to program DINT9.  DINT9',
     6' will use the coordinates to compute all interatomic'/
     6' distances',
     7' and angles in one unit cell.  A simple check of the known',
     8' distances'/' for your compound will quickly show if your',
     9' coordinates are in error.'/' Instructions for executing DINT9',
     a' will be typed at the end of SUPOWD.'/' The only additional',
     b' information reguired by DINT9 is'/' the cutoff for the computat',
     c 'ion of interatomic distances.'/' If this value is input as zero',
     d' 3.2A will be used'//'$ENTER the distance limit: ')
	READ(IREAD,196)RLIM
	IF(RLIM .EQ. 0)RLIM = 3.2
C
C SET UP FOR A DIFFRACTED BEAM GRAPHITE MONOCHROMETER
C
	WRITE(ITYP,380)
380	FORMAT(/'$ENTER the 2-theta of the incident beam monochrometer',
     1' (0=none used): ')
	READ(IREAD,196)TTH1
C*************SHIP THIS FEATURE IT COMPLETLY SCREWS UP THE CALCULATION***
        tth2 = 0.0
c	WRITE(ITYP,390)
c390	FORMAT(/'$ENTER 2-theta of diffracted beam monochrometer',
c     1' (graphite=28.3, 0=none): ')
c	READ(IREAD,196)TTH2
C
C FORM FACTOR CARD
C
      WRITE(ITYP,400)
400	FORMAT(/' Atomic scattering factors:'/
     1' Type in the chemical symbols and oxidation state',
     2' of each of the types of elements present'/' One symbol on a',
     3' line.  For single symbol elements enter a blank after the'/
     3' name and before the oxidation state (if one is to be entered)'/
     3' When all are entered type <CR>',
     4' examples: '/
     5' B'/' B +1'/' Cu+2'/' Cu'/' C '/' S -2'/' Mn'/' Li+1'/
     6' <Carriage Return>')
	NA = 1
410	WRITE(ITYP,420) NA
420	FORMAT('$ENTER the scattering factor for element number',I4)
	READ(IREAD,425) TYPE(NA)
425	FORMAT(20A4)
	IF(TYPE(NA) .EQ. BL)  GO TO 500
C
C  HANDEL ELECTRON SCATTERING FACTORS
C
       IF(WL .NE. 'ED')GO TO 429
	DO 426 I=1,204
	IF(TYPE(NA) .EQ. ESCAT(I)) GO TO 450
426	CONTINUE
       GO TO 433
C
C  HANDEL X-RAY SCATTERING FACTERS
C
429	DO 430 I=1,352
	IF(TYPE(NA) .EQ. XSCAT1(I)) GO TO 450
430	CONTINUE
        DO I=1,97
	IF(TYPE(NA) .EQ. XSCAT1A(I)) GO TO 450
        ENDDO



C
C  NOT IN THE ORFLS LIST TRY THE POLYNOMIAL LIST
C
	DO 432 I=1,352
	IF(TYPE(NA) .EQ. XSCAT2(I)) GO TO 449
432	CONTINUE
        DO I=1,45
        IF(TYPE(NA) .EQ. XSCAT2A(I)) GO TO 449
        ENDDO

433	WRITE(ITYP,440)
440	FORMAT(' Illegal element symbol (probably the oxidation state'/
     1' requested is not in library choose a different oxidation state)'
     2 )
	GO TO 410
C
C  HAS THIS ELEMENT ALREDY BEEN ENTERED?
C
449	I = I + 470
450	IF(NA .EQ. 1) GO TO 490
	AI = I
	JJ = NA - 1
	DO 460 J = 1,JJ
	IF(NK(J) .EQ. I) GO TO 470
460	CONTINUE
	GO TO 490
470	WRITE(ITYP,480) TYPE(NA)
480	FORMAT(/' I already know about ',A4,' enter your other elements'/)
	GO TO 410
490	NK(NA) = I
	NA = NA + 1
       IF(NA .GT. NB) GO TO 500
	GO TO 410
500	IF(WL .EQ. 'ND') WRITE(ITYP,505)
505	FORMAT(/' ***** IMPORTANT *****'/' The batch file written by',
     1' this program MUST be edited and the proper'/
     2' neutron scattering factors MUST be inserted - The current',
     3' file will NOT work without them'/)
	NA = NA - 1
	NOAN = 0	
	NAM = NA
	NANOM = 0
	IF(WL .EQ. 'ED' .OR. WL .EQ. 'ND') GO TO 600
	WRITE(ITYP,510)
510	FORMAT('$Do you want anomolous dispersion corrections',
     1' applied? (Y/N) (Default=Y): ')
	READ(IREAD,100)YE
	IF(YE .EQ. NEG) GO TO 600
C
C  WE ONLY HAVE THE ANAOMALOUS DISPERSION COEFFICIENTS ON TAPE FOR
C  THE FIRST 5 WAVELENGTHS IN THE ARAD ARRAY
C
	DO 520 I=1,5
	IF(WL .EQ. ARAD(I)) GO TO 540
520	CONTINUE
	WRITE(ITYP,530)
530	FORMAT(/' SORRY! We do not have the coefficient on file for',
     1' your wavelength'/' You will have to run POWD10 in manual',
     2' mode and supply the f'' and f'''' values')
	GO TO 600
540	NOAN = 1
	WRITE(ITYP,550)
550	FORMAT(/' Enter the element symbols for which you',
     1' desire the corrections to be applied'/' One on a line',
     2' without oxidation state (ie. letters only)'/' A <cr> for',
     2' the first entry will apply the corrections to all elements')
	NAM = NA + 1
560	READ(IREAD,165)TYPE(NAM)
	IF(TYPE(NAM) .EQ. BL) GO TO 590
	DO 570 I = 1,96
	IF(TYPE(NAM) .EQ. ASCAT(I)) GO TO 580
570	CONTINUE
	WRITE(ITYP,440)
	GO TO 560
580	NK(NAM) = I + 888
	NAM = NAM + 1
	GO TO 560
590	NAM = NAM - 1
	NANOM = NAM - NA
       IF(NANOM .NE. 0)GO TO 600
C
C  DEFAULT REQUESTED TO APPLY ANOMALOUS DISPERSION TO ALL ELEMENTS (EXCEPT H)
C
       WRITE(ITYP,591)
591	FORMAT(' Anomalous dispersion corrections will be applied to:')
       J = 1
       IEND = NAM
	NAM = NAM + 1
592	TYPE(NAM)(1:2) = TYPE(J)(1:2)
        TYPE(NAM)(3:4) = '  '
	IF(TYPE(NAM) .EQ. BL) GO TO 597
       IF(TYPE(NAM) .EQ. 'H   ') GO TO 596
	DO 593 I = 1,96
	IF(TYPE(NAM)(1:2) .EQ. ASCAT(I)) GO TO 595
593	CONTINUE
	WRITE(ITYP,594) TYPE(NAM)
594	FORMAT(' No anomalous dispersion factor in file for ',A4)
	GO TO 596
595	NK(NAM) = I + 888
       WRITE(ITYP,598) TYPE(NAM)
598	FORMAT(1XA4)
	NAM = NAM + 1
596     J = J + 1
       IF(J .GT. IEND) GO TO 597
	GO TO 592
597	NAM = NAM - 1
	NANOM = NAM - NA
C
C  write first records to batch file
C
600	WRITE(ITP1,609) KFILE
609	FORMAT(A32)
	KFILE(NEXT:NEXT+3) = 'SUM'
	KFILE(MEXT:MEXT) = '7'
	WRITE(ITP1,609) KFILE
	KFILE(NEXT:NEXT+3) = 'CBN'
	KFILE(MEXT:MEXT) = '0'
	NP = 1
	WRITE(ITP1,610) KFILE, CFORM, MINAM, TITLE, SYS,SYM,IZ,MINLOC,
     1 REF, WL, NSG, NB, NP, NAA, NANOM, ITRANS, IBETA, NTCS, RLIM,
     2 TTH1, TTH2, XLAMDA
610	FORMAT(A32/'$ RUN POWD:[PUBLIC.EXE.POWD10]POWD10'
     1 /2(40A1)/80A1/12A1,9A1,I5,50A1/
     2 80A1/ A2,I4,3I3,3X,I3,6X,2I3,3X,I3,4X,F5.2,2F6.3,F10.5) 
C
C  SORT SCATTERING FACTORS FORM LOW TO HIGH
C
      NN = NAM - 1
      DO 620 I = 1,NN
      M = I + 1
      DO 620 J = M,NAM
      IF(NK(I).LT.NK(J)) GO TO 620
      IT = NK(I)
      NK(I) = NK(J)
      NK(J) = IT
      T = TYPE(I)
      TYPE(I) = TYPE(J)
      TYPE(J) = T
  620 CONTINUE
      WRITE(ITP1,625)(NK(I),I=1,NAM)
  625 FORMAT(20I3)
	WRITE(ITYP,630)
630	FORMAT(/
     1' INPUT only the needed lattice parameters for your symmetry'/
     1' (Zero angles default to 90 degrees)'/
     1' a, b, c, alpha, beta, gamma (separate with commas): ')
	READ(IREAD,196)A,B,C,AL,BE,GA
	IF(B.EQ.0.0)B = A
	IF(C.EQ.0.0)C = A
	IF(AL.EQ.0.0)AL = 90.
	IF(BE.EQ.0.0)BE = 90.
	IF(GA.EQ.0.0)GA = 90.
      WRITE(ITP1,650) A, B, C, AL, BE, GA
650	FORMAT(6F10.5)
      WRITE(ITYP,660)
  660 FORMAT(' ENTER indices of the scale reflection, if zero maximum',
     1 /'$intensity reflection will be used (separate with commas):')
      READ(IREAD,205)LOG
      WRITE(ITYP,680)
  680 FORMAT(' ENTER the intensity value you wish the scale reflection'/
     1' to be set to (if zero 100. is assumed)')
      READ(IREAD,196)SCL
      IF(SCL.EQ.0.0) SCL = 100.
      WRITE(ITYP,690)
  690 FORMAT(' ENTER the resolution code for the plot:'/
     1' 1 = .01, 2 = .02, 3 = .05 and 4 = .10 (degrees per point)')
      READ(IREAD,205)MAX
	IF(MAX .EQ. 0) MAX = 2
      SCMAX = MAX/100.
      SCMAX = INT(SCL) + SCMAX
      HW1=0.0
      ANG1=0.0
      WRITE(ITYP,710)
 710  FORMAT(/' Program will use the NBS half width function by default',
     2/' Do you wish different values to be used? Y or N')
      READ(IREAD,100)YE
      IF(YE.NE.YES) GO TO 730
      WRITE(ITYP,720)
720   FORMAT(' INPUT half-width and angle separated by commas:')
      READ(IREAD,196) HW1,ANG1
730   WRITE(ITYP,740)
740	 FORMAT(' TYPE the max 2-theta to be calculated'/
     1' Default = a value just less than 180.')
      READ(IREAD,196)TTMAX
	WRITE(ITYP,750)
750	FORMAT(/' ENTER the experimental density if known:')
	READ(IREAD,196)DENS
      WRITE(ITP1,760)(LOG(I),I=1,3),SCL,DENS,TTMAX
760   FORMAT(3I2,6X,3F6.2)
      WRITE(ITYP,770)NB,(I,TYPE(I),I=1,NA)
770	FORMAT(' You must now enter the following data for each of the'/
     1 1xI3,'  atoms in your asymmetric unit.'//
     2' Item 1 (8A1): atom label- any name (***YOU MUST USE 8 LETTERS',
     1' OR BLANKS!!!)'/
     3' Item 2 (I): the scattering factor code see below'/
     3' Item 3 (I): the anomolous dispersion code-see below'/
     3'             leave blank if not being used'/
     4' Item 4 (F): Multiplier- this is obtained by taking'/
     510x,'the general multiplicity for your space group as given'/
     610x,'to the left of coordinates in vol.I of Int. Tables'/
     6' (at top left of coordinates next to "x,y,z...")'/
     710x,'and dividing it into the specific multiplicity'/
     810x,'listed for the position of this atom'/,
     9' Item 5 (F): x coordinate'/
     a' Item 6 (F): y coordinate'/
     b' Item 7 (F): z coordinate'/
     c' Item 8 (F): isotropic thermal parameter - B'/
     d10X,'if B=0.0 then a second record must be supplied with'/
     e10X,'the 6 anisotropic beta values'/
     f/' scattering factor codes:'/
     g' Code Atom'/40(1XI4,1X,A4/)//)
      IF(NOAN.EQ.0) GO TO 790
      J = NA + 1
      WRITE(ITYP,780)(I,TYPE(I),I=J,NAM)
780	FORMAT(' Anomolous Dispersion Codes:'/
     1' Code Atom'/ 40(1XI4,3XA2/)/)
790	WRITE(ITYP,800)
800	FORMAT(' After 8 character name separate all items with commas -',
     1' one line per atom'/' NOTE: The Scat. code and Anom. code must',
     2' NOT contain a decimal point!')
	DO 900 M = 1,NB
810	WRITE(ITYP,820)M
820	FORMAT(' Enter Atom Number',I3/
     1X'AtomName   Scat. code, Anom code, ',
     1'Multiplier, X, Y, Z, B')
      READ(IREAD,830,err=831)(TITLE(J),J=1,8),IFC,IAC,REST
830	FORMAT(8A1,2I,5G)
      goto 833
 831  write(ityp,832)
 832   format(' There was an error on read. Try again')
      go to 810
 833  IF(REST(5) .NE. 0.0) GO TO 850
      WRITE(ITYP,840)M
840	FORMAT(' Six Beta''s for atom',I3,' (separate with commas)')
      READ(IREAD,196)BETA
850	AFC = IFC
	WRITE(ITYP,855)(TITLE(I),I=1,8),AFC,IAC,REST
855	FORMAT(1X,8A1, F6.1, 2XI2,2XF6.4, 4F10.6)
	IF(REST(5).EQ. 0.0)WRITE(ITYP,856)BETA
856	FORMAT(6(1X,F10.5))
	WRITE(ITYP,860)
860	FORMAT('$ Is atom Ok? (Y or N):')
      READ(IREAD,100)YE
      IF(YE .EQ. 'N') GO TO 810
	WRITE(ITP1,870)(TITLE(I),I=1,8),AFC,REST,IAC
870	FORMAT(8A1, F6.1, F6.4, 4F10.6, 18XI2)
      IF(REST(5) .NE. 0.0) GO TO 900
      WRITE(ITP1,880)BETA
880	FORMAT(6F10.6)
900	CONTINUE
C PLOTTER CONTROL CARD
C  FINAL SUMMARY WILL BE WRITEN TO UNIT 7
      I = 7
      A1 = .5
      A2 = 0.999
      A3 = 0.1
	A4 = 0.8
	A5 = .1
	IF(NPLOT .EQ. 1) NPLOT = 0
	NPR = 1
	write(ityp,902)
902	format(' Is program COMBIN to be run later to simulate a ',
     1'pattern for a mixture?'/' 0 = Do not prepare COMBIN file'/
     2' 1 = Prepare COMBIN file as calculated'/
     3' 2 = Prepare for COMBIN using Cu K alpha radiation'/
     4'$Enter option: <0>: ')
	read(iread,904) nflag
904	format(i)
	WRITE(ITP1,910)HW1, ANG1, SCMAX, I,NPR, NPLOT,A1,A2,A3,A4,A5,
     1 nflag
910	FORMAT(3F6.2,2XI2,6X,2I2,3X,5F5.3,10Xi2)
      WRITE(ITYP,920)
920	FORMAT(//'$Do you wish a second data set run? (N/Y): ')
      READ(IREAD,100)YE
	JSENT = JBL
      IF(YE.EQ.YES) JSENT = ISENT
      WRITE(ITP1,165)JSENT
      IF(YE .EQ. YES) GO TO 40
      WRITE(ITP1,930)
930	FORMAT('%*')
      WRITE(ITYP,940)
940	FORMAT(/,' Do you wish to see the remainder of the'/
     1,' of the instructions (Y or N)'/)
      READ(IREAD,100)  YE
      IF(YE.NE.YES) GO TO 999
      WRITE(ITYP,950)
950	FORMAT(///' As soon as terminal returns a  $  type'//
     1' SUBMIT/NOTIFY/NOPRINT/BATCH=ORDER "filename".COM'//
     2'   where filename is the name assigned to the .COM file'/
     3'   the program will be run in batch mode and the output'/
     4'   will be written to a file named "filename".SUM.'/
     5'   If any problems are suspected the "$ assign NL: FOR006"'/
     6'   statment in the .COM file should pe changed to "$ assign',
     7' filename.pow FOR006"'/
     6'   The .POW file contains all of the gory details of the', 
     7' calculation.',/,
     8'   The file POWD10.OUT contains calculated pattern in d5000 
     9    format' )
999	CALL EXIT
      END

