	PROGRAM MEN3
	INTEGER INST(2)
	BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD
	BYTE CL,CLB,CLA,CLG(5)
	BYTE VER(72)
	BYTE ISP,JSP,DSP,IG,ITERM,IX,IFL,JIN,CW,CH,TYP
	BYTE FN(9,30)
	BYTE D1(12),D2(12),D3(12),LOGO(12)
      CALL DFAULT(FN,DSP,IG,YD,ITERM,TYP,IX,D1,D2,D3,D4,LOGO,FR,VER,DLT
     1 ,INST)
      CALL MENU(FN,DSP,IG,YD,ITERM,TYP,IX,D1,D2,D3,D4,LOGO,FR,VER,INST)
	STOP
	END
      SUBROUTINE MENU(FN,DSP,IG,YD,ITERM,TYP,IX,D1,D2,D3,D4,LOGO,FR,VER,INST)
C
      INTEGER INST(2)
      COMMON /SCN/ XS,XF,YS,YF,XXS,XXF,YYS,YYF,CSTR,CFIN,CYMIN,CYMAX,STR
     1,FIN,YMIN,YMAX,ZZ,CW,CH,ISP,JSP,IFL
      COMMON /COLOR/ CL,CLB,CLA,CLG
      COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF,NTP,SENS
     1,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30),EXSTD(30)
      DIMENSION DP(2)
	DOUBLE PRECISION DD(5),SS(5),X1(3),Y1(7)
      BYTE CL,CLB,CLA,CLG(5)
      BYTE ISP,JSP,DSP,IG,ITERM,IX,IFL,JIN,CW,CH,TYP
      BYTE FN(9,30),ANS,VER(72)
      BYTE D1(12),D2(12),D3(12),D4(12),LOGO(12)
	DATA DD/'FULL    ','SPLIT   ','OVERLAY ','ADDITION','SUBTRACT'/
	DATA SS/'XRF.RAW' ,'XRD.RAW ','RIGAKU  ','ROOT.PKS','ROOT.SPC'/
	DATA X1/'2-THETA ','DSPACING','LAMBDA  '/
	DATA Y1/'LINEAR  ','INTEGRAL','LOG     ','SQRT    ','SC 0-100'
     1	,'1ST DIFF','2ND DIFF'/
      DATA DP/'NO  ','YES '/
C
C
C  LU-1 DEFAULT FILE ON SY0:
C
C  VER ARRAY CONTAINING CURRENT VERSION OF SPECPLOT
C  TYP IS FILE TYPE SPECPLOT OR RIGAKU
C  TYP=0 SPECPLOT BINARY FILE
C  TYP=1 RIGAKU BINARY FILE
C  TYP=3 RIGAKU PKS FILE
C  TYP=4 SPECPLOT ROOT.SPC FILE
C
C  D1 IS DISK VOL WITH DATA FILES
C  D2 IS DISK VOL WITH JCPDS DATA BASE
C  D3 IS DISK VOL WITH ELEMENTAL DATA BASE
C  D4 IS DISK VOL WITH HELP FILES
C
C  IDPRC  ONLINE DATA PROCESSING (0-NO  1-YES)
C  IBKGR=0 NONE
C  IBKGR=1 LINEAR BKGR
C  IBKGR=2 PARABOLIC BKGR
C  NB NUMBER BACK  AND NF NUMBER FORWARD  FOR BKGR SUBTRACTION
C  ISCH=0 NONE
C  ISCH>0 NUMBER OF PTS TO CALCULATE 2ND DERIVATIVE OVER (SMOOTH)
C  SENS  SENSITIVITY FOR SEARCH  IE  SENS* Std Dev
C  INRM=0 NONE
C  INRM=1 NORMALIZE DATA
C  ISTD=0 NONE
C  ISTD=1 EXTERNAL STD
C  ISTD=2 INTERNAL STD (INTERNAL.STD)
C  ISTD=3 EXTERNAL & INTERNAL STD (EXTERNAL.STD & INTERNAL.STD)
C
C  ISM=0 NO REAL DATA SMOOTH
C  ISM>0 NUMBER OF PTS TO SMOOTH OVER
C  NDER  NUMBER OF PTS TO TAKE DERIVATIVE OVER 5,7,9,11,15,19,25
C  IK2=0 NO K ALPHA ELIMINATION
C  IK2=1 RACINGER
C  IK2=2 LADELL
C
C  ****    MENU OUTPUT      ***********
200	CALL CLEAR(ITERM)
      WRITE(6,9002) VER
 9002 FORMAT(1X,72A1)
	TYPE *,'  ********************** DISPLAY OPTIONS ********************'
	TYPE *,' '
	IF(INST(1).NE.'XR')WRITE(6,9001)SS(TYP+2)
	IF(INST(1).EQ.'XR')WRITE(6,9001)SS(TYP+1)
9001	FORMAT('0',T5,' 1   FILE TYPE ',T55,A8)
	WRITE(6,9005)DD(ISP)
9005	FORMAT('0',T5,' 2   DISPLAY ',T55,A8)
	VV=IX+1
	IF(IX.EQ.1.AND.INST(1).EQ.'XR')VV=VV+1
	IF(IX.EQ.1.AND.TYP.EQ.3)VV=VV+1
	WRITE(6,9010)X1(VV)
