C PROGRAM COMBIN(INPUT,TAPE5=INPUT,OUTPUT,TAPE6=OUTPUT,TAPE20,TAPE2
C	1,TAPE22,TAPE23,TAPE24,PUNCH)
	COMMON /FLAG/ IFLAG
	LOGICAL*1 ITITLE
	DIMENSION U(8001,5),Y(8001),BKG(8001),XINTR(5),X(5)
	DIMENSION ITITLE(80,5),SCMAX(5)
	NIN=5
	NOUT=6
	MOUT=20
	SUM=0.0
	CONST=2.0
	A1=-7.5E-4
	A2=5.0E-7
	A4=8.333E-14
	B4=8.333E-7
	SIG=2.0
	DO 100 I=1,8001
	Y(I)=0.0
100	BKG(I)=0.0
	READ (NIN,5) NFILES,X,NBKG,NSCALE,YSCALE,XLIM,NOISE,XSIG,NPUNCH
5	FORMAT (I5,5F5.2,2I5,2F5.1,I5,F5.2,I5)
	WRITE (NOUT,6) NFILES
6	FORMAT ('1THE NUMBER OF FILES WHICH WILL BE COMBINED ARE',I2)
	WRITE (NOUT,7) NFILES,X
7	FORMAT ('0THE WEIGHT FRACTIONS FOR THE',I2,' PATTERNS ARE',5F5.3)
	WRITE (NOUT,8) NBKG
8	FORMAT ('0THE BACKGROUND CODE IS',I3)
	READ (NIN,11) PEAK,PWIDTH,PINT
11	FORMAT (3F5.3)
	WRITE (NOUT,9) PEAK,PWIDTH,PINT
