C                      SPECMIS
C
C
      SUBROUTINE CLFILE(DLT,ITERM)
C
      BYTE ITERM,DLT(5)
C
      CALL ERRSET(28,.TRUE.,.FALSE.,.TRUE.,.FALSE.,31)
      CALL ERRSET(32,.TRUE.,.FALSE.,.TRUE.,.FALSE.,31)
C
      IF(DLT(1).EQ.1) CLOSE(UNIT=2,DISPOSE='DELETE',ERR=100)
  100 IF(DLT(2).EQ.1) CLOSE(UNIT=8,DISPOSE='DELETE',ERR=200)
  200 IF(DLT(3).EQ.1) CLOSE(UNIT=9,DISPOSE='DELETE',ERR=300)
  300 IF(DLT(4).EQ.1) CLOSE(UNIT=10,DISPOSE='DELETE',ERR=400)
  400 IF(DLT(5).EQ.1) CLOSE(UNIT=13,DISPOSE='DELETE',ERR=500)
  500 CALL CLOSE(3)
      RETURN
      END
C
C
      SUBROUTINE OPEN8(T0,FN,F,ISP,IFL,JIN)
C
      COMMON /HEAD/ SNUM,MON,DATE,YEAR,TIT,DX,YCR,INST,ITG,CRY
     1,DSPACE,YL
      COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF,NT
     1,SENS,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30)
     1,EXSTD(30)
      INTEGER SNUM,DATE,YEAR,INST(2)
      BYTE FN(9,30),F(30),ISP,IFL,TIT(48),JIN
C
      IF(ISP.EQ.2) RETURN
      IF(ISP.EQ.3) RETURN
C
      IN=INST(1)
      DY=1./YCR
      CALL CLOSE(8)
      IF(ISP.NE.4.AND.ISP.NE.5) GO TO 15 ! ADD OR SUBTRACT SPC.SPC
      F(1)='S'
      F(2)='P'
      F(3)='C'
      F(4)='.'
      GO TO 30
   15 DO 10 I=1,30
   10 F(I)=FN(1,I)
   30 DO 20 I=1,30
   20 IF(F(I).EQ.'.') J=I
      F(J+1)='S'
      F(J+2)='P'
      F(J+3)='C'
      F(J+4)=0
C
      CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,31)
      CALL ERRSET(30,.TRUE.,.FALSE.,.TRUE.,.FALSE.,31)
C
      IF(IDPRC.GT.0.AND.JIN.EQ.0) GO TO 100 ! START FRESH
      OPEN(UNIT=8,NAME=F,TYPE='OLD',SHARED,ERR=100)
  102 READ(8,2000,END=101) I
 2000 FORMAT(A1)
      GO TO 102
  101 CONTINUE
      RETURN
  100 OPEN(UNIT=8,NAME=F,TYPE='NEW',SHARED,ERR=999)
       WRITE(8,21) SNUM,MON,DATE,YEAR,(INST(I),I=1,2)
     1,(TIT(I),I=1,48)
   21 FORMAT(1X,I5,1X,I2,'-',I2,'-',I2,1X,2A2,4X,48A1)
      IF(IN.EQ.'DI') WRITE(8,53) T0,DX,DY,ITG,YL
      IF(IN.EQ.'XR') WRITE(8,55) T0,DX,DY,CRY,DSPACE
   53 FORMAT(1X,'START ANGLE=',F8.3,'  DELTA 2THETA='
     &,F6.3,'  TIME=',F5.1,' TUBE=',A2,' LAMDA=',F6.3)
   55 FORMAT(1X,'START ANGLE=',F8.3,' STEP=',F6.3,' TIME=',F5.1
     1,' CRYSTAL=',A4,' 2D=',F6.3)
	IF(IN.EQ.'ED') WRITE(8,56) T0,DX,DY
56	FORMAT(1X,'START=',F8.3,'  STEP=',F6.3,'  TIME=',F5.1)
      IF(IN.EQ.'DI')WRITE(8,61) ISM,IBKGR,MF,MB,IK2,ITG,ISCH,SENS,IPF,NT
   61 FORMAT(1X,'SM=',I2,2X,'BKGR=',3I2,2X,'KA2=',I1,2X,'TUBE=',A2,1X,
     1'SCH=',I2,' SENS=',F4.2,'  CENTROID=',I2,' NTP=',I2)
      IF(IN.EQ.'XR'.OR.IN.EQ.'ED')WRITE(8,62)ISM,IBKGR,MF,MB,ISCH,SENS
     &,IPF,NT
   62 FORMAT(1X,'SMOOTH=',I2,'  BKGR=',3I2,'  SEARCH=',I2,'  SENS='
     1,F4.1,'  CENTROID=',I2,'  NTOP=',I2)
      IF(IN.EQ.'XR')  WRITE(8,202)
  202 FORMAT(/3X,'N   2THETA    LAMDA   ENERGY    HEIGHT    AREA',
     1'        P       W2       W4'/)
      IF(IN.EQ.'DI') WRITE(8,9)
    9 FORMAT(/3X,'N   2THETA   DSPACE  (1/D**2)  HEIGHT     AREA',
     X'        P       W2       W4'/)
      IF(IN.EQ.'ED') WRITE(8,63)
   63 FORMAT(/3X,'N   ENERGY     LAMDA   HEIGHT    AREA'
     &,7X,'P',8X,'W2',8X,'W4'/)
      RETURN
  999 WRITE(6,1000) F
 1000 FORMAT(1X,'PROBLEM OPENING ',30A1)
      STOP ! PROBLEMS PROBLEMS
      END