9010	FORMAT('0',T5,' 3   X-AXIS ',T55,A8)
	WRITE(6,9020)Y1(DSP+1)
9020	FORMAT('0',T5,' 4   Y-AXIS ',T55,A8)
	IF(ISP.GT.1.AND.JSP.LT.2)JSP=2
	IF(ISP.EQ.1)JSP=1
	WRITE(6,9030)JSP
9030	FORMAT('0',T5,' 5   NUMBER OF FILES TO DISPLAY ',T55,I1)
	IF(ISP.GT.3)WRITE(6,9040)FR
9040	FORMAT('0',T5,' 6   FRACTION OF SECOND FILE TO ADD/SUBTRACT '
     1	,T55,F4.2)
	IF(ISP.EQ.3)WRITE(6,9050)YD
9050	FORMAT('0',T5,' 6   PERCENT DISPLACEMENT FOR OVERLAY ',T55,F4.2)
	IF(DSP.GT.4)WRITE(6,9060)NDER
9060	FORMAT('0',T5,' 7   # OF POINTS FOR DERIVATIVE CALCULATION '
     1	,T55,I2)
      I=IDPRC+1
      TYPE *,' '
      IF(JSP.EQ.1) WRITE(6,9070) DP(I)
 9070 FORMAT(1X,T5,' 8   DATA PROCESSING',T55,A4)
	IF(JSP.EQ.1) WRITE(6,9080)
9080	FORMAT('0',T5,' 9   SHOW DATA PROCESSING PARAMETERS')
	DO 300 I=1,4
300	TYPE *,' '
	WRITE(6,9200)
9200	FORMAT('$ ENTER NUMBER TO CHANGE OR <CR> TO CONTINUE > ')
	IQ=0
	READ(5,9210,END=999)IQ,ANS
9210	FORMAT(Q,A1)
	IF(IQ.EQ.0)GOTO 303
	IF(ANS.EQ.'1')CALL FTYPE(TYP,INST,ITERM)
	IF(ANS.EQ.'2')CALL DISPL(ISP,ITERM)
	IF(ANS.EQ.'3')CALL AXISX(IX,INST,ITERM,TYP)
	IF(ANS.EQ.'4')CALL AXISY(DSP,ITERM)
	IF(ANS.EQ.'5')CALL FNUM(JSP,ITERM,ISP)
	IF(ANS.EQ.'6'.AND.ISP.GT.2)CALL FRACT(FR,YD,ISP,ITERM)
	IF(ANS.EQ.'7'.AND.DSP.GT.4)CALL DPTS(NDER,ITERM)
	IF(ANS.NE.'8') GO TO 302
      IF(IDPRC.NE.0) GO TO 301
	IDPRC=1
	GO TO 302
301   IDPRC=0
302	IF(ANS.EQ.'9')CALL DPM2(ITERM,INST)
      IF(JSP.GT.1) IDPRC=0
	GOTO200
C
303	CALL CLEAR(ITERM)
      IF(JSP.GT.1) GO TO 110
  304 WRITE(6,1000)
 1000 FORMAT(1H$,'FILENAME > ')
      READ(5,1010,END=999) IQ,(FN(1,I),I=1,30)
 1010 FORMAT(Q,30A1)
      IF(IQ.EQ.0) GO TO 304
      IJ=1
      CALL EXT(IQ,FN,IJ,D1,TYP)
      GO TO 120
  110 DO 130 I=1,JSP
  111 WRITE(6,1020) I
 1020 FORMAT(1H$,'FILENAME NUMBER ',I1,1X,'IS > ')
      READ(5,1010,END=999) IQ,(FN(I,J),J=1,30)
      IF(IQ.EQ.0) GO TO 111
      IJ=I
      CALL EXT(IQ,FN,IJ,D1,TYP)
  130 CONTINUE
  120 RETURN
  999 STOP
 9000 WRITE(6,2000)
 2000 FORMAT(1X,'SY0:SPECPLOT.DFT WAS NOT OPENED'/
     1' DOES IT EXISTS UNDER THIS UIC')
   99 STOP
      END
	SUBROUTINE FTYPE(TYP,INST,ITERM)
C
C  CHANGE FILE TYPE
C
	DOUBLE PRECISION SS(5)
	DIMENSION INST(2)
	BYTE TYP,ITERM
	DATA SS/'XRF.RAW ','XRD.RAW ','RIGAKU  ','ROOT.PKS','ROOT.SPC'/
C
50	CALL CLEAR(ITERM)
	TYPE *,' ***************** OPTIONS AVAILABLE ****************'
	TYPE *,' '
	DO 100 K=1,5
	WRITE(6,9000)K,SS(K)
9000	FORMAT('0',T10,I1,5X,A8)
100	CONTINUE
	DO 150 I=1,5
150	TYPE *,' '
	WRITE(6,9100)
9100	FORMAT('$ ENTER NUMBER OF OPTION DESIRED > ')
	IQ=0
	READ(5,9110,END=999)IQ,IANS
