C        COPYRIGHT 1985 UNIVERSITY OF GLASGOW                           0001.000
C        TABULATION OF FINAL STRUCTURE FACTORS  PROGRAM FTAB AUG 85     0002.000
C        GX PACKAGE  APRIL 1985   PAUL R. MALLINSON                     0003.000
C                                                                       0004.000
      CHARACTER C(7200),HEAD(3),LINE(110),IBLNK(20),REPLY(148)          0005.000
         CHARACTER*8 TAG                                                0006.000
         CHARACTER*14 FCHEAD,LASTHD                                     0007.000
      INTEGER H(3),   FIRSTCH(20),FWIDTH(20)                            0008.000
      DIMENSION TITLE(15),FPIP(4)                                       0009.000
C     STATEMENT FUNCTION                                                0010.000
      LOC(I,J,K)=((J-1)*NL+I-1)*20+K                                    0011.000
      DATA HEAD,IBLNK/'H','K','L',20*' '/,REPLY/148*' '/                0012.000
         DATA JIND/3/,                                   LASTHD/' '/    0013.000
 1    FORMAT (1H0,I11,' OBSERVATIONS READ')                             0014.000
 11   FORMAT     (5X,A1,2(',',I3),6X)                                   0015.000
 12   FORMAT     (3X,I3,',',2X,A1,',',I3,6X)                            0016.000
 13   FORMAT     (3X,2(I3,','),2X,A1,6X)                                0017.000
 22   FORMAT ('1'/////6X,                                               0018.000
     1     'OBSERVED AND FINAL CALCULATED STRUCTURE FACTORS'/'0',5X,    0019.000
     215A4/'0',I6,' LIST COLUMNS ACROSS PAGE'/'0',I8,' LINES PER PAGE') 0020.000
23    FORMAT (1H ,110A1)                                                0021.000
26    FORMAT     ('1'/' ',15A4,3X,'PAGE',I3/)                           0022.000
 28   FORMAT ('1FTAB COMPLETED')                                        0023.000
29    FORMAT (15A4)                                                     0024.000
30    FORMAT (20X)                                                      0025.000
 31      FORMAT (4I5)                                                   0026.000
37    FORMAT (2I5,I6,4X)                                                0027.000
51    FORMAT ('0',5X,'COPY NUMBER',I2/'0',5X,'COLUMNS ARE  ',           0028.000
     1A1,',  ABS(FO) X',I4,A13,'X',I4,A14,I4)                           0029.000
 997  FORMAT (20A1)                                                     0030.000
         WRITE (6,600)                                                  0031.000
 600     FORMAT(' TYPE CAPTION FOR TOP OF EACH PAGE:')                  0032.000
      READ (2,29) TITLE                                                 0033.000
