      SUBROUTINE CCHART                                                 CHRT0100
C                                                                       CHRT0110
C     PROGRAM TO SIMULATE A DIFFRACTOMETER CHART                        CHRT0120
C     *** DISTRIBUTION VERSION ***                                              
C                                                                       CHRT0130
      INTEGER*2 IH,IK,IL                                                CHRT0140
      LOGICAL*1 ITITLE,IDAY                                             CHRT0150
      COMMON /GENL/WL1,WL2,DMIN,XMUR,XMAX,XMU,A(19),SC(5),ITIME,NIN,NOUTCHRT0160
     1,NPUNCH,NSCRT1,NFILE,IA,NABS,NSG,IXYZ,ITRANS,NTRANS(3,3),ISCALE           
     2,NPLOT,NREFL,                                                             
     3          NAS,NWL,ISH,ISK,ISL,IOUT,LENT,LENX,ITITLE(320),IDAY(8)          
      COMMON /DATA/D(1001),IH(1001),IK(1001),IL(1001)                   CHRT0190
      COMMON /CAL/XINT1(1000),XINT3(1000),TTH1(1000)                    CHRT0200
      COMMON /XPLOT/W,TTHETA,SCMAX                                      CHRT0210
      COMMON /DENSTY/ DENS,DENSC                                                
      COMMON /IICOR/ XINTR                                                      
      DIMENSION XINT2(1000),TTH2(1000)                                  CHRT0220
      DIMENSION Y(8001)                                                 CHRT0230
      DIMENSION TABLE1(15),TABLE2(15),TABLE(15),XANGLE(15)              CHRT0240
      DIMENSION TABLE3(15)                                                      
C                                                                       CHRT0250
C     INITIALIZE VARIABLES                                              CHRT0260
C                                                                       CHRT0270
      PI=3.141593                                                       CHRT0280
      RAD=114.5916                                                      CHRT0290
      ZERO=0.0                                                          CHRT0300
C                                                                       CHRT0310
      DATA TABLE1/0.060,0.066,0.075,0.089,0.108,0.130,0.160,0.175,0.205,CHRT0320
     10.225,0.250,0.295,0.360,0.410,0.500/                              CHRT0330
C                                                                       CHRT0340
      DATA TABLE2/0.070,0.075,0.088,0.105,0.130,0.185,0.260,0.315,0.390,CHRT0350
     10.450,0.535,0.750,1.200,1.500,2.000/                              CHRT0360
C                                                                       CHRT0370
C     NBS MEASURED FWHM TABLE                                                   
      DATA TABLE3/0.12,0.12,0.12,0.125,0.13,0.135,0.155,0.185,0.23,             
     1           0.255,0.285,0.315,0.36,0.41,0.5/                               
C                                                                               
      DATA XANGLE/0.0,20.0,40.0,60.0,80.0,100.0,120.0,130.0,140.0,145.0,CHRT0380
     1150.0,155.0,160.0,162.5,165.0/                                    CHRT0390
