

	PROGRAM STDANL
	COMMON/A/LH,LP,LT,LO,NN,NORI,X(500),Y(500)
	COMMON AJUNK(3000)
	CALL STAND
	STOP
	END
C
	BLOCKDATA INIT
	COMMON/A/LH,LP,LT,LO,NN,NORI,X(500),Y(500)
	DATA LH/1/,LP/6/,LT/5/,LO/1/,NORI/0/
	END
C
C
C	SUBROUTINE STAND
C
	SUBROUTINE STAND
	CHARACTER*8 HEAD(14),IDENT(7),JX(5)
	COMMON/A/LH,LP,LT,LO,NN,NORI,X(500),Y(500)
	COMMON IJ(3),NREF,NREFPR,IXRAYT,NG,NGOOD,NS,NSS,NBAD,NRET,
     *	NERR,NST,NHKL(6,3),ID,IS,
     *  FS,SS,X1,X2,V(110,7),S(110,7),T(110),R(7,7),A(110),B(110)
        DIMENSION IDUM(34),DUM(2023),TT(110)
	EQUIVALENCE (IDUM(1),IJ(1)),(DUM(1),FS)
	DATA NSMAX/6/,NGMAX/110/,NTMAX/500/,II/34/,IR/2023/
	DATA IDENT(1)/'Mean   '/,IDENT(2)/'range SD'/,
     *  IDENT(3)/'Minimum '/,IDENT(4)/'Maximum'/,IDENT(5)
     *  /'Corr cft'/,IDENT(6)/'PFAC   '/,IDENT(7)/'%perhour'/
     *  JX(1)/'        '/,JX(2)/'Standard'/,JX(3)/'  Mean  '/,
     *  JX(4)/'   Esd  '/,JX(5)/'  NREF  '/
1	DO 2 I=1,II
2	IDUM(I)=0
	DO 3 I=1,IR
3	DUM(I)=0.
	NREFPR=-1
	DO 4 I=1,NSMAX+1
4	R(3,I)=1.E35
5	READ(LH,ERR=15,END=17)IJ,FS,SS,NREF,IXRAYT
	IF(NREF-NREFPR-1)6,7,6
6	NG=NG+1
	IF(NG-NGMAX)7,7,16
7	NREFPR=NREF
	NS=0
	DO 8 I=1,NSS
8	IF(IJ(1).EQ.NHKL(I,1).AND.IJ(2).EQ.NHKL(I,2).AND.IJ(3).EQ.NHKL
     *  (I,3))NS=I
	IF(NS)9,9,14
9	IF(NSS+1-NSMAX)12,12,10
10	WRITE(LP,11)IJ
11	FORMAT(' Too many different standards',3I5,' has been skipped')
	NBAD=NBAD+1
	GOTO 5
12	NSS=NSS+1
	DO 13 I=1,3
13	NHKL(NSS,I)=IJ(I)
	NS=NSS
14	V(NG,NS)=FS
	S(NG,NS)=SS
	T(NG)=IXRAYT/3600.
	TT(NG)=FLOAT(NREF)
	NGOOD=NGOOD+1
	GOTO 5
15	NERR=NERR+1
	GOTO 5
16	NRET=1
	NG=NG-1
	BACKSPACE(LH)
