C  PROGRAM TO READ IN X-RAY ATOMIC SCATTERING FACTORS FROM
C  TAPE UNIT 10 (I.E. F10=F10FORMF) AND INTERPOLATE THEM TO
C  OUTPUT ON UNIT 20  THE FORM FACTORS IN LEAST SQUARES FORMAT
C  INTERACTIVE PROGRAM FOR XDS SIGMA 5  8/72  BY R. SNYDER
	INTEGER   BLANK, ELEM(2,14), SYMBL(2)
	DIMENSION                         FF(25),SPACE(25)
	COMMON ICDI,ICDO,IPRT,WAVE,FF,SPACE
	DATA BLANK/'  '/
	ICDI=105
	IPRT=108
	ICDO=20
	WRITE(IPRT,200)
200	FORMAT(//' PROGRAM TO PRODUCE X-RAY ATOMIC SCATTERING'/
	1' FACTORS IN LEAST SQUARES(ORFLS) FORMAT'//
	2' ENTER WAVELENGTH OF RADIATION DESIRED WITH DECIMAL'/)
	ITAP = 10
	READ(ICDI,1)WAVE
1	FORMAT(G20.10)
	IXR63 = 2
	WRITE(IPRT,201)
201	FORMAT(/' ENTER ELEMENTS WHOSE FORM FACTORS ARE DESIRED'/
	1' ONE ON A LINE WITH SYMBOL LEFT ADJUSTED IN COL 1'/
	2' AND OXIDATION STATE WITH SIGN IN COL 3+4'/
	3' WHEN OXIDATION STATE IS ZERO COL 3+4 ARE BLANK'/
	4' EXAMPLES:'/'C'/'I -1'/'LI+1'/'CU+2'/'V +5'//)
203	DO 205 I=1,14
	READ(ICDI,210)ELEM(1,I),ELEM(2,I)
210	FORMAT(2A2)
	IF(ELEM(1,I).EQ.BLANK) GO TO 220
205	CONTINUE
220	ISYM = I - 1
	IF(ISYM.EQ.0) GO TO 999
	GO TO(100,105,106),IXR63
100	WRITE(IPRT,3)
3	FORMAT(   1H0,'F VS. SIN THETA / LAMBDA IN X-RAY 67 FORMAT'/)
	 GO TO 110
105	WRITE(IPRT,4)
4	FORMAT(   1H0, 'F VS. SIN THETA IN ORFLS FORMAT'/)
	GO TO 110
106	WRITE(IPRT,11)
11	FORMAT(   1H0, 'F VS. SIN THETA / LAMBDA IN HALL''S DIRECT METHOD
	1FORMAT'/)
110	IHIT = 0
120	READ(ITAP,210,END=250)SYMBL
	DO 230 I = 1,ISYM
	IF(SYMBL(1).NE.ELEM(1,I)) GO TO 230
	IF(SYMBL(2).NE.ELEM(2,I)) GO TO 230
	GO TO 240
230	CONTINUE
	READ(ITAP,227)
227	FORMAT(//////)
	 GO TO 120
240	IHIT = IHIT + 1
	IS = I
	READ(ITAP,245)(SPACE(I),FF(I),I=1,25)
245	FORMAT(4(2F7.2))
	GO TO(145,155,160),IXR63
250	IF(IHIT.EQ.ISYM) GO TO 999
	WRITE(IPRT,255)ISYM,(ELEM(1,I),ELEM(2,I),I=1,ISYM)
255	FORMAT(//' THE FOLLOWING ELEMENTS WERE INPUT:',/N(1X,2A2)//
	1' THE ELEMENTS IN THIS LIST FOR WHICH NO SCATTERING FACTORS'/
	2' WERE PRODUCED ARE NOT IN DATA FILE.  TRY CHANGING THE'/
	3' OXIDATION STATE OF THE ELEMENTS IN QUESTION--RETYPE AS'/
	4' BEFORE'/)
	REWIND ITAP
	GO TO 203
	GO TO(145,155,160),IXR63
145	I=1
	IF(ELEM(1,IS)-SYMBL(1))149,146,149
146	IF(ELEM(2,IS)-SYMBL(2))149,147,149
147	WRITE(ICDO,9)(ELEM(J,IS),J=1,2),SPACE(I),FF(I),I
9	FORMAT('FORMFX ',2A2,2X,2F7.4,'  R. STEWART H FORM FACTOR PRIVATE
	1COMM.  ',1XI2)
	WRITE(IPRT,20)(ELEM(J,IS),J=1,2)
20	FORMAT(//    ' FORM FACTOR TABLE FOR ',2A2/)
	WRITE( IPRT, 19 ) (ELEM(J,IS),J=1,2),SPACE(I),FF(I),I
19	FORMAT(   1X,'FORMFX ',2A2,2X2F7.4,'  R. STEWART H FORM FACTOR PRI
	1VATE COMM.  ',1XI2)
	DO 148 I=2,25
	WRITE(IPRT,15)(ELEM(J,IS),J=1,2),SPACE(I),FF(I),I
15	FORMAT(   1X,'FORMFX ',2A2,2X2F7.4,43XI2)
148	WRITE(ICDO,10)(ELEM(J,IS),J=1,2),SPACE(I),FF(I),I
10	FORMAT('FORMFX '2A2,2X,2F7.4,43XI2)
	GO TO 120
149	WRITE(ICDO,7) ELEM(1,IS),         SPACE(I),FF(I),I
7	FORMAT('FORMFX ',A2,4X,2F7.2,' CROMER AND WABER ACTA CRYST 18,104(
	11965) ',1XI2)
	WRITE(IPRT,20)(ELEM(J,IS),J=1,2)
	WRITE(IPRT,5)(ELEM(J,IS),J=1,2),SPACE(I),FF(I),I
5	FORMAT(   1X, 'FORMFX ',2A2,4X2F7.2,' CROMER AND WABER ACTA CRYST
	'18,104(1965) ',1XI2)
	DO 150 I=2,25
	WRITE(IPRT,13)(ELEM(J,IS),J=1,2),SPACE(I),FF(I),I
13	FORMAT(   1X, 'FORMFX ',2A2,4X2F7.2,43XI2)
150	WRITE(ICDO,8) ELEM(1,IS),         SPACE(I),FF(I),(ELEM(J,IS),J=1
	1,2),I
8	FORMAT('FORMFX ' A2,4X,2F7.2,12X2A2,27XI2)
	GO TO 120
155	WRITE(IPRT,20)(ELEM(J,IS),J=1,2)
	CALL INTRP
	GO TO 120
160	I=1
	WRITE(IPRT,20)(ELEM(J,IS),J=1,2)
	WRITE(ICDO,12)(ELEM(J,IS),J=1,2),I,(FF(J),J=1,9)
12	FORMAT(2A2,I1,12X,9F7.3)
	WRITE(IPRT,16)(ELEM(J,IS),J=1,2),I,(FF(J),J=1,9)
16	FORMAT(   1X,2A2,I1,12X9F7.3)
	I=2
	WRITE(ICDO,12)(ELEM(J,IS),J=1,2),I,(FF(J),J=10,18)
	WRITE(IPRT,16)(ELEM(J,IS),J=1,2),I,(FF(J),J=10,18)
	GO TO 120
999	STOP
	END
	SUBROUTINE INTRP
	DIMENSION Z(250),FF(25),SPACE(25),T(50),X(10),Y(10),YA(10)
	COMMON ICDI,ICDO,IPRT,WAVE,FF,SPACE
C     ATOMIC SCATTERING FACTOR INTERPOLATION
C          AITKEN,S N-POINT ITERATION
C        FOR IBM 1130 WITH 1442 CARD READ/PUNCH MODEL 6
	DINCR=.02
	NP=4
	NPA=NP/2
	A=0.0
	L=1
	DO10 I=1,25
	T(L)=SPACE(I)
	L=L+1
	T(L)=FF(I)
10	L=L+1
	L=1
	N=49
	AMAX=1.0
C  CHANGE ARGUMENT TO SIN THETA
	DO 24 I=1,N,2
24	T(I)=T(I)*WAVE
C BEGIN INTERPOLATION
	DO 18  I=1,250
18	Z(I)=0.0
42	DO 26  I=1,N,2
	IF  (A-T(I) )   27,  27,  26
26	CONTINUE
27	IA=I-NPA*2
	IF  (I/2-NPA)  28,  28,  29
28	IA=1
29	IF  (IA+NP*2-N)  32,  32,  31
31	IA=N-2*NP
32	DO  30  J=1,NP
	X(J)=T(IA)
	Y(J)=T(IA+1)
30	IA=IA+2
	NPB=NP-1
	DO  41  K=1,NPB
	DO  40  J=K,NPB
40	YA(J)=(Y(K)*(X(J+1)-A)-Y(J+1)*(X(K)-A))/(X(J+1)-X(K))
	DO  41  J=K,NPB
41	Y(J+1)=YA(J)
	Z(L)=Y(NP)+0.00005
	L=L+1
	A=A+DINCR
	IF  (A-AMAX)  42,  42,  45
45	L=L-1
	ICD=0
	DO  49  I=1,L,7
	ICD=ICD+1
	WRITE (IPRT,6) Z(I),Z(I+1),Z(I+2),Z(I+3),Z(I+4),Z(I+5),Z(I+6)
6	FORMAT(   1X, 7F10.4)
49	WRITE (ICDO,5) Z(I),Z(I+1),Z(I+2),Z(I+3),Z(I+4),Z(I+5),Z(I+6),ICD
5	FORMAT (  7F10.4,I10 )
	RETURN
	END