C                                                                       CHRT0400
C     READ CCHART CARD                                                  CHRT0410
C                                                                       CHRT0420
      READ (NIN,100) W,TTHETA,SCMAX,NSC1,NTYPE,NCURVE,NSUPP,NLIST,NPR,NCCHRT0430
     1C,SCA,SCB,SCC,SCD,SCE,SCMAX2,NSC2                                 CHRT0440
      WRITE (NOUT,100) W,TTHETA,SCMAX,NSC1,NTYPE,NCURVE,NSUPP,NLIST,NPR,CHRT0450
     1NCC,SCA,SCB,SCC,SCD,SCE,SCMAX2,NSC2                               CHRT0460
  100 FORMAT (3F6.2,7I2,3X,5F5.4,F6.2,I2)                               CHRT0470
      IF (NPR.LE.0) NPR=2                                               CHRT0480
      IF (NCURVE.EQ.0) GO TO 120                                        CHRT0490
      AMULT=3.0                                                         CHRT0500
      WRITE (NOUT,110)                                                  CHRT0510
  110 FORMAT (32H0GAUSSIAN CURVE WILL BE COMPUTED)                      CHRT0520
      GO TO 140                                                         CHRT0530
  120 AMULT=25.0                                                        CHRT0540
      WRITE (NOUT,130)                                                  CHRT0550
  130 FORMAT (30H0CAUCHY CURVE WILL BE COMPUTED)                        CHRT0560
  140 IF (NTYPE) 150,200,160                                            CHRT0570
  150 NTYPE=NPUNCH                                                      CHRT0580
      GO TO 180                                                         CHRT0590
  160 IF(NTYPE-6) 170,170,200                                                   
  170 NTYPE=NOUT                                                        CHRT0610
  180 IF (SCA.LE.0.0) SCA=0.1                                           CHRT0620
      IF (NLIST.LE.0) NLIST=1                                           CHRT0630
  200 IF (NTYPE.GT.2) WRITE (NOUT,210) NTYPE,SCB,SCA,SCB,SCD,SCC,SCD,SCECHRT0670
  210 FORMAT (//53H PRINTABLE SUMMARY TABLE WILL BE LISTED ON TAPE UNIT CHRT0680
     1I2/40H REFLECTIONS OMITTED FOR D GREATER THAN F6.4,35H IF INTEGRATCHRT0690
     2ED INTENSITY LESS THAN F6.1/35H REFLECTIONS OMITTED FOR D BETWEEN CHRT0700
     3F6.4,5H AND F6.4,35H IF INTEGRATED INTENSITY LESS THAN F6.1/37H RECHRT0710
     4FLECTIONS OMITTED FOR D LESS THAN F6.4,35H IF INTEGRATED INTENSITYCHRT0720
     5 LESS THAN F6.1)                                                  CHRT0730
C     IF W=0.0 USE NBS MEASURED FWHM TABLE                                      
      IF (W .GT. 0.01) GO TO 212                                                
      W = 0.12                                                                  
      TTHETA = 40.0                                                             
      DO 723 I=1,15                                                             
723   TABLE(I) = TABLE3(I)                                                      
      GO TO 249                                                                 
212   DO 220  I=1,15                                                    CHRT0740
      IF (XANGLE(I).LT.TTHETA) GO TO 220                                CHRT0750
      ITEMP=I-1                                                         CHRT0760
      XPART=TTHETA-XANGLE(ITEMP)                                        CHRT0770
      YPART=XANGLE(I)-XANGLE(ITEMP)                                     CHRT0780
      FRAC=XPART/YPART                                                  CHRT0790
      HWU=(FRAC*(TABLE2(I)-TABLE2(ITEMP)))+TABLE2(ITEMP)                CHRT0800
      HWL=(FRAC*(TABLE1(I)-TABLE1(ITEMP)))+TABLE1(ITEMP)                CHRT0810
      DIF=(W-HWL)/(HWU-HWL)                                             CHRT0820
      GO TO 230                                                         CHRT0830
  220 CONTINUE                                                          CHRT0840
  230 DO 240  J=1,15                                                    CHRT0850
  240 TABLE(J)=TABLE1(J)+DIF*(TABLE2(J)-TABLE1(J))                      CHRT0860
  249 WRITE (NOUT,250) W,TTHETA,WL1,WL2                                         
  250 FORMAT (/20H   THE HALF-WIDTH ISF5.2,25H AT THE DIFFRACTION ANGLEFCHRT0880
     16.2,9H (2THETA)/31H   THE ALPHA ONE WAVE LENGTH ISF8.5/31H   THE ACHRT0890
     2LPHA TWO WAVE LENGTH ISF8.5)                                      CHRT0900
      WRITE (NOUT,251) (XANGLE(J),J=1,15),(TABLE(K),K=1,15)                     
251   FORMAT ('0ANGLE=',4X,15F6.1/' FWHM=',5X,15F6.3)                           
      FRAC=WL2/WL1                                                      CHRT0910
