C COPYRIGHT 1985 UNIVERSITY OF GLASGOW 0001.000 C WEIGHTING ANALYSIS PROGRAM WTANAL 0002.000 C GX PACKAGE APRIL 1985 PAUL R. MALLINSON & K.W. MUIR 0003.000 C 0004.000 PROGRAM WTANLPRM 0005.000 CHARACTER LINE(148) 0006.000 CHARACTER*4 HEDA(8),HEDB(2,15),HEDC(15) 0007.000 INTEGER FCH(20),FWD(20),KNT(6), FKEEP(20000) 0008.000 DIMENSION SIGWD(3,25),SIGD(3,25),SGPWD(8),SGDP(8),SGTWD(15) 0009.000 DIMENSION SFO(3,25),NFO(3,25),IHKL(3),SFOP(8),NFOP(8),SFOT(15) 0010.000 DIMENSION NFOT(15),TITLE(20),IMHKL(7) 0011.000 DIMENSION NN(3), R(11),STHE(10),NOFOB(10),SWDFO(10),SDEL(10) 0012.000 DIMENSION SFOBS(10),NSTH(10),SWDTH(10),SDLTH(10),SF(10) 0013.000 DIMENSION PKNT(6),FLIM(7),SGDT(15) 0014.000 DATA LINE/148*' '/,KNT/6*0/,LIN/17/,LC/5/,LP/3/,LT/6/ 0015.000 DATA FLIM/0.,0.5,1.5,2.5,3.5,4.5,99./ 0016.000 DATA HEDA/'EEE','EEO','EOE','EOO','OEE','OEO','OOE','OOO'/ 0017.000 DATA HEDC/'ALL','EVEN','ODD','EVEN','ODD','EVEN','ODD','EVEN','ODD0018.000 1','EVEN','ODD','EVEN','ODD','EVEN','ODD'/ 0019.000 DATA HEDB/' ',' ','H',' ','H',' ','K',' ','K',' ','L',' ','L',' ',0020.000 1'H+K',' ','H+K',' ','H+L',' ','H+L',' ','K+L',' ','K+L',' ','H+K+'0021.000 2,'L','H+K+','L'/ 0022.000 DATA SFO/75*0.0/,NFO/75*0/,SFOP/8*0.0/,NFOP/8*0/,SFOT/15*0.0/,NFOT0023.000 1/15*0/ 0024.000 DATA SIGWD/75*0.0/,SIGD/75*0.0/,SGPWD/8*0.0/,SGDP/8*0.0/,SGTWD/15*0025.000 10.0/,SGDT/15*0.0/ 0026.000 DATA NOFOB/10*0/,SWDFO/10*0.0/,SDEL/10*0.0/,SFOBS/10*0.0/,NSTH/10*0027.000 10/,SWDTH/10*0.0/,SDLTH/10*0.0/,SF/10*0.0/,FKEEP/20000*0/ 0028.000 1000 FORMAT(80A1) 0029.000 1001 FORMAT(1H0,5X,I5,' OBSERVATIONS',/6X,I5,' PARAMETERS',/7X, 0030.000 1' E.S.D. OF OBSERVATION OF UNIT WEIGHT (S) =',F7.2) 0031.000 1002 FORMAT(1H ,3I5,5F10.2) 0032.000 1003 FORMAT(///1H ,4X,'H',4X,'K',4X,'L',6X,' FO ',5X,' FC ',5X,'DELTA'0033.000 1,4X,'SIG(FO)',2X,'DELTA/SIG*S'//) 0034.000 1004 FORMAT(6(1H ,I5,5X,F7.2,2X,F4.1,' - ',F4.1/)) 0035.000 1005 FORMAT(//1H ,' N ',5X,'PERCENT',2X,'DELTA/SIG*S'/) 0036.000 1006 FORMAT(//5X,' TYPE NO. OF PARAMETERS AND DELTA/SIGMA RATIO FOR PRI0037.000 1NTING'//) 0038.000 WRITE(LT, 222) 0039.000 222 FORMAT('0TYPE TITLE') 0040.000 READ(5,100)TITLE 0041.000 WRITE(LP,101)TITLE 0042.000 100 FORMAT(20A4) 0043.000 101 FORMAT(' ',20A4) 0044.000 999 WRITE(LT,1006) 0045.000 READ(LC,1000)(LINE(I),I=2,73) 0046.000 CALL PARSE(LINE,NFS,FCH,FWD) 0047.000 IF(NFS.NE.2)GOTO 999 0048.000 CALL IFORMT(LINE,FCH(1),FWD(1),N) 0049.000 CALL FFORMT(LINE,FCH(2),FWD(2),FPR) 0050.000 S=0. 0051.000 NP=0 0052.000 11 READ(LIN,END=2) IW1,IW2, FO, SIG,A, B, STHOL 0053.000 FO=SQRT(FO) 0054.000 SIG=0.5*SIG/FO 0055.000 DC=FO-SQRT(A*A+B*B) 0056.000 NP=NP+1 0057.000 S=S+DC*DC/(SIG*SIG) 0058.000 GOTO 11 0059.000 2 S=SQRT(S/REAL(NP-N)) 0060.000 WRITE(LP,1001)NP,N,S 0061.000 WRITE(LP,1003) 0062.000 NP=0 0063.000 STHLM=0.0 0064.000 REWIND(LIN) 0065.000 122 READ(LIN,END=3) IW1,IW2,FO,SIG,A,B,STHOL 0066.000 FO=SQRT(FO) 0067.000 SIG=0.5*SIG/FO 0068.000 FC=SQRT(A*A+B*B) 0069.000 NP=NP+1 0070.000 I=MOD(IW1,16777216) 0071.000 IHKL(1)=(I/65536)-128 0072.000 I=MOD(I,65536) 0073.000 IHKL(2)=(I/256)-128 0074.000 I=MOD(I,256) 0075.000 IHKL(3)=I-128 0076.000 STHOL=SQRT(STHOL) 0077.000 FKEEP(NP)=NINT(FO*10.) 0078.000 IF(STHLM-STHOL)500,501,501 0079.000 500 STHLM=STHOL 0080.000 501 DELTA=ABS(FO-FC) 0081.000 DELT=DELTA/(SIG*S) 0082.000 WDSQ=DELT**2 0083.000 IDELT=NINT(DELT)+1 0084.000 IF(IDELT.GT.6)IDELT=6 0085.000 KNT(IDELT)=KNT(IDELT)+1 0086.000 IF(DELT.GT.FPR) 0087.000 1WRITE(LP,1002) IHKL, FO, FC,DELTA,SIG,DELT 0088.000 DO 1 I=1,3 0089.000 IMHKL(I)=SMOD(IHKL(I)) 0090.000 N=IABS(IHKL(I))+1 0091.000 IF(N-25)600,600,601 0092.000 601 N=25 0093.000 600 SFO(I,N)=SFO(I,N)+ABS(FO) 0094.000 SIGWD(I,N)=SIGWD(I,N)+WDSQ 0095.000 SIGD(I,N)=SIGD(I,N)+DELTA 0096.000 1 NFO(I,N)=NFO(I,N)+1 0097.000 IPAR=4*IMHKL(1)+2*IMHKL(2)+IMHKL(3)+1 0098.000 SFOP(IPAR)=SFOP(IPAR)+ABS(FO) 0099.000 NFOP(IPAR)=NFOP(IPAR)+1 0100.000 SGPWD(IPAR)=SGPWD(IPAR)+WDSQ 0101.000 SGDP(IPAR)=SGDP(IPAR)+DELTA 0102.000 IMHKL(4)=SMOD(IMHKL(1)+IMHKL(2)) 0103.000 IMHKL(5)=SMOD(IMHKL(1)+IMHKL(3)) 0104.000 IMHKL(6)=SMOD(IMHKL(2)+IMHKL(3)) 0105.000 IMHKL(7)=SMOD(IMHKL(1)+IMHKL(2)+IMHKL(3)) 0106.000 DO 5 I=1,7 0107.000 N=2*I+IMHKL(I) 0108.000 SGTWD(N)=SGTWD(N)+WDSQ 0109.000 SGDT(N)=SGDT(N)+DELTA 0110.000 SFOT(N)=SFOT(N)+ABS(FO) 0111.000 5 NFOT(N)=NFOT(N)+1 0112.000 SFOT(1)=SFOT(1)+ABS(FO) 0113.000 NFOT(1)=NFOT(1)+1 0114.000 SGTWD(1)=SGTWD(1)+WDSQ 0115.000 SGDT(1)=SGDT(1)+DELTA 0116.000 GO TO 122 0117.000 3 DO 6 I=1,6 0118.000 6 PKNT(I)=100.0*REAL(KNT(I))/REAL(NP) 0119.000 WRITE(LP,1005) 0120.000 WRITE(LP,1004)(KNT(I),PKNT(I),FLIM(I),FLIM(I+1),I=1,6) 0121.000 DO 7 I=1,3 0122.000 NN(I)=1 0123.000 DO 7 J=1,25 0124.000 IF(NFO(I,J))7,7,17 0125.000 17 NN(I)=J 0126.000 SIGD(I,J)=SIGD(I,J)/SFO(I,J) 0127.000 SIGWD(I,J)=SIGWD(I,J)/NFO(I,J) 0128.000 SFO(I,J)=SFO(I,J)/NFO(I,J) 0129.000 7 CONTINUE 0130.000 DO 8 I=1,8 0131.000 IF (NFOP(I).EQ.0) GO TO 8 0132.000 SGPWD(I)=SGPWD(I)/NFOP(I) 0133.000 SGDP(I)=SGDP(I)/SFOP(I) 0134.000 SFOP(I)=SFOP(I)/NFOP(I) 0135.000 8 CONTINUE 0136.000 DO 9 I=1,15 0137.000 IF (NFOT(I).EQ.0) GO TO 9 0138.000 SGTWD(I)=SGTWD(I)/NFOT(I) 0139.000 SGDT(I)=SGDT(I)/SFOT(I) 0140.000 SFOT(I)=SFOT(I)/NFOT(I) 0141.000 9 CONTINUE 0142.000 WRITE(LP,103) 0143.000 103 FORMAT('0ANALYSIS AS A FUNCTION OF H,K,L VALUES'//'0 H AV FO0144.000 1 R AV W D SQ N K AV FO R AV W D SQ N 0145.000 2 L AV FO R AV W D SQ N '//) 0146.000 DO 10 I=1,25 0147.000 J=I-1 0148.000 IF(I-NN(1))700,700,701 0149.000 700 WRITE(LP,104)J,SFO(1,I),SIGD(1,I),SIGWD(1,I),NFO(1,I) 0150.000 104 FORMAT(' ',I5,2X,F8.3,2X,F5.2,2X,F7.2,2X,I5) 0151.000 IF(I-NN(2))702,702,708 0152.000 702 WRITE(LP,105)J,SFO(2,I),SIGD(2,I),SIGWD(2,I),NFO(2,I) 0153.000 105 FORMAT('+',40X,I5,2X,F8.3,2X,F5.2,2X,F7.2,2X,I5) 0154.000 708 IF(I-NN(3))704,704,10 0155.000 704 WRITE(LP,106)J,SFO(3,I),SIGD(3,I),SIGWD(3,I),NFO(3,I) 0156.000 106 FORMAT('+',80X,I5,2X,F8.3,2X,F5.2,2X,F7.2,2X,I5) 0157.000 GO TO 10 0158.000 701 IF(I-NN(2))706,706,707 0159.000 706 WRITE(LP,107)J,SFO(2,I),SIGD(2,I),SIGWD(2,I),NFO(2,I) 0160.000 107 FORMAT(' ',40X,I5,2X,F8.3,2X,F5.2,2X,F7.2,2X,I5) 0161.000 GO TO 708 0162.000 707 IF(I-NN(3))709,709,10 0163.000 709 WRITE(LP,108)J,SFO(3,I),SIGD(3,I),SIGWD(3,I),NFO(3,I) 0164.000 108 FORMAT(' ',80X,I5,2X,F8.3,2X,F5.2,2X,F7.2,2X,I5) 0165.000 10 CONTINUE 0166.000 WRITE(LP,109)NFOT(1),SFOT(1),SGDT(1),SGTWD(1) 0167.000 109 FORMAT( '0FOR ALL',I6,' DATA, AV FO =',F11.3,' R =',F10.5, 0168.000 1 ' AV W D SQ =',F10.5/ '0PLANES WITH INDICE0169.000 2S GREATER THAN 24 ARE IN THE 24 GROUP') 0170.000 IPAV=NFOT(1)/8 0171.000 WRITE(LP,110) 0172.000 110 FORMAT('1PARITY ANALYSIS'//' EVEN AND ODD COMBINATIONS OF H,K,L'/'0173.000 10 AV FO R AV W D SQ N'/) 0174.000 DO 20 I=1,8 0175.000 20 WRITE(LP,111)HEDA(I),SFOP(I),SGDP(I),SGPWD(I),NFOP(I) 0176.000 111 FORMAT(' ',A4,F10.3,2F10.5,I10) 0177.000 WRITE(LP,114) IPAV 0178.000 114 FORMAT ('0AVERAGE NO. OF DATA IN EACH GROUP =',I6 0179.000 1 ///'0EVEN AND ODD SUMS OF H,K,L'//'0SUM 0180.000 2PARITY AV FO R AV W D SQ N '//) 0181.000 DO 21 I=2,15 0182.000 21 WRITE(LP,112)HEDB(1,I),HEDB(2,I),HEDC(I),SFOT(I),SGDT(I),SGTWD(I),0183.000 1NFOT(I) 0184.000 112 FORMAT(' ',3A4,F10.3,2F10.5,I10) 0185.000 CALL SORT(FKEEP,NP) 0186.000 NO=NP/10 0187.000 DO 404 I=1,10 0188.000 K=1+(I-1)*NO 0189.000 404 R(I)=FKEEP(K)*0.1 0190.000 R(11)=FKEEP(NP)*0.1 0191.000 C SIN THETA/LAMBDA RANGES 0192.000 STHLM=STHLM**3 0193.000 STHI=STHLM/10. 0194.000 DO 405 I=1,9 0195.000 405 STHE(I)=(STHI*I)**0.333333 0196.000 STHE(10)=(STHLM+0.001)**0.333333 0197.000 REWIND LIN 0198.000 412 READ(LIN,END=407) IW1,IW2,FO,SIG,A,B,STHOL 0199.000 FO=SQRT(FO) 0200.000 SIG=0.5*SIG/FO 0201.000 FC=SQRT(A*A+B*B) 0202.000 STHOL=SQRT(STHOL) 0203.000 DO 408 I=2,11 0204.000 IF(R(I)-FO)408,409,409 0205.000 408 CONTINUE 0206.000 I=11 0207.000 409 I=I-1 0208.000 NOFOB(I)=NOFOB(I)+1 0209.000 DELTA=ABS(FO-FC) 0210.000 WDSQ=(DELTA/(SIG*S))**2 0211.000 SWDFO(I)=SWDFO(I)+WDSQ 0212.000 SDEL(I)=SDEL(I)+DELTA 0213.000 SFOBS(I)=SFOBS(I)+FO 0214.000 DO 410 I=1,10 0215.000 IF(STHOL-STHE(I))411,410,410 0216.000 410 CONTINUE 0217.000 I=10 0218.000 411 NSTH(I)=NSTH(I)+1 0219.000 SWDTH(I)=SWDTH(I)+WDSQ 0220.000 SDLTH(I)=SDLTH(I)+DELTA 0221.000 SF(I)=SF(I)+FO 0222.000 GO TO 412 0223.000 407 DO 420 I=1,10 0224.000 IF (NOFOB(I).EQ.0) GO TO 413 0225.000 SWDFO(I)=SWDFO(I)/NOFOB(I) 0226.000 SDEL(I)=SDEL(I)/SFOBS(I) 0227.000 SFOBS(I)=SFOBS(I)/NOFOB(I) 0228.000 413 IF (NSTH(I).EQ.0) GO TO 420 0229.000 SWDTH(I)=SWDTH(I)/NSTH(I) 0230.000 SDLTH(I)=SDLTH(I)/SF(I) 0231.000 SF(I)=SF(I)/NSTH(I) 0232.000 420 CONTINUE 0233.000 WRITE(LP,414) 0234.000 414 FORMAT('1ANALYSIS AS A FUNCTION OF FOBS'/'0',9X,'RANGE',16X,'AV FO0235.000 1',13X,'R', 9X,'AV W D SQ N '//) 0236.000 DO 415 I=1,10 0237.000 J=I+1 0238.000 415 WRITE(LP,416)R(I),R(J),SFOBS(I),SDEL(I),SWDFO(I),NOFOB(I) 0239.000 416 FORMAT('0',F10.1,' -',F7.1, F15.3,2F15.5,I10) 0240.000 WRITE(LP,417) 0241.000 417 FORMAT('1ANALYSIS AS A FUNCTION OF SIN THETA/LAMBDA'/'0',12X,'S/L 0242.000 1UP TO AV FO',13X,'R', 9X,'AV W D SQ N '//) 0243.000 DO 418 I=1,10 0244.000 418 WRITE(LP,419)STHE(I),SF(I),SDLTH(I),SWDTH(I),NSTH(I) 0245.000 419 FORMAT('0',10X,F10.4,F15.3,2F15.5,I10) 0246.000 WRITE(LP,115)HEDC(1),SFOT(1),NFOT(1) 0247.000 115 FORMAT ('0',16X,A4,F15.3,30X,I10//'0WTANAL COMPLETED') 0248.000 STOP 0249.000 END 0250.000 SUBROUTINE SORT(IX,N) 0251.000 C**** SORTS IX 0252.000 DIMENSION IX(N) 0253.000 INT=2 0254.000 10 INT=2*INT 0255.000 IF(INT.LT.N) GO TO 10 0256.000 INT=MIN0(N,(3*INT)/4-1) 0257.000 20 INT=INT/2 0258.000 IFIN=N-INT 0259.000 DO 70 II=1,IFIN 0260.000 I=II 0261.000 J=I+INT 0262.000 IF(IX(I).LE.IX(J)) GO TO 70 0263.000 L=IX(J) 0264.000 40 IX(J)=IX(I) 0265.000 J=I 0266.000 I=I-INT 0267.000 IF(I.LE.0) GO TO 60 0268.000 IF(IX(I).GT.L) GO TO 40 0269.000 60 IX(J)=L 0270.000 70 CONTINUE 0271.000 IF(INT.GT.1) GO TO 20 0272.000 RETURN 0273.000 END 0274.000 FUNCTION SMOD(I) 0275.000 SMOD=IABS(I)-2*(IABS(I)/2) 0276.000 RETURN 0277.000 END 0278.000