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