C                                                                       CHRT0920
C     READ CCHART DATA INPUT FOR INTERRUPTED PLOT                       CHRT0930
C                                                                       CHRT0940
      IF (NPLOT.GT.0) GO TO 300                                         CHRT0950
      NREFL=NSG                                                         CHRT0960
      IF (NPLOT.EQ.-2) GO TO 280                                        CHRT0970
      NPLOT=IABS(NPLOT)                                                 CHRT0980
      DO 270  N=1,NREFL                                                 CHRT0990
      READ (NPLOT) TTH1(N),D(N),IH(N),IK(N),IL(N),XINT1(N),XINT3(N),XINTCHRT1000
     15                                                                 CHRT1010
      WRITE (NOUT,260) TTH1(N),D(N),IH(N),IK(N),IL(N),XINT1(N),XINT3(N),CHRT1020
     1XINT5                                                             CHRT1030
  260 FORMAT (2F10.5,1X,3I3,3F10.5)                                     CHRT1040
  270 CONTINUE                                                          CHRT1050
      GO TO 300                                                         CHRT1060
  280 DO 290  N=1,NREFL                                                 CHRT1070
      READ (NIN,260) TTH1(N),D(N),IH(N),IK(N),IL(N),XINT1(N),XINT3(N),XICHRT1080
     1NT5                                                               CHRT1090
      WRITE (NOUT,260) TTH1(N),D(N),IH(N),IK(N),IL(N),XINT1(N),XINT3(N),CHRT1100
     1XINT5                                                             CHRT1110
  290 CONTINUE                                                          CHRT1120
  300 DO 310  I=1,8001                                                  CHRT1130
  310 Y(I)=0.0                                                          CHRT1140
      K=2                                                               CHRT1150
      M=1                                                               CHRT1160
      IREFL=NREFL                                                       CHRT1170
      DO 440  II=1,NREFL                                                CHRT1180
      IF (TTH1(II).GE.5.0) GO TO 320                                    CHRT1190
      M=II+1                                                            CHRT1200
      TTH2(II)=TTH1(II)                                                 CHRT1210
      XINT2(II)=0.0                                                     CHRT1220
  320 IF (TTH1(II).LE.165.0) GO TO 330                                  CHRT1230
      IREFL=II-1                                                        CHRT1240
      GO TO 450                                                         CHRT1250
  330 XINT2(II)=0.5*XINT1(II)                                           CHRT1260
      X=FRAC*SIN(TTH1(II)/RAD)                                          CHRT1270
      TTH2(II)=0.0                                                      CHRT1280
      IF (X.LT.1.0) TTH2(II)=RAD*ATAN(X/SQRT(1.0-X**2))                 CHRT1290
C     CHECK FOR REFLECTION     RANGE FOR HALF WIDTH DETERMINATION       CHRT1300
  340 IF (XANGLE(K).GE.TTH1(II)) GO TO 350                              CHRT1310
      K=K+1                                                             CHRT1320
      GO TO 340                                                         CHRT1330
  350 KTEMP=K-1                                                         CHRT1340
      XPART=TTH1(II)-XANGLE(KTEMP)                                      CHRT1350
      YPART=XANGLE(K)-XANGLE(KTEMP)                                     CHRT1360
      WREFL=(XPART/YPART)*(TABLE(K)-TABLE(KTEMP))+TABLE(KTEMP)          CHRT1370
      WSQ=WREFL*WREFL                                                   CHRT1380
      IF (NCURVE.NE.0) GO TO 360                                        CHRT1390
      ZREFL=2.0*XINT1(II)*WREFL/PI                                      CHRT1400
      GO TO 370                                                         CHRT1410
  360 ZREFL=XINT1(II)/WREFL                                             CHRT1420
C     SET RANGE OF Y CALCULATION DEPENDING ON HALF WIDTH                CHRT1430
  370 ISTART=(TTH1(II)-WREFL*AMULT)*50.0-249.0                          CHRT1440
      INT=WREFL*AMULT*100.0                                             CHRT1450
      ISTOP=ISTART+INT                                                  CHRT1460
C                                                                       CHRT1470
C     CHECK LIMITS OF CALCULATION RANGE                                 CHRT1480
C                                                                       CHRT1490
      IF (ISTART.LE.0) ISTART=1                                         CHRT1500
      IF (ISTOP.GT.8001) ISTOP=8001                                     CHRT1510
