      SUBROUTINE NORM(D2,XL,F,STR,FIN)
C
C  PROGRAM TO CORRECT .SPC FILE
C WRITTEN BY RAY GOEHNER 9/83
C
C PROGRAM USES THESE FILES   INSTD CONTAINS STD 2THETA
C EXSTD CONTAINS POLYNOMIAL FOR EXT CORRECTION
C
      COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF,
     1NT,SENS,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30)
     1,EXSTD(30)
      BYTE F(30),D2(12)
C
      DMAX=XL/(2.*SIN(0.0087266*STR))
      DMIN=XL/(2.*SIN(0.0087266*FIN))
      J=0
      DO 100 I=1,30
      IF(F(I).NE.'.') GO TO 100
      J=I
      GO TO 110
  100 CONTINUE
C
  110 REWIND 8
      F(J+1)='D'
      F(J+2)='I'
      F(J+3)='F'
      CALL CLOSE(9)
      OPEN(UNIT=9,NAME=F,TYPE='NEW',ERR=9000)
      F(J+2)='S'
      F(J+3)='P'
      CALL CLOSE(10)
      OPEN(UNIT=10,NAME=F,TYPE='NEW',ERR=9000)
      MIN=2
      LIST=1
      CALL CNORM(DMAX,DMIN,XL,MIN,LIST,D2,F)
      RETURN
 9000 WRITE(7,2010) F
 2010 FORMAT(1X/1X,'PROBLEM IN OPENING SPC FILE ',30A1)
  999 STOP 'PROBLEMS PROBLEMS'
      END
      SUBROUTINE CNORM(DMAX,DMIN,XL,MIN,LIST,D2,F)
C
C PROGRAM THAT NORMALIZES INTENSITY
C MODIFIED BY TERRY QUICK (LLL) FROM ORIGINAL ROUTINE WRITTEN BY RAY
C GOEHNER (GE)
C
      COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF,
     1NT,SENS,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30)
     1,EXSTD(30)
      BYTE AQ,D2(12),F(30),FI(6)
      INTEGER SNUM,DATE,YEAR,EOJ,TTY
      DIMENSION P2T(100),TIT(12),INST(2)
C
      TTY=6
      REWIND 8
      DO 2 I=1,30
C    2 IF(F(I).EQ.']') IQ=I   ! THIS IS THE RSX-11 STATEMENT
    2 IF(F(I).EQ.':')IQ=I   ! THIS IS THE VMS STATEMENT
      DO 3 I=1,6
      J=IQ+I
    3 FI(I)=F(J)
      X=0.0
      Y=0.0
      DO 10 I=1,5
      READ(8,1) A
    1 FORMAT(1X,A4)
   10 CONTINUE
      I=1
   20 READ(8,15,END=95) P2T(I),A,B
   15 FORMAT(4X,F9.0,18X,2F9.0)
      IF(P2T(I).LE.0.0) GO TO 20
      IF(A.GT.X)X=A
      IF(B.GT.Y)Y=B
      I=I+1
      GO TO 20
   95 REWIND 8
      N=I-1
      CALL CORRECT(MIN,AERR,ERR,P2T,N,XL,LIST,TTY,D2)
      READ(8,16) SNUM,MON,DATE,YEAR,(INST(I),I=1,2),(TIT(I),I=1,12)
   16 FORMAT(1X,I5,1X,I2,1X,I2,1X,I2,1X,2A2,4X,12A4)
      READ(8,17) T0,DX,DY
   17 FORMAT(13X,F8.3,15X,F6.3,7X,F5.1)
      DO 14 I=1,4
      READ(8,1) A
   14 CONTINUE
      WRITE(9,32) FI,MON,DATE,YEAR,(INST(I),I=1,2),(TIT(I),I=1,12)
      WRITE(10,32)FI,MON,DATE,YEAR,(INST(I),I=1,2),(TIT(I),I=1,12)
   32 FORMAT(1X,6A1,1X,I2,'/',I2,'/',I2,1X,2A2,4X,12A4)
      WRITE(10,*) DMAX,DMIN
      WRITE(9,33) T0,DX,DY
   33 FORMAT(1X,'INITIAL 2THETA=',F8.3,' DELTA 2THETA=',F6.3,
     X' DELTA TIME=',F6.2,'SEC')
      WRITE(9,61) ISM,IBKGR,MF,MB,IK2,XL,ISCH,SENS,IPF,NT
   61 FORMAT(1X,'SM=',I2,2X,'BKGR=',3I2,2X,'KA2=',I1,2X,'WLGTH=',F8.6,
     1' SCH=',I2,' SENS=',F4.2,'  CENTROID=',I2,' NT=',I2)
      WRITE(9,41)
      IF(ISTD.EQ.1.OR.ISTD.EQ.3) WRITE(9,1010)
 1010 FORMAT('+',$,'EXTERNAL STANDARD USED')
      IF(ISTD.EQ.2.OR.ISTD.EQ.3) WRITE(9,1020) AERR,ERR
 1020 FORMAT('+',$,' INTERNAL STANDARD USED  AVERAGE ERROR WAS',F9.3
     1,'  AVERAGE DIFF WAS',F9.3)
      WRITE(9,41)
      WRITE(9,142)
      IF(LIST.EQ.1) WRITE(7,142)
   42 FORMAT(3X,'M',4X,'DSPACE',4X,'HEIGHT')
  142 FORMAT(3X,'M',4X,'2THETA',4X,'DSPACE',4X,'HEIGHT')
      WRITE(9,41)
   41 FORMAT(1X)
      M=0
   21 READ(8,19,END=96,ERR=21) DE,SDE,Q,PK,CAREA,P,W2,W4
      IF(DE.LE.0.0) GO TO 21
      IF(DE.GT.180.0) GO TO 21
      M=M+1
      IF(ISTD.GT.0) DE=P2T(M)
   19 FORMAT(4X,8F9.0)
      IF(SDE.LE.0.01) GO TO 21
      IF(DE.LE.0.0) GO TO 900
      SDE=XL/(2.0*SIN(0.0087266*DE))
  250 PK=PK*100./X
      IPK=PK
      CAREA=CAREA*100./Y
      IM=M
      WRITE(9,143) IM,DE,SDE,PK
      IF(LIST.EQ.1) WRITE(7,143) IM,DE,SDE,PK
      WRITE(9,41)
      WRITE(10,144) SDE,IPK
  144 FORMAT(F7.3,I10)
   43 FORMAT(1X,I3,F10.4,2F10.1,F10.3)
  143 FORMAT(1X,I3,F10.3,F10.4,2F10.1,F10.3)
      GO TO 21
   96 RETURN
  900 WRITE(6,1000)
 1000 FORMAT(1X,'PROBLEM P2T IS ZERO ? ? ?')
 9999 STOP
      END
      SUBROUTINE CORRECT(MIN,AERR,ERR,P2T,N,XL,LIST,TTY,D2)