9	FORMAT ('0THE PARAMETERS FOR THE AMORPHOUS COMPONENT'/'          P
     1EAK POSITION = ',F6.2,/,'          PEAK WIDTH = ',F6.2,/,'          FR
     2ACTION OF INTENSITY = ',F4.2)
	NPLT=(XLIM-4.98)/0.02
	WRITE (NOUT,12) XLIM,NSCALE,YSCALE
12	FORMAT ('0PLOTS WILL BE MADE UP TO ',F4.0,' DEGREES',/,' THE HORIZON
     1TAL SCALE CODE IS',I2,/,' THE VERTICAL SCALE CODE IS',F6.1)
	IF (NOISE.EQ.0) WRITE (NOUT,13) XSIG
13	FORMAT ('0NOISE WILL BE INTRODUCED AT THE',F4.1,' STANDARD DEVIATI
     1ON LEVEL')
	WRITE (NOUT,14)
14	FORMAT ('0THE CONSTANTS USED FOR BACKGROUND ARE'/'         CONST.
     1          A1             A2             A4             B4  ')
	IF (XSIG.NE.0.0) SIG=XSIG
	READ (NIN,10)A,B,C,D,E
	IF (A.NE.0.0) CONST=A
	IF (B.NE.0.0) A1=B
	IF (C.NE.0.0) A2=C
	IF (D.NE.0.0) A4=D
	IF (E.NE.0.0) B4=E
	WRITE (NOUT,10)CONST,A1,A2,A4,B4
10	FORMAT (5E15.5)
	IF (NFILES.GT.5) NFILES=5
	READ (MOUT)(ITITLE(I,1),I=1,80),XINTR(1),SCMAX(1),(U(I,1),I=1,8001)
	MOUT=MOUT+1
	IF(NFILES.GT.1) READ (MOUT) (ITITLE(I,2),I=1,80),XINTR(2),SCMAX(2)
     1,(U(I,2),I=1,8001)
	MOUT=MOUT+1
	IF(NFILES.GT.2) READ (MOUT) (ITITLE(I,3),I=1,80),XINTR(3),SCMAX(3)
     1,(U(I,3),I=1,8001)
	MOUT=MOUT+1
	IF(NFILES.GT.3) READ (MOUT) (ITITLE(I,4),I=1,80),XINTR(4),SCMAX(4)
     1,(U(I,4),I=1,8001)
	MOUT=MOUT+1
	IF(NFILES.GT.4) READ (MOUT) (ITITLE(I,5),I=1,80),XINTR(5),SCMAX(5)
     1,(U(I,5),I=1,8001)
	DO 195 N=1,NFILES
	IMAX=SCMAX(N)
	SCMAX(N)=IMAX
	IF (IMAX.EQ.100) GO TO 195
	DO 190 I=1,8001
190	U(I,N)=U(I,N)*100.0/SCMAX(N)
195	CONTINUE
C     CREATE COMPOSITE PATTERN
	DO 200 N=1,NFILES
	DO 200 I=1,8001
200	Y (I)=Y(I)+X(N)*U(I,N)*XINTR(N)
	CALL SCALE (Y,100.)
	DO 210 I=1,8001
210	SUM=SUM+Y(I)
	WRITE (NOUT,20)
20	FORMAT (39H1PLOT OF COMBINED TRACES SCALED TO 100.,/
     1 18H WT FRACT    PHASE)
	WRITE (NOUT,71)
71	FORMAT (1H+,90X,16HI/I(COR)   SCALE)
	DO 105 N=1,NFILES
105	WRITE (NOUT,30) X(N),(ITITLE(I,N),I=1,80),XINTR(N),SCMAX(N)
30	FORMAT (2X,F5.2,3X,80A1,2F10.5)
	CALL PLOT (Y,NPLT,NSCAL,100.0)
C     DEFINE AND ADD BACKGROUND
C     SELECT BACKGROUND
C       NBKG=1  CONSTANT BACKGROUND
C       NBKG=2  LINEAR BACKGROUND
C       NBKG=4  QUADRATIC BACKGROUND
C       NBKG=8  QUARDIC BACKGROUND
C       NBKG=16 AMORPHOUS PEAK
	AINT=SUM*PINT
	WRITE (NOUT,31) AINT,SUM
31	FORMAT (2F10.2)
	PI=3.1415926
	MBKG=NBKG
	IF(NBKG.LT.16) GO TO 305
	NBKG=NBKG-16
C     ADD AMORPHOUS PEAK WITH CAUCHY FORM
	DO 300 I=1,8001
	T=I
300	BKG(I)=BKG(I)+((2.0*AINT)/(PI*PWIDTH))/(1.0+4.0*((4.98+0.02*T-
     1PEAK)/PWIDTH)**2)
305	IF(NBKG.LT.8) GO TO 311
	NBKG=NBKG-8
	DO 310 I=1,8001
310	BKG(I)=BKG(I)+A4*(I-4001)**4+B4*(I-4001)**2
311	IF(NBKG.LT.4) GO TO 320
	NBKG=NBKG-4
	DO 315 I=1,8001
315	BKG(I)=BKG(I)+A2*(I-4001)**2
320	IF(NBKG.LT.2) GO TO 330
	NBKG=NBKG-2
	DO 325 I=1,8001
325	BKG(I)=BKG(I)+A1*(I-8001)
330	IF(NBKG.NE.1) GO TO 340
	DO 335 I=1,8001
335	BKG(I)=BKG(I)+CONST
	IF (MBGK.LT.4) GO TO 345
	WRITE (NOUT,40)
40	FORMAT (29H1PLOT OF COMBINED BACKGROUNDS,/18H WT FRACT    PHASE)
	WRITE (NOUT,71)
	DO 110 N=1,NFILES
110	WRITE (NOUT,30) X(N),(ITITLE(I,N),I=1,80),XINTR(N),SCMAX(N)
340	CALL PLOT (BKG,NPLT,NSCALE,100.0)
345	CONTINUE
C     ADD BACKGROUND TO INTENSITY TRACE
	DO 400 I=1,8001
400	Y(I)=Y(I)+BKG(I)
	CALL SCALE (Y,100.)
	WRITE (NOUT,50)
50	FORMAT (30H1PLOT OF TRACE WITH BACKGROUND,/18H WT FRACT    PHASE)
	WRITE (NOUT,71)
	DO 115 N=1,NFILES
115	WRITE (NOUT,30) X(N),(ITITLE(I,N),I=1,80),XINTR(N),SCMAX(N)
	CALL PLOT (Y,NPLT,NSCALE,100.0)
C     ADD NOISE FUNCTION
	IF (NOISE.EQ.0) GO TO 409
	DO 408 I=1,8001
	IF (Y(I).LT.0.0) GO TO 407
	Y(I)=Y(I)+ SIG*SQRT(Y(I))*(0.5-RAN(I))
	GO TO 408
407	Y(I)=Y(I)-SIG*SQRT(-Y(I))*(0.5-RAN(I))
408	CONTINUE
409	CONTINUE
	CALL SCALE (Y,1000.)
	WRITE (NOUT,60)
60	FORMAT (25H1PLOT OF TRACE WITH NOISE,/18H WT FRACT    PHASE)
	WRITE (NOUT,71)
	DO 120 N=1,NFILES
120	WRITE (NOUT,30) X(N),(ITITLE(I,N),I=1,80),XINTR(N),SCMAX(N)
	CALL PLOT (Y,NPLT,NSCALE,1000.0)
	CALL SCALE (Y,YSCALE)
C     LIST FINAL DATA
	WRITE (NOUT,70)
70	FORMAT (16H1FINAL TRACE FOR,/18H WT FRACT    PHASE)
	WRITE (NOUT,71)
	DO 125 N=1,NFILES
125	WRITE (NOUT,30) X(N),(ITITLE(I,N),I=1,80),XINTR(N),SCMAX(N)
	CALL OUTPUT (Y,NPUNCH)
	STOP
	END
	SUBROUTINE SCALE (Y,SCMAX)
	DIMENSION Y(8001)
	XMAX=Y(1)
	DO 100 I=2,8001
	IF (ABS(Y(I)).GT.XMAX) XMAX=ABS(Y(I))
100	CONTINUE
	DO 105 I=1,8001
105	Y(I)=Y(I)*SCMAX/XMAX
	RETURN
	END
	SUBROUTINE PLOT (Y,NPLT,JSCALE,SCMAX)
	DIMENSION Y(8001), INTEN(101)
	DATA NX/'X'/,NPLUS/'+'/,NBLANK/' '/,NDOT/'.'/,NMINUS/'-'/
5	FORMAT (41H THE INTENSITY SCALE IS BASED ON I(MAX) =,I5/44H THE 2T
     1HETA SCALE IS PLOTTED IN INTERVALS OF,F5.2,8H DEGREES//10X,
     1 7H 2THETA,
     225X, 9HINTENSITY)
10	FORMAT (18X,1H0,8X,2H10,8X,2H20,8X,2H30,8X,2H40,8X,2H50,8X,2H60,8X
     1,2H70,8X,2H80,8X,2H90,8X3H100,/18X,10(1HI,9X),1HI)
20	FORMAT (12X,I3,3H - ,101A1)
30	FORMAT (18X,101A1)
	NOUT=6
	DO 100 I=1,101
100	INTEN(I)=NBLANK
	KPOINT=0
C     DEFINE PLOT SCALES
	ISCALE=SCMAX
	IF(JSCALE.GE.4) NSCALE=1
	IF(JSCALE.EQ.3) NSCALE=2
	IF(JSCALE.EQ.2) NSCALE=5
	IF(JSCALE.LE.1) NSCALE=10
	DELTA=FLOAT(NSCALE)*0.02
	WRITE (NOUT, 5) ISCALE,DELTA
	WRITE (NOUT,10)
C     SETUP DIFFRACTION TRACE
C     IF SCMAX.GT.100 PLOT TWO TRACES ONE WITH I(MAX)=100
	DO 215 I=1,NPLT,NSCALE
	IF (Y(I).LT.0.0) GO TO 205
	NPOINT=Y(I)+1.5
	IF (ISCALE.GT.100) KPOINT=Y(I)*100/FLOAT(ISCALE)+1.5
	IF (KPOINT.NE.0) INTEN(KPOINT)=NPLUS
	IF (NPOINT.GT.101) NPOINT=101
	INTEN(NPOINT)=NX
	GO TO 210
205	NPOINT=1.5-Y(I)
	IF (NPOINT.GT.101) NPOINT=101
	IF (ISCALE.GT.100) KPOINT=1.5-Y(I)*100.0/FLOAT(ISCALE)
	IF (KPOINT.GT.101) KPOINT=101
	IF (KPOINT.NE.0) INTEN(KPOINT)=NMINUS
	INTEN(NPOINT)=NDOT
210	TTH=5.00+(I-1)*0.02
	NTH=TTH
	IF(MOD(I,50)-1 .EQ.0.0) WRITE (NOUT,20 ) NTH,INTEN
	IF(MOD(I,50)-1 .NE.0.0) WRITE (NOUT,30) INTEN
	INTEN(NPOINT)=NBLANK
	INTEN(KPOINT)=NBLANK
	INTEN(101)=NBLANK
215	CONTINUE
	RETURN
	END
	SUBROUTINE OUTPUT (Y,NPUNCH)
	DIMENSION Y(8001),TTH(8001)
10	FORMAT (1X,8(F6.2,1X,F6.1,1X))
20	FORMAT ('1 2THETA   INT  2THETA   INT  2THETA   INT  2THETA   INT
     1 2THETA   INT  2THETA   INT  2THETA   INT  2THETA   INT')
	NOUT=6
	DO 100 N=1,8001
	T=N
100	TTH(N)=4.98+T*0.02
	I1=1
	I2=50
	DO 120 N=1,20
	WRITE (NOUT,20)
	DO 110 I=I1,I2
110	WRITE (NOUT,10) TTH(I),Y(I),TTH(I+50),Y(I+50),TTH(I+100),Y(I+100),
     1TTH(I+150),Y(I+150),TTH(I+200),Y(I+200),TTH(I+250),Y(I+250),TTH(I+
     2300),Y(I+300),TTH(I+350),Y(I+350)
	I1=I1+400
120	I2=I2+400
	WRITE (NOUT,10) TTH(8001),Y(8001)
	IF (NPUNCH.EQ.0) GO TO 99
c	 PUNCH 75, (Y(I),I=1,8001)
	 write(10,75) (Y(I),I=1,8001)
75 	FORMAT (10F8.1)
99	RETURN
	END