9110	FORMAT(Q,I1)
	IF(IQ.EQ.0)GOTO 999
	IF(IANS.LT.1.OR.IANS.GT.5)GOTO50
	TYP=IANS-2
	IF(TYP.LT.0)TYP=0
	IF(IANS.EQ.1)INST(1)='XR'
	IF(IANS.EQ.1)INST(2)='F '
	IF(IANS.EQ.2)INST(1)='DI'
	IF(IANS.EQ.2)INST(2)='F '
999	RETURN
	END
C
	SUBROUTINE DISPL(ISP,ITERM)
C
C  CHANGE DISPLAY OPTION
C
	DOUBLE PRECISION DD(5)
	BYTE ISP,ITERM
	DATA DD/'FULL    ','SPLIT   ','OVERLAY ','ADDITION','SUBTRACT'/
C
50	CALL CLEAR(ITERM)
	TYPE *,' '
	TYPE *,' *************  DISPLAYS AVAILABLE *******************'
	TYPE *,' '
	DO 100 K=1,5
	WRITE(6,9000)K,DD(K)
9000	FORMAT('0',T10,I1,5X,A8)
100	CONTINUE
	DO 150 I=1,5
150	TYPE *,' '
	WRITE(6,9100)
9100	FORMAT('$ ENTER NUMBER FOR OPTION DESIRED > ')
	IQ=0
	READ(5,9110,END=999)IQ,IANS
9110	FORMAT(Q,I1)
	IF(IQ.EQ.0)GOTO 999
	IF(IANS.LT.1.OR.IANS.GT.5)GOTO50
	ISP=IANS
999	RETURN
	END
C
	SUBROUTINE AXISX(IX,INST,ITERM,TYP)
C
C  CHANGE X-AXIS DISPLAY
C
	DOUBLE PRECISION X1(3)
	DIMENSION INST(2)
	BYTE IX,ITERM,TYP
	DATA X1/'2-THETA ','DSPACING','LAMBDA  '/
C
50	CALL CLEAR(ITERM)
	TYPE *,'  ***********  X-AXIS OPTIONS AVAILABLE  *****************'
	TYPE *,' '
	WRITE(6,9000)X1(1)
9000	FORMAT('0',T10,' 1 ',5X,A8)
	IF(TYP.EQ.0.AND.INST(1).EQ.'XR')WRITE(6,9010)X1(3)
	IF(TYP.EQ.0.AND.INST(1).NE.'XR')WRITE(6,9010)X1(2)
	IF(TYP.EQ.3.AND.INST(1).NE.'XR')WRITE(6,9010)X1(2)
	IF(TYP.EQ.3.AND.INST(1).EQ.'XR')WRITE(6,9010)X1(3)
9010	FORMAT('0',T10,' 2 ',5X,A8)
	IF(TYP.EQ.1.OR.TYP.EQ.2)WRITE(6,9010)X1(2)
100	CONTINUE
	DO 150 I=1,8
150	TYPE *,' '
	WRITE(6,9100)
9100	FORMAT('$ ENTER NUMBER OF OPTION DESIRED > ')
	IQ=0
	READ(5,9110,END=999)IQ,IANS
9110	FORMAT(Q,I1)
	IF(IQ.EQ.0)GOTO 999
	IF(IANS.LT.1.OR.IANS.GT.2)GO TO 50
	IX=IANS-1
999	RETURN
	END
C
	SUBROUTINE AXISY(DSP,ITERM)
C
C  CHANGE Y-AXIS DISPLAY
C
	DOUBLE PRECISION Y1(7)
	BYTE DSP,ITERM
	DATA Y1/'LINEAR  ','INTEGRAL','LOG     ','SQRT    ','SC 0-100'
     1	,'1ST DIFF','2ND DIFF'/
C
50	CALL CLEAR(ITERM)
	TYPE *,'************* Y-AXIS OPTIONS AVAILABLE ******************'
	TYPE *,' '
	DO 100 K=1,7
	WRITE(6,9000)K,Y1(K)
9000	FORMAT('0',T10,I1,5X,A8)
100	CONTINUE
	DO 150 I=1,5
150	TYPE *,' '
	IQ=0
	WRITE(6,9100)
9100	FORMAT('$ ENTER NUMBER FOR OPTION DESIRED > ')
	READ(5,9110,END=999)IQ,IANS
9110	FORMAT(Q,I1)
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.LT.1.OR.IANS.GT.7)GOTO50
	DSP=IANS-1
999	RETURN
	END
C
	SUBROUTINE FNUM(JSP,ITERM,ISP)
C
C CHANGE NUMBER OF FILES DISPLAYED
C
	BYTE JSP,ITERM,ISP
C
50	CALL CLEAR(ITERM)
	IF(ISP.GT.1)GO TO 200
	DO 100 I=1,5
100	TYPE *,' '
	TYPE *,'*****************************************************'
	TYPE *,'*                                                   *'
	TYPE *,'*    ONLY 1 FILE ALLOWED IN FULL SCREEN DISPLAY     *'
	TYPE *,'*                                                   *'
	TYPE *,'*****************************************************'
	DO 110 I=1,10
110	TYPE *,' '
	WRITE(6,9000)
9000	FORMAT('$ ENTER <CR> TO CONTINUE > ')
	READ(5,9010,END=999)IANS
9010	FORMAT(A2)
	GO TO 999