C     CALCULATE PROFILE FOR A REFLECTION                                CHRT1520
      DO 390  J=ISTART,ISTOP                                            CHRT1530
      X=J                                                               CHRT1540
      DEL = TTH1(II)-((X+249.0)/50.0)                                           
      DELSQ = DEL*DEL                                                           
      IF (NCURVE.NE.0) GO TO 380                                        CHRT1560
C     CAUCHY PROFILE FOR A REFLECTION                                   CHRT1570
      Y(J)=Y(J)+(ZREFL/(WSQ+4.0*DELSQ))                                 CHRT1580
      GO TO 390                                                         CHRT1590
C     GAUSSIAN PROFILE FOR A REFLECTION                                 CHRT1600
  380 Y(J)=Y(J)+ZREFL*EXP(-PI*DELSQ/WSQ)                                CHRT1610
  390 CONTINUE                                                          CHRT1620
C                                                                       CHRT1630
C     REPEAT PROFILE FOR ALPHA2                                         CHRT1640
      IF (WL2.EQ.0) GO TO 440                                           CHRT1650
      ZPART=TTH2(II)-XANGLE(KTEMP)                                      CHRT1660
      XREFL=(ZPART/YPART)*(TABLE(K)-TABLE(KTEMP))+TABLE(KTEMP)          CHRT1670
      XSQ=XREFL*XREFL                                                   CHRT1680
      IF (NCURVE.NE.0) GO TO 400                                        CHRT1690
      YREFL=2.0*XINT2(II)*XREFL/PI                                      CHRT1700
      GO TO 410                                                         CHRT1710
  400 YREFL=XINT2(II)/XREFL                                             CHRT1720
  410 KSTART=(TTH2(II)-XREFL*AMULT)*50.0-249.0                          CHRT1730
      KSTOP=KSTART+INT                                                  CHRT1740
      IF (KSTART.LE.0) KSTART=1                                         CHRT1750
      IF (KSTOP.GT.8001) KSTOP=8001                                     CHRT1760
      DO 430  J=KSTART,KSTOP                                            CHRT1770
      X=J                                                               CHRT1780
      DEL = TTH2(II)-((X+249.0)/50.0)                                           
      DELSQ = DEL*DEL                                                           
      IF (TTH2(II).LE.0) GO TO 440                                      CHRT1800
      IF (NCURVE.NE.0) GO TO 420                                        CHRT1810
      Y(J)=Y(J)+(YREFL/(XSQ+4.0*DELSQ))                                 CHRT1820
      GO TO 430                                                         CHRT1830
  420 Y(J)=Y(J)+YREFL*EXP(-PI*DELSQ/XSQ)                                CHRT1840
  430 CONTINUE                                                          CHRT1850
  440 CONTINUE                                                          CHRT1860