C     JIND=1,2 OR 3 FOR H,K OR L VARIES MOST RAPIDLY.                   0034.000
C     M=NO. OF COLUMNS, NL=NO. OF LINES PER PAGE.                       0035.000
C     ICENT= 1/2/3/4/5 FOR NON-CENTROSYMMETRIC (PRINT ABS(FC) WITHOUT   0036.000
C     PHASE OR SIGFO)/CENTROSYMMETRIC (FC WITH SIGN)/NON-CENTROSYMMETRIC0037.000
C     (ABS(FC) WITH PHASE)/CENTROSYMMETRIC (FC WITH SIGN AND SIGFO)/NON-0038.000
C     CENTROSYMMETRIC (ABS(FC) WITH SIGFO)                              0039.000
C     NCOPS=NO. OF COPIES OF LIST REQUIRED.                             0040.000
 507     WRITE (6,508)                                                  0041.000
 508     FORMAT(' HOW ARE THE REFLECTION DATA SORTED - RUNNING INDEX H, 0042.000
     1K, OR L? (DEFAULT L)')                                            0043.000
         READ (2,601,END=502) (REPLY(I),I=2,73)                         0044.000
 601     FORMAT(72A1)                                                   0045.000
         CALL PARSE(REPLY,NFIELD,FIRSTCH,FWIDTH)                        0046.000
         IF (NFIELD.EQ.0) GO TO 603                                     0047.000
         CALL AFORMT(REPLY,FIRSTCH(1),FWIDTH(1),TAG)                    0048.000
         IF (TAG.NE.'H') GO TO 504                                      0049.000
         JIND=1                                                         0050.000
         GO TO 603                                                      0051.000
 504     IF (TAG.NE.'K') GO TO 506                                      0052.000
         JIND=2                                                         0053.000
         GO TO 603                                                      0054.000
 506     IF (TAG.NE.'L') GO TO 507                                      0055.000
         JIND=3                                                         0056.000
 603         WRITE (6,505)                                              0057.000
 505     FORMAT (' HOW MANY COLUMNS? (DEFAULT 6)')                      0058.000
         M=6                                                            0059.000
         READ (2,601,END=502) (REPLY(I),I=2,73)                         0060.000
         CALL PARSE(REPLY,NFIELD,FIRSTCH,FWIDTH)                        0061.000
         IF (NFIELD.EQ.0) GO TO 608                                     0062.000
         CALL IFORMT(REPLY,FIRSTCH(1),FWIDTH(1),M)                      0063.000
 608     WRITE (6,509)                                                  0064.000
 509     FORMAT (' HOW MANY LINES PER PAGE? (DEFAULT 38)')              0065.000
         NL=38                                                          0066.000
         READ (2,601,END=502) (REPLY(I),I=2,73)                         0067.000
         CALL PARSE(REPLY,NFIELD,FIRSTCH,FWIDTH)                        0068.000
         IF (NFIELD.EQ.0) GO TO 510                                     0069.000
         CALL IFORMT(REPLY,FIRSTCH(1),FWIDTH(1),NL)                     0070.000
 510     WRITE (6,511)                                                  0071.000
 511     FORMAT (' TYPE MULTIPLIER FOR FO AND FC (DEFAULT 10):')        0072.000
         ISCAL=10                                                       0073.000
         READ (2,601,END=502) (REPLY(I),I=2,73)                         0074.000
         CALL PARSE(REPLY,NFIELD,FIRSTCH,FWIDTH)                        0075.000
         IF (NFIELD.GT.0) CALL IFORMT(REPLY,FIRSTCH(1),FWIDTH(1),ISCAL) 0076.000
         SCALE=ISCAL                                                    0077.000
         WRITE (6,513)                                                  0078.000
 513     FORMAT (' TYPE LISTING OPTION NUMBER (DEFAULT 1). OPTIONS:'/   0079.000
     1   ' 1 - INDEX, ABS(FO), ABS(FC)'/                                0080.000
     2   ' 2 - INDEX, ABS(FO), FC WITH SIGN'/                           0081.000
     3   ' 3 - INDEX, ABS(FO), ABS(FC), PHASE ANGLE IN DEGREES'/        0082.000
     4   ' 4 - INDEX, ABS(FO), FC WITH SIGN, SIGMA(FO)'/                0083.000
     5   ' 5 - INDEX, ABS(FO), ABS(FC), SIGMA(FO):')                    0084.000
         ICENT=1                                                        0085.000
         READ (2,601,END=502) (REPLY(I),I=2,73)                         0086.000
         CALL PARSE(REPLY,NFIELD,FIRSTCH,FWIDTH)                        0087.000
         IF (NFIELD.EQ.0) GO TO 514                                     0088.000
         CALL IFORMT(REPLY,FIRSTCH(1),FWIDTH(1),ICENT)                  0089.000
 514     WRITE (6,515)                                                  0090.000
 515     FORMAT (' HOW MANY COPIES ARE REQUIRED? (DEFAULT 1)')          0091.000
         NCOPS=1                                                        0092.000
         READ (2,601,END=502) (REPLY(I),I=2,73)                         0093.000
         CALL PARSE(REPLY,NFIELD,FIRSTCH,FWIDTH)                        0094.000
         IF (NFIELD.GT.0)                                               0095.000
     1   CALL IFORMT(REPLY,FIRSTCH(1),FWIDTH(1),NCOPS)                  0096.000
 502  IF (ICENT-2) 41,41,108                                            0097.000
 41   NK=18                                                             0098.000
      NSPCE=0                                                           0099.000
      IF (M.GT.6) M=6                                                   0100.000
      GO TO 3215                                                        0101.000
 108  NK=20                                                             0102.000
      NSPCE=2                                                           0103.000
      IF (M.GT.5) M=5                                                   0104.000
 3215 NLM20=NL*M*20                                                     0105.000
      IF (NLM20-7200) 6519,6519,6520                                    0106.000
 6520  WRITE (6,6521)                                                   0107.000
 6521 FORMAT ('0NO. OF LINES TIMES NO. OF COLUMNS TOO LARGE (MAX 360)') 0108.000
      GO TO 603                                                         0109.000
 6519 GO TO (110,14,15),JIND                                            0110.000
110   K=2                                                               0111.000
      L=3                                                               0112.000
      GO TO 16                                                          0113.000
14    K=1                                                               0114.000
      L=3                                                               0115.000
      GO TO 16                                                          0116.000
15    K=1                                                               0117.000
      L=2                                                               0118.000
16    PI=180./3.141593                                                  0119.000
      ICOPS=0                                                           0120.000
      IPC=0                                                             0121.000
      LC=0                                                              0122.000
 530  READ (17) IW1,IW2,FO,SIG,FPIP(1),FPIP(4)                          0123.000
         FO=SQRT(FO)                                                    0124.000
         SIG=0.5*SIG/FO                                                 0125.000
         FPIP(2)=SQRT(FPIP(1)*FPIP(1)+FPIP(4)*FPIP(4))                  0126.000
         IND=MOD(IW1,16777216)                                          0127.000
         H(1)=(IND/65536)-128                                           0128.000
         IND=MOD(IND,65536)                                             0129.000
         H(2)=(IND/256)-128                                             0130.000
         IND=MOD(IND,256)                                               0131.000
         H(3)=IND-128                                                   0132.000
C     PUT HEADING AT TOP OF FIRST BLOCK                                 0133.000
      GO TO 4                                                           0134.000
  9   READ (17,END=17 ) IW1,IW2,FO,SIG,FPIP(1),FPIP(4)                  0135.000
         FO=SQRT(FO)                                                    0136.000
         SIG=0.5*SIG/FO                                                 0137.000
         FPIP(2)=SQRT(FPIP(1)*FPIP(1)+FPIP(4)*FPIP(4))                  0138.000
         IND=MOD(IW1,16777216)                                          0139.000
         H(1)=(IND/65536)-128                                           0140.000
         IND=MOD(IND,65536)                                             0141.000
         H(2)=(IND/256)-128                                             0142.000
         IND=MOD(IND,256)                                               0143.000
         H(3)=IND-128                                                   0144.000
C     PUT IN NEW HEADING IF EITHER OF LESS RAPIDLY VARYING INDICES      0145.000
C     CHANGES.                                                          0146.000
111   IF (H(K)-I1) 4,101,4                                              0147.000
101   IF (H(L)-I2) 4,100,4                                              0148.000
C     PUT IN EXTRA HEADING IF END OF PAGE OCCURS WITHIN A BLOCK         0149.000
100   NP=LC/(M*NL)                                                      0150.000
      IF (M*NL*NP-LC) 6,20,6                                            0151.000
6     IFO=NINT(FO*SCALE)                                                0152.000
      IFC=NINT(FPIP(2)*SCALE)                                           0153.000
      IPC=IPC+1                                                         0154.000
      LC=LC+1                                                           0155.000
      GO TO (81,40,102,40,80),ICENT                                     0156.000
C     CALC PHASE ANGLE IN RANGE 0 TO 360 DEGREES                        0157.000
 102  PHI=ATAN2(FPIP(4),FPIP(1))                                        0158.000
      IPHI=NINT(PHI*PI)                                                 0159.000
      IF (IPHI) 112,3,3                                                 0160.000
 112  IPHI=IPHI+360                                                     0161.000
 3    WRITE(18,31) H(JIND),IFO,IFC,IPHI                                 0162.000
      GO TO 9                                                           0163.000
 40   IF (FPIP(1)) 104,105,105                                          0164.000
104   IFC=-IFC                                                          0165.000
 105  IF (ICENT-2) 81,81,80                                             0166.000
80    ISIG= INT(SIG*SCALE)+1                                            0167.000
      WRITE(18,31) H(JIND),IFO,IFC,ISIG                                 0168.000
      GO TO 9                                                           0169.000
81    WRITE(18,37) H(JIND),IFO,IFC                                      0170.000
      GO TO 9                                                           0171.000
C     FILL UP COLUMN WITH BLANKS IF END OF BLOCK OCCURS LESS THAN       0172.000
C     4 LINES FROM BOTTOM.                                              0173.000
4     NC=LC/NL+1                                                        0174.000
      NBLKS=NL*NC-LC                                                    0175.000
      IF (NBLKS-3) 200,200,20                                           0176.000
200   DO 21 N=1,NBLKS                                                   0177.000
21    WRITE (18,30)                                                     0178.000
 701  LC=LC+NBLKS                                                       0179.000
C     WRITE APPROPRIATE BLOCK HEADING AND STORE NEW VALUES OF           0180.000
C     CONSTANT INDICES.                                                 0181.000
20    GO TO (113,8,10),JIND                                             0182.000
113   WRITE(18,11) HEAD(JIND),H(2),H(3)                                 0183.000
      GO TO 5                                                           0184.000
8     WRITE(18,12) H(1),HEAD(JIND),H(3)                                 0185.000
      GO TO 5                                                           0186.000
10    WRITE(18,13) H(1),H(2),HEAD(JIND)                                 0187.000
5     I1=H(K)                                                           0188.000
      I2=H(L)                                                           0189.000
      LC=LC+1                                                           0190.000
C     PROCEED WITH NEW BLOCK                                            0191.000
      GO TO 6                                                           0192.000
C     FILL UP PAGE WITH BLANKS IF NECESSARY WHEN ALL DATA HAS BEEN READ.0193.000
17    NP=LC/(M*NL)+1                                                    0194.000
      NBLKS=M*NL*NP-LC                                                  0195.000
      IF (NBLKS-M*NL) 106,35,106                                        0196.000
106   DO 18 N=1,NBLKS                                                   0197.000
18    WRITE (18,30)                                                     0198.000
702   GO TO 34                                                          0199.000
35    NP=NP-1                                                           0200.000
 34   WRITE (3,22) TITLE,M,NL                                           0201.000
      WRITE (3,1) IPC                                                   0202.000
      ICOPS=ICOPS+1                                                     0203.000
      IF (MOD(ICENT,2)) 107,42,107                                      0204.000
107   FCHEAD=',  ABS(FC)'                                               0205.000
      GO TO 50                                                          0206.000
42    FCHEAD=',  SIGNED FC'                                             0207.000
 50   IF (ICENT-3) 520,523,521                                          0208.000
 521  LASTHD=',  SIGMA(FO) X'                                           0209.000
      WRITE (3,51) ICOPS,HEAD(JIND),ISCAL,FCHEAD,ISCAL,LASTHD,ISCAL     0210.000
      GO TO 540                                                         0211.000
 523  LASTHD=',  PHASE ANGLE'                                           0212.000
 520  WRITE (3,51) ICOPS,HEAD(JIND),ISCAL,FCHEAD,ISCAL,LASTHD           0213.000
 540  REWIND 18                                                         0214.000
      NPC=0                                                             0215.000
 25    NPC=NPC+1                                                        0216.000
      WRITE (3,26) TITLE,NPC                                            0217.000
C     READ SCRATCH TAPE ONE PAGE AT A TIME AND PRINT IT IN ROW ORDER.   0218.000
      READ (18,997)     (C(I),I=1,NLM20)                                0219.000
 703  DO 24 I=1,NL                                                      0220.000
      DO 503 J=1,110                                                    0221.000
 503  LINE(J)=IBLNK(1)                                                  0222.000
      N1=NSPCE                                                          0223.000
      DO 500 J=1,M                                                      0224.000
      DO 501 K=1,NK                                                     0225.000
      N=LOC(I,J,K)                                                      0226.000
      N1=N1+1                                                           0227.000
 501  LINE(N1)=C(N)                                                     0228.000
 500  N1=N1+NSPCE                                                       0229.000
 24   WRITE (3,23) LINE                                                 0230.000
C     TEST NO. OF PAGES TO DETECT END OF TAPE.                          0231.000
      IF (NPC-NP) 25,115,25                                             0232.000
 115  IF (ICOPS-NCOPS) 34,27,27                                         0233.000
27    WRITE (3,28)                                                      0234.000
      STOP                                                              0235.000
      END                                                               0236.000