200	IF(ISP.GT.2)GO TO 300
	DO 210 I=1,5
210	TYPE *,' '
	TYPE *,'******************************************************'
	TYPE *,'*                                                    *'
	TYPE *,'*    ONLY 2 FILES ALLOWED IN SPLIT SCREEN DISPLAY    *'
	TYPE *,'*                                                    *'
	TYPE *,'******************************************************'
	DO 220 I=1,10
220	TYPE *,' '
	WRITE(6,9000)
	READ(5,9010,END=999)IANS
	GO TO 999
300	DO 310 I=1,5
310	TYPE *,' '
	TYPE *,'******************************************************'
	TYPE *,'*                                                    *'
	TYPE *,'*      MAXIMUM NUMBER OF FILES ALLOWED :   9         *'
	TYPE *,'*                                                    *'
	TYPE *,'******************************************************'
	DO 320 I=1,10
320	TYPE *,' '
	WRITE(6,9300)
9300	FORMAT('$ ENTER NUMBER OF FILES TO PROCESS > ')
	IQ=0
	READ(5,9310,END=999)IQ,IANS
9310	FORMAT(Q,I1)
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.LT.1.OR.IANS.GT.9)GO TO 50
	JSP=IANS
999	RETURN
	END
C
	SUBROUTINE FRACT(FR,YD,ISP,ITERM)
C
C  CHANGE EITHER FRACTION TO ADD/SUBTRACT OR DISPLACEMENT
C
	BYTE ISP,ITERM
50	CALL CLEAR(ITERM)
	IF(ISP.EQ.3)GO TO 500
	DO 100 I=1,5
100	TYPE *,' '
	TYPE *,'***************************************************'
	TYPE *,'*                                                 *'
	TYPE *,'*  FRACTION MUST BE A DECIMAL NUMBER LESS THAN 1  *'
	TYPE *,'*                                                 *'
	TYPE *,'***************************************************'
	DO 150 I=1,10
150	TYPE *,' '
	WRITE(5,9100)
9100	FORMAT('$ ENTER FRACTION OF ADDITIONAL FILE TO ADD/SUBTRACT > ')
	IQ=0
	READ(5,9110,END=999)IQ,ANS
9110	FORMAT(Q,F10.0)
	IF(IQ.EQ.0)GO TO 999
	IF(ANS.LT.0.OR.ANS.GT.1)GO TO 50
	FR=ANS
	GO TO 999
500	DO 510 I=1,5
510	TYPE *,' '
	TYPE *,'*****************************************************'
	TYPE *,'*                                                   *'
	TYPE *,'*     DISPLACEMENT IS FRACTION OF FULL SCREEN       *'
        TYPE *,'*      MUST BE DECIMAL NUMBER LESS THAN 1.0         *'
        TYPE *,'*                                                   *'
	TYPE *,'*****************************************************'
	DO 520 I=1,8
520	TYPE *,' '
	WRITE(6,9500)
9500	FORMAT('$ ENTER DISPLACEMENT FOR OVERLAY > ')
	IQ=0
	READ(5,9510,END=999)IQ,ANS
9510	FORMAT(Q,F10.0)
	IF(IQ.EQ.0)GO TO 999
	IF(ANS.GT.1.OR.ANS.LT.0)GO TO 50
	YD=ANS
999	RETURN
	END
C
	SUBROUTINE DPTS(NDER,ITERM)
C
C  CHANGE NUMBER OF POINTS FOR DERIVATIVE CALCULATION
C
	BYTE NDER,ITERM
50	CALL CLEAR(ITERM)
	DO 100 I=1,5
100	TYPE *,' '
	TYPE *,'**************************************************'
	TYPE *,'*                                                *'
	TYPE *,'*  # POINTS ALLOWED : 5, 7, 9, 11, 15, 19, 25    *'
	TYPE *,'*                                                *'
	TYPE *,'**************************************************'
	DO 150 I=1,10
150	TYPE *,' '
	WRITE(6,9200)
9200	FORMAT('$ ENTER NUMBER OF POINTS DESIRED > ')
	IQ=0
	READ(5,9210,END=999)IQ,IANS
9210	FORMAT(Q,I2)
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.EQ.5.OR.IANS.EQ.7.OR.IANS.EQ.9.OR.IANS.EQ.11.OR.IANS.EQ.15.
     1	OR.IANS.EQ.19.OR.IANS.EQ.25)NDER=IANS
999	RETURN
	END
C
	SUBROUTINE DPM2(ITERM,INST)
	INTEGER INST(2)
	COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF
     1	,NTP,SENS,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30),EXSTD(30)
      BYTE ITERM,ANS,DUM(30)
	DOUBLE PRECISION BS(3),ALPH2(3),STD(4)
	DIMENSION ANORM(2)
	DATA BS/'NONE    ','LINEAR  ','PARABOL.'/
	DATA ALPH2/'NONE    ','RACINGER','LADELL  '/
	DATA STD/'NONE    ','EXTERNAL','INTERNAL','EXT&INT '/
	DATA ANORM/'NO  ','YES '/
C
50	CALL CLEAR(ITERM)
	TYPE *,'  ***************** DATA REDUCTION OPTIONS ***************'
	TYPE *,' '
	WRITE(6,9001)BS(IBKGR+1)