C                                                                       CHRT1870
C     SCALE THE CALCULATED PATTERN                                      CHRT1880
C                                                                       CHRT1890
  450 X=Y(1)                                                            CHRT1900
      DO 460  J=2,8001                                                  CHRT1910
      IF (X.LE.Y(J)) X=Y(J)                                             CHRT1920
  460 CONTINUE                                                          CHRT1930
      IF (SCMAX.EQ.0.0) SCMAX=100.2                                     CHRT1940
  470 ZSCALE=AMOD(SCMAX,1.0)                                            CHRT1950
      SCMAX=SCMAX-ZSCALE                                                CHRT1960
      NSCALE=10.0*(ZSCALE+0.02)                                         CHRT1970
      IF (NSCALE.EQ.0) NSCALE=2                                         CHRT1980
      LENGTH=40*2**(NSCALE-1)                                           CHRT1990
      XSCAL=1.0                                                         CHRT2000
      IF (TTH1(IREFL).GT.164.0) GO TO 480                               CHRT2010
      XSCAL=(TTH1(IREFL)-5.0)/160.0                                     CHRT2020
      LENGTH=FLOAT(LENGTH)*XSCAL+1.0                                    CHRT2030
  480 NPLT=8000.0*XSCAL                                                 CHRT2040
      XSCAL=LENGTH                                                      CHRT2050
      WRITE (NOUT,490) ZSCALE,SCMAX,NSCALE,LENGTH,XSCAL                 CHRT2060
  490 FORMAT (1H1,11H  ZSCALE = F7.1/7H  SC = F7.1/11H  NSCALE = I2/11H CHRT2070
     1 LENGTH = I6/11H  XSCALE = F7.1)                                  CHRT2080
      SCALE=SCMAX/X                                                     CHRT2090
      DO 500  J=1,8001                                                  CHRT2100
  500 Y(J)=Y(J)*SCALE                                                   CHRT2110
      IF (SCMAX.EQ.SCMAX2) GO TO 660                                    CHRT2120
      DO 580  II=M,IREFL                                                CHRT2130
      IF (TTH1(II).LE.165.0) GO TO 520                                  CHRT2140
  510 TTH2(II)=0.0                                                      CHRT2150
      GO TO 580                                                         CHRT2160
  520 NANG=((TTH1(II)-5.0)/0.02)+1.0                                    CHRT2170
      IF (Y(NANG)-Y(NANG-1)) 550,570,530                                CHRT2180
  530 IF (NANG-8001) 540,570,510                                        CHRT2190
  540 IF (Y(NANG+1).LE.Y(NANG)) GO TO 570                               CHRT2200
      NANG=NANG+1                                                       CHRT2210
      GO TO 530                                                         CHRT2220
  550 IF (Y(NANG-1).GE.Y(NANG-2)) GO TO 560                             CHRT2230
      NANG=NANG-1                                                       CHRT2240
      GO TO 550                                                         CHRT2250
  560 NANG=NANG-1                                                       CHRT2260
  570 XINT2(II)=Y(NANG)                                                 CHRT2270
      TTH2(II)=(FLOAT(NANG)-1.0)*0.02+5.0                               CHRT2280
  580 CONTINUE                                                          CHRT2290
C                                                                       CHRT2300
C     OUTPUT COMPLETE  I VS.2 THETA TABLE (2 THETA=0.02)                CHRT2310
C                                                                       CHRT2320
      IF (NSUPP.EQ.0) GO TO 660                                         CHRT2330
      X1=5.00                                                           CHRT2340
      X2=6.00                                                           CHRT2350
      X3=7.00                                                           CHRT2360
      X4=8.00                                                           CHRT2370
      X5=9.00                                                           CHRT2380
      NNN=NPLT+1                                                        CHRT2390
      NN=51                                                             CHRT2400
      N1=1                                                              CHRT2410
      N2=51                                                             CHRT2420
      N3=101                                                            CHRT2430
      N4=151                                                            CHRT2440
      N5=201                                                            CHRT2450
590   WRITE (NOUT,600) (ITITLE(I),I=1,LENX)                                     
600   FORMAT ('1',(15X,80A1))                                                   
      WRITE (NOUT,601)                                                          