C  PROGRAM TO DO INTERNAL & EXTERNAL STANDARD CORRECTION
C WRITTEN BY RAY GOEHNER 9/83
C
C  ISTD=1  EXTERNAL CORRECTION ONLY
C  ISTD=2  INTERNAL STANDARD CORRECTION ONLY
C  ISTD=3  EXTERNAL THEN INTERNAL STANDARD CORRECTION
C
C  E2T + OR - ERROR IN 2THETA THAT IS ACCEPTABLE
C  MIN MINIMUM NUMBER OF MATCHED PEAKS ALLOWED
C  P2T MATRIX CONTAINING OBSERVED 2THETA
C  N NUMBER OF PKS IN P2T
C  A  POLY COEFF. FOR CORRECTION
C  LIST  FLAG IF USER WANTS A LISTING OF MATCHES & HOW THEY WERE MATCHED
C  TTY  LOGICAL UNIT FOR USER TERM
C  STD2T  MATRIX HAVING INTERNAL STD PEAKS
C  M2T  MATRIX HAVING MATCHED OBSERVED PEAKS
C
      COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF,
     1NT,SENS,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30),
     1EXSTD(30)
      BYTE D2(12)
      DIMENSION P2T(1),A(6),STD2T(100)
      REAL*8 M2T(100),DEL(100),AA,BB(10)
      INTEGER TTY
C
      IF(ISTD.LT.1) RETURN ! WHY ARE YOU HERE
C
      IF(ISTD.LT.4) GO TO 100
      WRITE(TTY,1000) ISTD
 1000 FORMAT(1X,'PROBLEM IN CORRECT SUBROUTINE  ISTD=',I4)
      STOP 'NO SUCH OPTION'
C
C                         EXTERNAL CORRECTION
C
  100 IF(ISTD.EQ.2) GO TO 200
      OPEN(UNIT=1,NAME=EXSTD,ERR=910,TYPE='OLD',READONLY)
      READ(1,1010,END=105,ERR=910) (A(I),I=1,6)
 1010 FORMAT(6E12.5)
  105 CLOSE(UNIT=1)
      DO 110 I=1,N
      P2T(I)=P2T(I)+A(1)+A(2)*P2T(I)+A(3)*P2T(I)**2+A(4)
     1*P2T(I)**3+A(5)*P2T(I)**4+A(6)*P2T(I)**5
  110 CONTINUE
C
C                        INTERNAL CORRECTION
C
  200 IF(ISTD.EQ.1) RETURN
      CALL MATCH2(MIN,AERR,ERR,STD2T,P2T,M2T,DEL,N,NSTD,NM,XL,LIST,TTY
     1,D2)
      NORDER=2
      IF(NM.EQ.3) NORDER=1
      IF(NM.GT.2) GO TO 360
      AA=ERR
      DO 355 I=1,10
  355 BB(I)=0.0
      GO TO 370
  360 CALL PFIT(M2T,DEL,NM,-NORDER,AA,BB,NS,S)
  370 IF(LIST.NE.1) GO TO 400
      WRITE(TTY,1020) AA,(BB(I),I=1,NORDER)
 1020 FORMAT(1X,'A1=',E12.4,' A2=',E12.4,' A3=',E12.4)
      WRITE(TTY,1030) NS,S
 1030 FORMAT(1X,'NS=',I4,' STD= DEV=',E12.4)
  400 DO 220 I=1,N
  220 P2T(I)=P2T(I)+AA+BB(1)*P2T(I)+BB(2)*P2T(I)**2
     1+BB(3)*P2T(I)**3+BB(4)*P2T(I)**4+BB(5)*P2T(I)**5
      RETURN
  910 WRITE(TTY,3000) EXSTD
 3000 FORMAT(1X'PROBLEM IN EXTERNAL CORRECTION FILE ',30A1)
      STOP ' EXTERNAL CORRECTIO FAILED'
      END