9001	FORMAT('0',T5,' 1   BACKGROUND SUBTRACT ',T55,A8)
	WRITE(6,9010)ISCH
9010	FORMAT('0',T5,' 2   #PTS FOR SEARCH',T55,I2)
	IF(ISCH.EQ.0)GO TO 900
	WRITE(6,9020)SENS
9020	FORMAT('0',T5,' 3   SEARCH SENSITIVITY',T55,F5.2)
	WRITE(6,9030)IPF
9030	FORMAT('0',T5,' 4   #PTS FOR CENTROID FIT',T55,I2)
	WRITE(6,9040)NTP
9040	FORMAT('0',T5,' 5   #PTS FOR PEAK TOP SEARCH',T55,I2)
	IF(INST(1).EQ.'XR')GO TO 1000
	WRITE(6,9050)ANORM(INRM+1)
9050	FORMAT('0',T5,' 6   NORMALIZE INTENSITY',T55,A4)
	WRITE(6,9060)STD(ISTD+1)
9060	FORMAT('0',T5,' 7   STANDARDIZATION',T55,A8)
	IF(ISTD.EQ.1.OR.ISTD.EQ.3)WRITE(6,9061)EXSTD
9061	FORMAT(T12,'EXTERNAL STANDARD FILENAME',T45,30A1)
	IF(ISTD.EQ.2.OR.ISTD.EQ.3)WRITE(6,9065)INSTD,E2T
9065	FORMAT(T12,'INTERNAL STANDARD FILENAME',T45,30A1,/
     1  ,T12,'MATCH ERROR'T45,F4.2)
	IF(IBKGR.EQ.0)GO TO 1000
900	WRITE(6,9070)ALPH2(IK2+1)
9070	FORMAT('0',T5,' 8   K ALPHA2 ELIMINATION',T55,A8)
C
1000	TYPE *,' '
	WRITE(6,9200)
9200	FORMAT('$ ENTER NUMBER TO CHANGE OR <CR> TO CONTINUE > ')
	IQ=0
	READ(5,9210,END=999)IQ,ANS
9210	FORMAT(Q,A1)
	IF(IQ.EQ.0)GO TO 999
C
	IF(ANS.EQ.'1')CALL MBKG(IBKGR,ITERM)
	IF(ANS.EQ.'2')CALL MSRCH(ISCH,ITERM)
	IF(ANS.EQ.'3')CALL MSEN(SENS,ITERM)
	IF(ANS.EQ.'4')CALL MFIT(IPF,ITERM)
	IF(ANS.EQ.'5')CALL MFIT(NTP,ITERM)
	IF(ANS.NE.'6')GO TO 500
	IF(INRM.NE.0)GO TO 400
	INRM=1
	GO TO 50
400	INRM=0
	GO TO 50
500	IF(ANS.EQ.'7')CALL MSTAND(ISTD,EXSTD,E2T,INSTD,ITERM)
	IF(ANS.EQ.'8')CALL MALPHA(IK2,ITERM)
C
	GO TO 50
999	RETURN
	END
C
	SUBROUTINE MALPHA(IK2,ITERM)
C
C  K ALPHA 2 ELIMINATION
C
	DOUBLE PRECISION ALPH2(3)
	BYTE IK2,ITERM
	DATA ALPH2/'NONE    ','RACINGER','LADELL  '/
C
50	CALL CLEAR(ITERM)
	TYPE *,'   ********* K ALPHA2 ELIMINATION OPTIONS ***********'
	TYPE *,' '
	DO 100 I=1,3
	WRITE(6,9000)I-1,ALPH2(I)
9000	FORMAT('0',T10,I1,5X,A8)
100	CONTINUE
	DO 200 I=1,5
200	TYPE *,' '
	WRITE (6,9200)
9200	FORMAT('$ ENTER OPTION NUMBER DESIRED > ')
	IQ=0
	READ(5,9210,END=999,ERR=999)IQ,IANS
9210	FORMAT(Q,I1)
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.LT.0.OR.IANS.GT.2)GO TO 50
	IK2=IANS
999	RETURN
	END
C
	SUBROUTINE MSTAND(ISTD,EXSTD,E2T,INSTD,ITERM)
C
C  STANDARDIZATION
C
	DOUBLE PRECISION STD(4)
	BYTE ITERM,ISTD
	BYTE INSTD(30),EXSTD(30),DUM(30)
	DATA STD/'NONE    ','EXTERNAL','INTERNAL','EXT&INT '/
C
50	CALL CLEAR(ITERM)
	TYPE *,'  ******** STANDARDIZATION OPTIONS AVAILABLE ********'
	TYPE *,' '
	DO 200 I=1,4
	WRITE(6,9000)I-1,STD(I)
9000	FORMAT('0',T10,I1,5X,A8)
200	CONTINUE
	DO 210 I=1,5
210	TYPE *,' '
	WRITE(6,9200)
9200	FORMAT('$ ENTER NUMBER OF OPTION DESIRED > ')
	IQ=0
	IANS=0
	READ(5,9210,END=999,ERR=999)IQ,IANS