601   FORMAT(1X/1X/1X/)                                                         
      WRITE (NOUT,610)                                                  CHRT2480
  610 FORMAT (119H 2THETA   INTENSITY       2THETA   INTENSITY       2THCHRT2490
     1ETA   INTENSITY       2THETA   INTENSITY       2THETA   INTENSITY)CHRT2500
  620 WRITE (NOUT,630) X1,Y(N1),X2,Y(N2),X3,Y(N3),X4,Y(N4),X5,Y(N5)     CHRT2510
  630 FORMAT (F7.2,F10.2,5X,2F10.2,5X,2F10.2,5X,2F10.2,5X,2F10.2)       CHRT2520
      X1=X1+0.02                                                        CHRT2530
      X2=X2+0.02                                                        CHRT2540
      X3=X3+0.02                                                        CHRT2550
      X4=X4+0.02                                                        CHRT2560
      X5=X5+0.02                                                        CHRT2570
      N1=N1+1                                                           CHRT2580
      N2=N2+1                                                           CHRT2590
      N3=N3+1                                                           CHRT2600
      N4=N4+1                                                           CHRT2610
      N5=N5+1                                                           CHRT2620
      IF (N1.LT.NN) GO TO 620                                           CHRT2630
      NN=NN+250                                                         CHRT2640
      IF (NN-NNN) 640,650,660                                           CHRT2650
  640 N1=N1+200                                                         CHRT2660
      N2=N2+200                                                         CHRT2670
      N3=N3+200                                                         CHRT2680
      N4=N4+200                                                         CHRT2690
      N5=N5+200                                                         CHRT2700
      X1=X1+4.00                                                        CHRT2710
      X2=X2+4.00                                                        CHRT2720
      X3=X3+4.00                                                        CHRT2730
      X4=X4+4.00                                                        CHRT2740
      X5=X5+4.00                                                        CHRT2750
      GO TO 590                                                         CHRT2760
  650 X1=165.00                                                         CHRT2770
      WRITE (NOUT,630) X1,Y(8001)                                       CHRT2780
C                                                                       CHRT2790
C     PLOT THE DIFFRACTOMETER TRACE                                     CHRT2800
C                                                                       CHRT2810
  660 IF (NCC.EQ.0) CALL PLOT (Y,NSC1,NPLT,LENGTH,NSCALE)               CHRT2820
      IF (SCMAX2.LE.0.0) GO TO 670                                      CHRT2830
      X=X*SCALE                                                         CHRT2840
      SCMAX=SCMAX2                                                      CHRT2850
      NSC1=NSC2                                                         CHRT2860
      SCMAX2=0.0                                                        CHRT2870
      GO TO 470                                                         CHRT2880
  670 IF (NLIST.EQ.0) GO TO 710                                         CHRT2890
      K=2                                                               CHRT2900
      XLIST=ABS(FLOAT(NLIST))                                           CHRT2910
      DO 700  N=M,IREFL                                                 CHRT2920
  680 IF (XANGLE(K).GE.TTH1(N)) GO TO 690                               CHRT2930
      K=K+1                                                             CHRT2940
      GO TO 680                                                         CHRT2950
  690 KTEMP=K-1                                                         CHRT2960
      XPART=TTH1(N)-XANGLE(KTEMP)                                       CHRT2970
      YPART=XANGLE(K)-XANGLE(KTEMP)                                     CHRT2980
      WREFL=(XPART/YPART)*(TABLE(K)-TABLE(KTEMP))+TABLE(KTEMP)          CHRT2990
      IF (ABS(TTH2(N)-TTH1(N)).GT.XLIST*WREFL) XINT2(N)=0.0             CHRT3000
  700 CONTINUE                                                          CHRT3010
C                                                                       CHRT3020
C     OUTPUT THE ABRIDGED SUMMARY                                       CHRT3030
C                                                                       CHRT3040
  710 IF (NTYPE.EQ.0) GO TO 920                                         CHRT3050
      IF (NTYPE.NE.NPUNCH) GO TO 730                                    CHRT3060
      ASSIGN 890 TO NTYP1                                               CHRT3070
      NPR=1                                                             CHRT3080
      WRITE (NTYPE,720) (ITITLE(I),I=1,LENX)                                    
720   FORMAT ((1X,80A1))                                                        
  730 DO 910  NPRINT=1,NPR                                              CHRT3110
      TTHZ=0.0                                                          CHRT3120
      NINTPX=0                                                          CHRT3130
      IF (NTYPE.EQ.NPUNCH) GO TO 750                                    CHRT3140
      ASSIGN 870 TO NTYP1                                               CHRT3150
      NNN=0                                                             CHRT3160
      WRITE (NTYPE,740) (ITITLE(I),I=1,LENX)                                    