17	WRITE(LP,18)
18	FORMAT(1H1,5X,'Analysis of Standard Intensities'//)
	DO 181 I=1,NSS
181	WRITE(LP,180)I,(NHKL(I,J),J=1,3)
180	FORMAT(' Standard',I3,'   H=',I3,' K=',I3,' L=',I3)
C******** ACCUMULATE SUMS
	NST=NSS+1
	NN=0
	DO 21 I=1,NG
	NS=0
	DO 19 J=1,NSS
	IF(V(I,J).GT.0.1)NS=NS+1
	VV=1000.0/V(1,J)
	V(I,NST)=V(I,NST)+V(I,J)*VV
19	S(I,NST)=S(I,NST)+S(I,J)*S(I,J)*VV*VV
	V(I,NST)=V(I,NST)/NS
	S(I,NST)=SQRT(S(I,NST)/NS)
	IF(NS.EQ.NSS) GOTO 20
	T(I)=-T(I)
	GOTO 21
20	NN=NN+1
	X1=X1+T(I)
	DO 21 J=1,NST
	R(1,J)=R(1,J)+V(I,J)
	IF(R(3,J).GT.V(I,J))R(3,J)=V(I,J)
	IF(R(4,J).LT.V(I,J))R(4,J)=V(I,J)
	R(6,J)=R(6,J)+S(I,J)*S(I,J)
21	CONTINUE
	X1=X1/NN
	DO 22 I=1,NST
	R(1,I)=R(1,I)/NN
22	R(6,I)=R(6,I)/NN
	DO 23 I=1,NG
	IF(T(I).LT.0.) GOTO 23
	X2=X2+(T(I)-X1)*(T(I)-X1)
	DO 23 J=1,NST
	R(2,J)=R(2,J)+(V(I,J)-R(1,J))*(V(I,J)-R(1,J))
	R(5,J)=R(5,J)+(V(I,J)-R(1,J))*(T(I)-X1)
23	CONTINUE
	X2=SQRT(X2/NN)
	DO 24 I=1,NST
	R(2,I)=SQRT(R(2,I)/NN)
	R(5,I)=R(5,I)/(NN*X2*R(2,I))
	R(6,I)=R(6,I)/NN
	R(6,I)=SQRT(AMAX1(1.E-35,R(2,I)*R(2,I)-R(6,I)))/R(1,I)
24	R(7,I)=100.*R(5,I)*R(2,I)/(R(1,I)*X2)
C*********** OUTPUT RESULTS
C	CALL SIZE(NST*12.0)
	ID=LP
	IS=1
25	DO 250 I=1,14
250	HEAD(I)=JX(1)
	I=1
251	HEAD(I)=JX(2)
	HEAD(I+1)=JX(4)
	I=I+2
	IF(I/2-NST+IS)251,252,252
252	HEAD(I)=JX(3)
	HEAD(I+1)=JX(4)
	DO 258 I=IS,NSS
258	NHKL(I,1)=I
	WRITE(ID,253)HEAD,(NHKL(I,1),I=IS,NSS)
253	FORMAT(/,'   NREF  Time ',14A8,/,'          Hrs   ',7(I6,10X))
	DO 254 I=1,NG
	K=NINT(TT(I))
	FS=ABS(T(I))
	WRITE(ID,255)K,FS,(V(I,J),S(I,J),J=IS,NST)
254	CONTINUE
255	FORMAT(I6,X,F6.2,7(F9.1,F7.1))
	DO 256 I=1,5
256	WRITE(ID,257)IDENT(I),(R(I,J),J=IS,NST)
257	FORMAT(' ',3X,A8,X,7(F8.2,8X))
	IF(LO)27,27,26
26	IF(ID.EQ.LT) GOTO 27
	ID=LT
	IS=MAX0(NST-3,1)
	GOTO 25
27	SX=0.
	SXX=0.
	SXY=0.
	SY=0.
	DO 40 I=1,NG
	SX=SX+TT(I)
	SXX=SXX+TT(I)*TT(I)
	SXY=SXY+TT(I)*V(I,NST)
	SY=SY+V(I,NST)
40	CONTINUE
	FFF=FLOAT(NG)
	AA=(FFF*SXY-SX*SY)/(FFF*SXX-SX*SX)
	BB=(SY-AA*SX)/FFF
	AB=AA/BB
	WRITE(LP,1233)AA,BB
1233	FORMAT(//5X,'Least Squares fit to plot of mean Intensity versus
     *  ref',/5X,' Intensity = ',E15.5,' *NREF + ',F10.2)
	WRITE(LP,1234)AB
1234	FORMAT(//5X,' Fade Correction: I(NREF) = 1.0+NREF*(',E15.5,')')
	WRITE(LT,50)
50	FORMAT(//' *********** Is this a graphics terminal?'//)
	CALL QUERY(LT,LT,KPLOT)
	DO 30 I=1,NST
	R(7,I)=R(7,I)*R(1,I)/100.
	R(6,I)=R(1,I)-R(7,I)*X1
	K=0
	DO 31 J=1,NG
	IF(T(J).LT.0.) GOTO 31
	K=K+1
	A(K)=T(J)
	B(K)=V(J,I)
31	CONTINUE
	IF(KPLOT.EQ.1) CALL STANDPLOT(A,B,NN,R(6,I),R(7,I))
	IF(I.LT.NST) GOTO 33
	WRITE(LP,32) JX(2+I/NST)
	GOTO 30
33	WRITE(LP,32) JX(2+I/NST),I
32	FORMAT('1Plot of FSQ versus time in hours for  ',A8,I5)
30	CALL SKETCH(A,B,NN,R(6,I),R(7,I),0)
C	CALL END PLT
C COPY INTO X AND Y ********************************************
	I=NORI
	DO 28 J=1,NG
	IF(T(J).LT.0.) GOTO 28
	I=I+1
	X(I)=T(J)
	Y(I)=V(J,NST)
28	CONTINUE
	NORI=NORI+NN
	X1=R(5,NST)
	X1=X1*SQRT(NN-2.)/SQRT(1.-X1)
	IF(X1.LT.2.) NN=-NN
	IF(NRET)29,29,1
29	RETURN
	END
C
	SUBROUTINE SKETCH(X,Y,N,A,B,MODE)
C       C  N pairs of points X,Y are plotted in a frame NY lines
C       C  by NX columns on device LP. Mode = 0/1 for do/dont plot
C       C   the trend line Y=A+BX. Range of X and Y are used to 
C       C  scale the plot.
	DIMENSION X(N),Y(N),R(4),XOUT(20)
	REAL P1,P2,P3,YOUT
	INTEGER NX,NY,I,J,IL,JJ,LP
	CHARACTER*1 JX(4),LINE(100)
	DATA JX(1)/' '/,JX(2)/'*'/,JX(3)/'+'/,JX(4)/'-'/
	DATA NX/100/,NY/46/,P1/1.E35/,P2/1.05/,LP/6/
	DO 1 I=1,3,2
	R(I)=-P1
1	R(I+1)=P1
	DO 2 I=1,N
	IF(X(I).GT.R(1))R(1)=X(I)
	IF(X(I).LT.R(2))R(2)=X(I)
	IF(Y(I).GT.R(3))R(3)=Y(I)
2	IF(Y(I).LT.R(4))R(4)=Y(I)
	DX=P2*(R(1)-R(2))/(NX-1.)
	DY=P2*(R(3)-R(4))/(NY-2.)
	IF(MODE.EQ.1) GOTO 99
	WRITE(LP,103)A,B
99	DO 15 I=1,NY
	DO 3 J=1,NX
3	LINE(J)=JX(1+I/NY)
	IL=0
	IF(MOD(I-1,5))6,4,6
4	IL=1
	DO 5 J=1,3
5	LINE(J)=JX(2)
6	YOUT=R(3)-DY*(I-1.)
	IF(NY-I-4)7,9,9
7	DO 8 J=11,NX,10
8	LINE(J)=JX(2)
9	DO 11 J=1,N
	JJ=(R(3)-Y(J))/DY+1.49
	IF(I-JJ)11,10,11
10	JJ=(X(J)-R(2))/DX+1.49
	LINE(JJ)=JX(3)
11	CONTINUE
	IF(MODE.EQ.1) GOTO 12
	DO 18 J=1,NX
	P3=A+B*(R(2)+(J-1)*DX)
	JJ=(R(3)-P3)/DY+1.49
	IF(JJ.NE.1) GOTO 18
	LINE(J)=JX(4)
18	CONTINUE
12	IF(IL)14,13,14
13	WRITE(LP,100) LINE
	GOTO 15

14	WRITE(LP,101) YOUT,LINE
15	CONTINUE
	DO 17 I=1,NX,10
	J=I/10+1
17	XOUT(J)=R(2)+DX*(I-1)
	WRITE(LP,102)(XOUT(I),I=1,J)
	RETURN
100	FORMAT(' ',15X,'*',100A1)
101	FORMAT(' ',E15.5,'*',100A1)
102	FORMAT(' ',10X,20E10.4)
103	FORMAT(' Intercept= ',E15.6,' Gradient= ',E15.6)
	END
C
	SUBROUTINE STANDPLOT(A,B,N,A1,B1)
	COMMON/LINE/A2,B2
	DIMENSION A(N),B(N),C(110)
	EXTERNAL FLINE
	WRITE(4,100)
100	FORMAT(' PLOT OPTION NOT YET IMPLEMENTED!')
	RETURN
C	DO 1 I=1,N
C1	C(I)=B(I)*100./B(1)
C	A2=A1*100./B(1)
C	B2=B1*100./B(1)
C	CALL JBAXES(A,N,15.,1HX        ,1,C,N,10.,1HY      ,1)
C	DO 2 I=1,N
C2	CALL JOIN PT(A(I),C(I))
C	CALL BRKN FN(FLINE,-1)
C	RETURN
	END
C
	FUNCTION FLINE(X)
	COMMON/LINE/A2,B2
	FLINE=A2+X*B2
	RETURN
	END
C
	SUBROUTINE QUERY(LIN,LOUT,ANSWER)
	CHARACTER LINE(145)
	CHARACTER*8 TAG
	INTEGER FCH(20),FWD(20),ANSWER
	DATA LINE/145*' '/
1001	FORMAT(72A1)
1002	FORMAT(//9X,' Please answer yes or no!'/)
1	READ(LIN,1001) (LINE(I),I=2,73)
	CALL PARSE(LINE,NFS,FCH,FWD)
	IF(NFS.NE.1) GOTO 2
	CALL AFORMT(LINE,FCH(1),FWD(1),TAG)
	IF(TAG.EQ.'YES'.OR.TAG.EQ.'Y'.OR.TAG.EQ.'yes'.OR.TAG.EQ.'y')
     *  GOTO 3
	IF(TAG.EQ.'NO'.OR.TAG.EQ.'N'.OR.TAG.EQ.'no'.OR.TAG.EQ.'n')
     *  GOTO 4
2	WRITE(LOUT,1002)
	GOTO 1
3	ANSWER=1
	GOTO 5
4	ANSWER=0
5	RETURN
	END