9210	FORMAT(Q,I1)
	IF(IQ.EQ.0)GO TO 800
	IF(IANS.LT.0.OR.IANS.GT.3)GO TO 50
	ISTD=IANS
800	IF(ISTD.EQ.0)GO TO 999
	DO 801 I=1,30
801	DUM(I)=' '
	CALL CLEAR(ITERM)
	TYPE *,'   **** STANDARDIZATION CONDITIONS ****  '
	TYPE *,' '
	IF(ISTD.EQ.2.OR.ISTD.EQ.3)WRITE(6,9800)INSTD
9800	FORMAT('0',T5,'1 - INTERNAL STANDARD FILENAME',T40,30A1)
	IF(ISTD.EQ.2.OR.ISTD.EQ.3)WRITE(6,9810)E2T
9810	FORMAT('0',T5,'2 - MATCH ERROR',T40,F4.2)
	IF(ISTD.EQ.1.OR.ISTD.EQ.3)WRITE(6,9820)EXSTD
9820	FORMAT('0',T5,'3 - EXTERNAL STANDARD FILENAME',T40,30A1)
	DO 810 I=1,5
810	TYPE *,' '
	WRITE(6,9850)
9850	FORMAT('$ ENTER NUMBER OF OPTION TO CHANGE > ')
	IQ=0
	IANS=0
	READ(5,9210,END=999,ERR=999)IQ,IANS
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.NE.1)GO TO 850
	CALL CLEAR(ITERM)
	DO 830 I=1,5
830	TYPE *,' '
	IQ=0
	WRITE(6,9830)
9830	FORMAT('$ INTERNAL STANDARD FILENAME OR PDF# > ')
	READ(5,9835,END=999,ERR=999)IQ,DUM
9835	FORMAT(Q,30A1)
	IF(IQ.EQ.0)GO TO 800
	DO 835 I=1,30
835	INSTD(I)=DUM(I)
	INSTD(IQ+1)=0
	GO TO 800
850	IF(IANS.NE.2)GO TO 870
	CALL CLEAR(ITERM)
	DO 855 I=1,5
855	TYPE *,' '
	WRITE(6,9855)
9855	FORMAT('$ ENTER MATCH ERROR > ')
	X=0.
	READ(5,9856,END=999,ERR=999)X
9856	FORMAT(F8.0)
	IF(X.GT.0)E2T=X
	GO TO 800
870	IF(IANS.NE.3)GO TO 800
	CALL CLEAR(ITERM)
	DO 875 I=1,5
875	TYPE *,' '
	WRITE(6,9875)
9875	FORMAT('$ EXTERNAL STANDARD FILENAME > ')
	IQ=0
	READ(5,9835,ERR=999,END=999)IQ,DUM
	IF(IQ.EQ.0)GO TO 800
	DO 890 I=1,30
890	EXSTD(I)=DUM(I)
	EXSTD(IQ+1)=0
	GO TO 800
999	RETURN
	END
C
	SUBROUTINE MFIT(IFIT,ITERM)
C
C  #POINTS FOR CENTROID OR PEAK TOP SEARCH
C
	BYTE ITERM
	CALL CLEAR(ITERM)
	DO 100 I=1,5
100	TYPE *,' '
	IANS=0
	WRITE(6,9000)
9000	FORMAT('$ ENTER NUMBER OF POINTS FOR SEARCH > ')
	READ(5,9010,END=999,ERR=999)IANS
9010	FORMAT(I2)
	IF(IANS.GT.0)IFIT=IANS
999	RETURN
	END
C
	SUBROUTINE MSEN(SENS,ITERM)
C
C  SEARCH SENSITIVITY
C
	BYTE ITERM
	CALL CLEAR(ITERM)
	DO 100 I=1,5
100	TYPE *,' '
	ANS=0.
	WRITE(6,9000)
9000	FORMAT('$ ENTER SENSITIVITY FOR SEARCH > ')
	READ(5,9010,END=999,ERR=999)ANS
9010	FORMAT(F8.0)
	IF(ANS.GT.0)SENS=ANS
999	RETURN
	END
C
	SUBROUTINE MSRCH(ISCH,ITERM)
C
C    CHANGE #PTS FOR SECOND DERIVATIVE SEARCH
C
	BYTE ISCH,ITERM
50	CALL CLEAR(ITERM)
	DO 100 I=1,5
100	TYPE *,' '
	TYPE *,'***************************************************'
	TYPE *,'*                                                 *'
	TYPE *,'*   # POINTS ALLOWED : 5, 7, 9, 11, 15, 19, 25    *'
	TYPE *,'*                                                 *'
	TYPE *,'*      ENTER 0 TO CANCEL SEARCH                   *'
	TYPE *,'*                                                 *'
	TYPE *,'***************************************************'
	DO 150 I=1,5
150	TYPE *,' '
	WRITE(6,9200)
9200	FORMAT('$ ENTER NUMBER OF POINTS DESIRED > ')
	IQ=0
	READ(5,9210,END=999)IQ,IANS
9210	FORMAT(Q,I2)
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.EQ.0.OR.IANS.EQ.5.OR.IANS.EQ.7.OR.IANS.EQ.9.OR.IANS.EQ.11.
     1   OR.IANS.EQ.15.OR.IANS.EQ.19.OR.IANS.EQ.25)ISCH=IANS
