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