C
C
      SUBROUTINE HEADER(LU,IFL,ISP,JSP,CH,YF,TYP,FN)
C
      COMMON /HEAD/ SNUM,MON,DATE,YEAR,TIT,DX,YCR,INST,ITG,CRY
     1,DSPACE,YL
C
      INTEGER SNUM,DATE,YEAR,INST(2)
      BYTE TIT(48),BUF(74),IFL,JSP,TYP,ISP,FN(9,30),F(30)
C
      DY=1./YCR
      IF(ISP.GT.3) GO TO 100
      N=0
      I1=IFL-1
      DO 10 I=1,30
      IF(N.EQ.0.AND.FN(I1,I).NE.']') GO TO 10
      N=N+1
      J=I+1
      IF(FN(I1,J).EQ.'.') GO TO 20
      F(N)=FN(I1,J)
   10 CONTINUE
      IF(N.GT.0) GO TO 20
      DO 11 I=1,30
      IF(N.EQ.0.AND.FN(I1,I).NE.':') GO TO 11
      N=N+1
      J=I+1
      IF(FN(I1,J).EQ.'.') GO TO 20
      F(N)=FN(I1,J)
   11 CONTINUE
   20 N=N-1
      ENCODE(74,1000,BUF)(F(J),J=1,6),MON,DATE,YEAR,INST,DX,DY,
     1(TIT(I),I=1,39)
 1000 FORMAT(6A1,1X,I2,'/',I2,'/',I2,1X,2A2,'S=',F4.2
     1,' T=',F5.1,1X,39A1)
C
      IF(INST(1).EQ.'XR')THEN
        ENCODE(73,1001,BUF)(F(J),J=1,6),MON,DATE,YEAR,INST,DX,DY
     1  ,(TIT(I),I=1,33),CRY
1001  FORMAT(6A1,1X,I2,'/',I2,'/',I2,1X,2A2,'S=',F4.2
     1,' T=',F5.1,1X,33A1,1X,A4)
       ENDIF
C
      Y=YF-(IFL-2)*(CH+2)
      IF(ISP.EQ.2) Y=YF
      CALL TPLOT(2,XS,Y)
      CALL OUTPUT(BUF,74)
      RETURN
  100 ENCODE(74,1010,BUF)
 1010 FORMAT(74X)
      L=1
      DO 200 I=1,JSP
      DO 300 J=1,30
      L=L+1
      IF(L.GT.74) GO TO 400  ! ENOUGH IS ENOUGH
      IF(FN(I,J).EQ.'.') GO TO 250
  300 BUF(L)=FN(I,J)
  250 L=L+1
      IF(ISP.EQ.4) BUF(L)='+'
      IF(ISP.EQ.5) BUF(L)='-'
      IF(I.EQ.JSP) BUF(L)=' '
  200 CONTINUE
  400 CALL TPLOT(2,XS,YF)
      CALL OUTPUT(BUF,74)
      RETURN
      END
C
      SUBROUTINE LDBKGR(F,ISTAT)
C
      BYTE F(30),Q
C
      WRITE(6,1000)
 1000 FORMAT(1H$,'PLOT BACKGROUND  DEFAULT:[NO] > ')
      READ(5,2000,END=999) Q
 2000 FORMAT(A1)
      IF(Q.NE.'Y') RETURN
      DO 100 I=1,30
  100 IF(F(I).EQ.'.') J=I
      F(J+1)='B'
      F(J+2)='K'
      F(J+3)='G'
      CALL CLOSE(2)
      CALL CLOSE(13)
      OPEN(UNIT=2,NAME=F,TYPE='OLD',ACCESS='DIRECT',RECORDSIZE=1
     1,ERR=900)
      ISTAT=2
      RETURN
  900 WRITE(6,1010) F
 1010 FORMAT(1X,'PROBLEM WITH BKGR FILE ',30A1)
  999 RETURN
      END