999	RETURN
	END
C
	SUBROUTINE MBKG(IBKGR,ITERM)
	DOUBLE PRECISION BK(3)
	BYTE ITERM,IBKGR
	DATA BK/'NONE    ','LINEAR  ','PARABOL.'/
C
50	CALL CLEAR(ITERM)
	DO 60 I=1,5
60	TYPE *,' '
	TYPE *,'  ***** BACKGROUND SUBTRACT OPTIONS AVAILABLE *****'
	TYPE *,' '
	DO 100 J=1,3
	WRITE(6,9000)J-1,BK(J)
9000	FORMAT('0',T10,1X,I1,6X,A8)
100	CONTINUE
	DO 150 I=1,5
150	TYPE *,' '
	WRITE(6,9200)
9200	FORMAT('$ ENTER NUMBER FOR OPTION DESIRED > ')
	IQ=0
	READ(5,9210,END=999)IQ,IANS
9210	FORMAT(Q,I1)
	IF(IQ.EQ.0)GO TO 999
	IF(IANS.LT.0.OR.IANS.GT.2)GO TO 50
	IBKGR=IANS
999	RETURN
	END
C
      SUBROUTINE EXT(IQ,FN,IJ,VOL,TYP)
C
      BYTE FN(9,30),VOL(12),F(30),TYP
C
      DO 210 I=1,30
  210 F(I)=FN(IJ,I)
      J=0
      L=0
      DO 100 I=1,30
      IF(F(I).EQ.':') J=I
      IF(F(I).EQ.'.') L=I
  100 CONTINUE
      IF(J.GT.0) GO TO 110
      DO 120 I=1,12
  120 F(I)=VOL(I)
      N=1
      DO 130 I=13,30
      F(I)=FN(IJ,N)
  130 N=N+1
      IQ=IQ+12
  110 IF(L.GT.0) GO TO 140
      IF(TYP.GT.1) GO TO 111
      F(IQ+1)='.'
      F(IQ+2)='R'
      F(IQ+3)='A'
      F(IQ+4)='W'
      F(IQ+5)=0
      GO TO 160
  111 IF(TYP.NE.2) GO TO 112
      F(IQ+1)='.'
      F(IQ+2)='P'
      F(IQ+3)='K'
      F(IQ+4)='S'
      F(IQ+5)=0
      GO TO 160
  112 IF(TYP.NE.3) GO TO 999
      F(IQ+1)='.'
      F(IQ+2)='S'
      F(IQ+3)='P'
      F(IQ+4)='C'
      F(IQ+5)=0
      GO TO 160
  140 F(IQ+1)=0
      IF(F(L+1).EQ.'P'.AND.F(L+2).EQ.'K') TYP=2
      IF(F(L+1).EQ.'S'.AND.F(L+2).EQ.'P') TYP=3
  160 CONTINUE
      DO 200 I=1,30
  200 FN(IJ,I)=F(I)
      IF(TYP.EQ.2) DSP=4
      RETURN
  999 WRITE(5,1000) F,TYP
 1000 FORMAT(1X,'PROB IN EXT SUB WITH FILE ',30A1,'  TYP=',I1)
      STOP 'PROBLEM LOOK IN EXT OF MODULE MENU'
      END
C
C
      SUBROUTINE DFAULT(FN,DSP,IG,YD,ITERM,TYP,IX,D1,D2,D3,D4,LOGO,FR,VER,DLT
     1,INST)
C
      INTEGER INST(2)
C   READS SY0:SPECPLOT.DFT TO GET DEFAULT CONDITIONS
C
      COMMON /SCN/ XS,XF,YS,YF,XXS,XXF,YYS,YYF,CSTR,CFIN,CYMIN,CYMAX,STR
     1,FIN,YMIN,YMAX,ZZ,CW,CH,ISP,JSP,IFL
      COMMON /COLOR/ CL,CLB,CLA,CLG
      COMMON /DPRC/ IDPRC,IBKGR,ISCH,INRM,ISTD,NDER,MF,MB,IK2,ISM,IPF,NTP,SENS
     1,INSTD,EXSTD,E2T
C
      BYTE IBKGR,IK2,ISCH,INRM,IDPRC,ISTD,NDER,MF,MB,ISM,INSTD(30),EXSTD(30)
      BYTE CL,CLB,CLA,CLG(5),DLT(5)
      BYTE ISP,JSP,DSP,IG,ITERM,IX,IFL,JIN,CW,CH,TYP
      BYTE FN(9,30),ANS
      BYTE D1(12),D2(12),D3(12),D4(12),LOGO(12),VER(72)