740   FORMAT ('1',(6X,80A1))                                                    
  750 WRITE (NTYPE,760)                                                 CHRT3190
  760 FORMAT (10X,51H 2THETA  PEAK     D      H  K  L I(INT) I(PK) I(DS)CHRT3200
     1)                                                                 CHRT3210
  770 FORMAT (11X,F6.2,1X,F6.2,1X,F6.3,2X,3I3,3I6)                      CHRT3220
  780 FORMAT (11X,F6.2,1X,F6.2,2X,F6.4,1X,3I3,3I6)                      CHRT3230
  790 FORMAT (11X,F6.2,7X,1X,F6.3,2X,3I3,I6,6X,I6)                      CHRT3240
  800 FORMAT (11X,F6.2,7X,2X,F6.4,1X,3I3,I6,6X,I6)                      CHRT3250
      DO 900  N=1,IREFL                                                 CHRT3260
      NINTP=XINT2(N)+0.5                                                CHRT3270
      NINTD=XINT3(N)+0.5                                                CHRT3280
      IF (D(N).GE.SCB) GO TO 820                                        CHRT3290
      IF (D(N).LT.SCD) GO TO 810                                        CHRT3300
      IF (XINT1(N)-SCC) 900,830,830                                     CHRT3310
  810 IF (XINT1(N)-SCE) 900,830,830                                     CHRT3320
  820 IF (XINT1(N).LT.SCA) GO TO 900                                    CHRT3330
  830 NINTI=XINT1(N)+0.5                                                CHRT3340
      IF (TTH2(N).EQ.TTHZ.AND.NINTP.EQ.NINTPX) GO TO 850                CHRT3350
      IF (D(N).LT.2.0) GO TO 840                                        CHRT3360
      WRITE (NTYPE,770) TTH1(N),TTH2(N),D(N),IH(N),IK(N),IL(N),NINTI,NINCHRT3370
     1TP,NINTD                                                          CHRT3380
      GO TO NTYP1, (870,890)                                            CHRT3390
  840 WRITE (NTYPE,780) TTH1(N),TTH2(N),D(N),IH(N),IK(N),IL(N),NINTI,NINCHRT3400
     1TP,NINTD                                                          CHRT3410
      GO TO NTYP1, (870,890)                                            CHRT3420
  850 IF (D(N).LT.2.0) GO TO 860                                        CHRT3430
      WRITE (NTYPE,790) TTH1(N),D(N),IH(N),IK(N),IL(N),NINTI,NINTD      CHRT3440
      GO TO NTYP1, (870,890)                                            CHRT3450
  860 WRITE (NTYPE,800) TTH1(N),D(N),IH(N),IK(N),IL(N),NINTI,NINTD      CHRT3460
      GO TO NTYP1, (870,890)                                            CHRT3470
  870 NNN=NNN+1                                                         CHRT3480
      IF (NNN.LT.55) GO TO 890                                          CHRT3490
      WRITE (NTYPE,880) (ITITLE(I),I=1,LENX)                                    
880   FORMAT ('1',(25X,80A1))                                                   
      WRITE (NTYPE,881)                                                         
881   FORMAT (//)                                                               
      WRITE (NTYPE,760)                                                 CHRT3520
      NNN=0                                                             CHRT3530
  890 TTHZ=TTH2(N)                                                      CHRT3540
      NINTPX=NINTP                                                      CHRT3550
  900 CONTINUE                                                          CHRT3560
  910 CONTINUE                                                          CHRT3570
  920 IF (IREFL.EQ.NREFL) GO TO 940                                     CHRT3580
      IREFL=NREFL-IREFL                                                 CHRT3590
      WRITE (NOUT,930) IREFL                                            CHRT3600
  930 FORMAT (///11H  THE LAST I3,48H REFLECTIONS ARE GREATER THAN 165 DCHRT3610
     1EGREES 2THETA)                                                    CHRT3620
940   CONTINUE                                                                  
      WRITE (NOUT,1111) XMU,DENS,DENSC,XINTR,SC(5)                              
1111  FORMAT (/'0LINEAR ABSORPTION COEFFICIENT = ',F8.2/                        
     1 '0INPUT DENSITY = ',F7.3/'0CALCULATED DENSITY = ',F7.3/                  
     2 '0I/I-CORUNDUM = ',F6.3/'0GAMMA = ',E15.7)                               
      RETURN                                                                    