C
C
C  LU-1 DEFAULT FILE ON SY0:
C
C  TYP IS FILE TYPE SPECPLOT OR RIGAKU
C  TYP=0 SPECPLOT BINARY FILE
C  TYP=1 RIGAKU BINARY FILE
C  TYP=3 RIGAKU PKS FILE
C  TYP=4 SPECPLOT ROOT.SPC FILE
C
C  D1 IS DISK VOL WITH DATA FILES
C  D2 IS DISK VOL WITH JCPDS DATA BASE
C  D3 IS DISK VOL WITH ELEMENTAL DATA BASE
C  D4 IS DISK VOL OF HELP FILES (D4:CHART.HLP)
C
C  IDPRC  ONLINE DATA PROCESSING (0-NO  1-YES)
C  IBKGR=0 NONE
C  IBKGR=1 LINEAR BKGR
C  IBKGR=2 PARABOLIC BKGR
C  MB NUMBER BACK  AND MF NUMBER FORWARD  FOR BKGR SUBTRACTION
C  ISCH=0 NONE
C  ISCH>0 NUMBER OF PTS TO CALCULATE 2ND DERIVATIVE OVER (SMOOTH)
C  NTP NUMBER OF PTS FOR PEAK TOP SEARCH
C  INRM=0 NONE
C  INRM=1 NORMALIZE DATA
C  ISTD=0 NONE
C  ISTD=1 EXTERNAL STD
C  ISTD=2 INTERNAL STD (INTERNAL.STD)
C  ISTD=3 EXTERNAL & INTERNAL STD (EXTERNAL.STD & INTERNAL.STD)
C
C  ISM=0 NO REAL DATA SMOOTH
C  ISM>0 NUMBER OF PTS TO SMOOTH OVER
C  NDER  NUMBER OF PTS TO TAKE DERIVATIVE OVER 5,7,9,11,15,19,25
C  IK2=0 NO K ALPHA ELIMINATION
C  IK2=1 RACINGER
C  IK2=2 LADELL
C
C  DLT(I) = 0 KEEP FILE     =1 DELETE FILE
C  DLT(1)   *.MAT
C  DLT(2)  *.SPC
C  DLT(3)   *.DIF
C  DLT(4)   *.DSP
C  DLT(5)   *.BKG
C
      OPEN(UNIT=1,NAME='SY0:SPECPLOT.DFT',FORM='FORMATTED',ACCESS='SEQUENTIAL'
     1,SHARED,TYPE='OLD',ERR=9000)
C
      READ(1,90,END=999) VER  ! VERSION OF SPECPLOT CURRENTLY BEING USED
   90 FORMAT(72A1)
      READ(1,91,END=999)INST  ! SPECPLOT INSTRUMENT TYPE
91    FORMAT(2A2)
      READ(1,101,END=999) LOGO
  101 FORMAT(12A1)
      READ(1,100,END=999) D1,D2,D3,D4
  100 FORMAT(12A1,1X,12A1,1X,12A1,1X,12A1)
      READ(1,102) CLB,CLA,CLG
  102 FORMAT(7I2)
      READ(1,*) TYP   ! FILE TYPE
      READ(1,*) ITERM! TERMINAL TYPE
      READ(1,*) DSP ! DISPLAY OPTION LINEAR-0, INTEGRAL-1, LOG-2, SQRT-3
C NORMALIZE -4, 1ST DERIVATIVE -5, 2ND DERIVATIVE -6
      READ(1,*) IG ! GRID LINES IG=1
      READ(1,*) ISP ! FULL-SCREEN, SPLIT-SCREEN, OVERLAY, ADD, SUBSTRACT
      READ(1,*) JSP ! NUMBER OF SPECTRUM BEING DISPLAYED
      READ(1,*) IX ! 2THETA OR DSPACING
      READ(1,*) YD ! DISPLACEMENT AS FRACTION OF SCREEN
      READ(1,*) IDPRC  ! DATA PROCESSING
      READ(1,*) IPF  ! NUMBER OF PTS FOR CENTROID TYPE FIT ALSO USED FOR P
      READ(1,*) IBKGR  ! BKGR SUBTRACT
      READ(1,*) MF,MB  ! NUMBER FORWARD,NUMBER BACK FOR BKGR
      READ(1,*) ISCH   ! PEAK SEARCH
      READ(1,*) SENS   ! 2ND DER PEAK SEARCH SENSITIVITY
      READ(1,*) NTP    ! NUMBER OF PTS FOR PEAK TOP SEARCH
      READ(1,*) INRM   ! NORMALIZE XRD ONLY
      READ(1,*) ISTD   ! INTERNAL AND/OR EXTERNAL CORRECTION
      READ(1,*) NDER   ! NUMBER OF PTS FOR DERIVATIVE
      READ(1,*) E2T    ! MATCH ERROR FOR INTERNAL STD CORRECTION
      READ(1,210,END=900) DLT   ! DELETE FILES ON CLOSING
  210 FORMAT(I1,1X,I1,1X,I1,1X,I1,1X,I1)
      READ(1,200,END=900) IQ,INSTD   ! INTERNAL STD FILENAME, OR PDF#
  200 FORMAT(Q,30A1)
      INSTD(IQ+1)=0
      READ(1,200,END=900) IQ,EXSTD   ! EXTERNAL STD FILENAME IE POLY COEFF.
      EXSTD(IQ+1)=0
  900 CLOSE(UNIT=1)
      FR=1.0  ! FRACTION FOR ADDITION AND SUBTRACTION
      RETURN
C
999   STOP
9000  WRITE(6,2000)
2000  FORMAT(1X,'SY0:SPECPLOT.DFT WAS NOT OPENED'/
     1 ' DOES IT EXIST UNDER THIS UIC')
99    STOP
      END
