C*************************************************************************
	SUBROUTINE WAVESEL(IW,IRAD,WAVE,wka1,wka2,*,li,lo,prompt)
C*************************************************************************
C	Selects a wavelength 
C
C Command format:
C	WAVELENGTH 
C	WAVELENGTH wave_length
C	WAVELENGTH [/TARGET=target_type] [/WTYPE=wavelength_option]
C*************************************************************************
	REAL WAVE,WKA1,WKA2
	INTEGER*2 IRAD
	logical PROMPT
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,DEF_LOGICAL,GET_FNUMBER
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
	CHARACTER*60 PARM
	INTEGER LEN
	CHARACTER*11 LGPRC
	PARAMETER (LGPRC='LNM$PROCESS')

C /TARGET qualifier
	IRAD = '  '
	IF (CLI$PRESENT('TARGET') .eq. %LOC(CLI$_PRESENT)) THEN 
	  IRAD = 'CU'
	  FLAG = CLI$GET_VALUE('TARGET',parm,len)
	  IF (len .eq. 2 .and. flag) then 
	    read(unit=parm(1:len),fmt='(a2)') IRAD
	    CALL WAVESET(IRAD,WAVE,WKA1,WKA2,*3)
	  ELSEIF (PROMPT) THEN 
	    CALL WAVEINQ(lo,li,IRAD,WAVE,WKA1,WKA2,*3)
	  ENDIF
C /NOTARGET qualifier (==> d-space mode)
	ELSEIF (CLI$PRESENT('TARGET') .eq. %LOC(CLI$_NEGATED)) THEN 
	  WAVE = 0
	  goto 1
C is there a wavelength value present?
	ELSEIF (CLI$PRESENT('WAVE_LENGTH')) THEN 
	  FLAG = GET_FNUMBER('WAVE_LENGTH',WLT)
	  IF (FLAG) then
	    write (lo,'(A)') ' WAVESEL ERROR -- UNABLE TO READ WAVELENGTH'
	    RETURN 1
C    WAVELENGTH = 0.0 (==> d-space mode)
	  ELSEIF (WLT .eq. 0.) then
	    WAVE = 0
	  ELSE
	    IRAD = 'SY'
	    WAVE = WLT
	    WKA1 = WLT
	    WKA2 = WLT
	    IW = 0
	  ENDIF 
	  goto 1
	ELSEIF (PROMPT) THEN
	  WRITE(lo,9001)
9001	  FORMAT(' Should card(s) be output in DSPACE(D) or 2THETA(T)',
	1	' units?',/,'$Type D or T [Default:D] > ')
	  READ(li,'(A1)',END=1) NF
	  IF(NF.EQ.'T' .or. NF.EQ.'t') then
	    IRAD = '  '
	    CALL WAVEINQ(lo,li,IRAD,WAVE,WKA1,WKA2,*3)
	  ELSE
	    WAVE = 0
	    goto 1
	  ENDIF
	ENDIF

C If we are now here, 2T's have been selected, is this radiation split?
22	WAVE=WKA1
	IF (WKA1 .eq. WKA2) THEN
	  IW = 0
	ELSE
C WTYPE qualifier
	  IF (CLI$PRESENT('WTYPE')) THEN 
	    FLAG = GET_NUMBER('WTYPE',IW)
	  ELSEIF(PROMPT) THEN
271	    WAVE=(2.*WKA1 + WKA2)/3.
	    WRITE (LO,9319) 1,IRAD,WKA1,IRAD,WKA2,IRAD,WAVE
9319	    FORMAT ('$Enter wavelength choice: [Default=',i1,']',/,
	1	' 	1 for ',A2,' K alpha 1 (w=',F9.6,'A)',/,
	2	' 	2 for ',A2,' K alpha 2 (w=',F9.6,'A)',/,
	3	' 	3 for ',A2,' K alpha bar (weighted avg of 1+2, (w=',
	4	F9.6,'A)',/,
	4	'$Wavelength index ([1]/2/3): ')
	    READ (LI,fmt='(I)',err=271) IW
	  ENDIF
	  IF (IW .EQ. 2) THEN 
	    WAVE=WKA2
	  ELSEIF (IW .EQ. 3) THEN 
	    WAVE=(2.*WKA1 + WKA2)/3.
	  ELSEIF (IW .EQ. 1) THEN 
	    WAVE=WKA1
	  ELSE
	    IW = 1
	    WAVE=WKA1
	  ENDIF
	ENDIF
1	IF (wave .eq. 0) THEN 
	  parm = '0.0'
	ELSEIF (IW .eq. 0) then 
	  write(parm,'(f9.6)') wave
	ELSE
	  write(parm,'(a2,i1)') IRAD,IW
	ENDIF
	len = lench(parm)
	flag = DEF_LOGICAL('PS_WAVELENGTH',parm(1:len),len,1,lgprc)
	RETURN
C---------------------------------------------------------------------------
3	write (lo,'(a)') ' WAVESEL ERROR -- incorrect wavelength entered'
	IF (PROMPT) THEN 
	  CALL WAVEINQ(lo,li,IRAD,WAVE,WKA1,WKA2,*33)
	  goto 22
	ENDIF
33	RETURN 1
	END
C*************************************************************************
	SUBROUTINE WAVEGET(IW,IRAD,WAVE,WKA1,WKA2)
C*************************************************************************
C Subroutine to set the wavelength according to logical name PS_WAVELENGTH
C if PS_WAVELENGTH is not defined, the WAVE is set to 0.0 (d-space mode)
C*************************************************************************
	REAL WAVE,WKA1,WKA2
	INTEGER*2 IRAD
	LOGICAL flag,GET_LOGICAL
	CHARACTER*60 PARM
	INTEGER LEN
	CHARACTER*11 LGPRC
	PARAMETER (LGPRC='LNM$PROCESS')
C check if SEARCH file is defined, if so read the file
	flag = GET_LOGICAL('PS_WAVELENGTH',parm,60,len,lgprc)
	if (.not. flag .or. len .lt. 3) goto 30

C check if the first two letters match a known wavelength
	read(parm,'(a2,i1)',err=20) irad,IW
	CALL WAVESET(IRAD,WAVE,WKA1,WKA2,*20)
	IF (IW .EQ. 2) THEN 
	  WAVE=WKA2
	ELSEIF (IW .EQ. 1) THEN 
	  WAVE=WKA1
	ELSE
	  IW = 3
	ENDIF
	RETURN

C Error reading the wavelength or invalid type
20	read(parm,'(f9.6)',err=30) wave
	IRAD = 'SY'
	WKA1 = WAVE
	WKA2 = WAVE
	RETURN
	
30	WAVE = 0.0
	IRAD = '  '
	RETURN
	END
C**************************************************************************
	SUBROUTINE WAVESET(IRAD,WAVE,WKA1,WKA2,*)
C	CONVERT A WAVELENGTH SYMBOL TO ACTUAL WAVELENGTH VALUE(S)
C this is to replace subroutine WAVELT
C
C**************************************************************************
	PARAMETER(nwave=7)
C be sure to keep the list the same in WAVEINQ below
	INTEGER*2 IWL(nwave)
	DATA IWL/'MO','CU','NI','CO','FE','CR','AG'/
	DIMENSION WLS1(nwave),WLS2(nwave)
	INTEGER*2 IRAD
C
C	LIST INCLUDES LATEST VALUE FOR CUKA1 AND MOKA1 FROM
C	PHYSICAL REVIEW LETTERS (1973), 31, P.972-975.
C	OTHER VALUES ARE OLDER ONES.
C
	DATA WLS1/.70932,1.540598,1.65783,1.78890,1.93597,2.28962,.559363/
	DATA WLS2/.71354,1.54434,1.66168,1.79279,1.93991,2.29352,.563775/
C Convert lowercase characters to uppercase
	CALL UPCASE(IRAD,2)
	DO 2 NWL=1,nwave
	  IF (IRAD.EQ.IWL(NWL)) THEN 
	    WKA1=WLS1(NWL)
	    WKA2=WLS2(NWL)
	    WAVE=(WLS1(NWL)*2.0+WLS2(NWL))/3.0
	    RETURN
	  ENDIF
2	CONTINUE
C the symbol was not recognized
	RETURN 1
	END
C**************************************************************************
	SUBROUTINE WAVEINQ(lo,li,IRAD,WAVE,WKA1,WKA2,*)
C     GET WAVELENGTH SYMBOL USING PROMPTED I/O; CONVERT TO ACTUAL 
C     WAVELENGTH VALUE(S)
C this is to replace subroutine WAVELT
C**************************************************************************
	PARAMETER(nwave=7)
	INTEGER*2 IRAD
C be sure to keep the list the same in WAVESET above
	INTEGER*2 IWL(nwave)
	DATA IWL/'Mo','Cu','Ni','Co','Fe','Cr','Ag'/
1	WRITE(LO,10)
10 	FORMAT('$Enter chemical symbol of X-ray target (or ? for list) ',
	1	'[Default=Cu]: ')
	IRAD = '  '
	READ (LI,'(A2)',END=11) IRAD
	IF (IRAD.EQ.'?') then
	  write(lo,'(A,<nwave+2>(1x,a2)/)') ' Defined targets are: ',
	1	(iwl(i),i=1,nwave),'SY','NU'
	  goto 1
	endif
11	IF (IRAD.EQ.'  ') IRAD='CU'
C Convert lowercase characters to uppercase
	CALL UPCASE(IRAD,2)
	IF (IRAD .EQ. 'NU' .or. IRAD .EQ. 'SY') THEN 
272	  WRITE(LO,32)
32	  FORMAT ('$ENTER WAVELENGTH: ')
	  READ (LI,'(f10.0)',err=272) WAVE
	  WKA1=WAVE
	  WKA2=WAVE
	ELSE
	  CALL WAVESET(IRAD,WAVE,WKA1,WKA2,*3)
	ENDIF
	RETURN
3	RETURN 1
	END
C*************************************************************************
	SUBROUTINE DELMODESEL(DELETED,*,li,lo,prompt)
C*************************************************************************
C	Selects a mode for use of deleted patterns
C
C Command format:
C	DELETED/INCLUDE
C	DELETED/EXCLUDE
C	DELETED
C*************************************************************************
	LOGICAL DELETED
	logical PROMPT
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,DEF_LOGICAL,GET_FNUMBER
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
	CHARACTER*60 PARM
	INTEGER LEN
	CHARACTER*11 LGPRC
	PARAMETER (LGPRC='LNM$PROCESS')

C /INCLUDE qualifier
	IF (CLI$PRESENT('INCLUDE') .eq. %LOC(CLI$_PRESENT)) THEN 
	  DELETED = .TRUE.
C /EXCLUDE qualifier
	ELSEIF (CLI$PRESENT('EXCLUDE') .eq. %LOC(CLI$_PRESENT)) THEN 
	  DELETED = .FALSE.
C ask for a value
	ELSE
	  WRITE(lo,'(A)') '$Include deleted patterns? (Y/[N]): '
	  read(LI,'(A1)',err=3) ians
	  IF (IANS .eq. 'y' .or. IANS .eq. 'Y') THEN
	    DELETED = .TRUE.
	  ELSE
	    DELETED = .FALSE.
	  ENDIF
	ENDIF

	IF (DELETED) THEN
	  flag = DEF_LOGICAL('PS_DELETED','TRUE',4,1,lgprc)
	  WRITE(lo,'(A)') ' ',
	1	' *** Using deleted patterns in processing ***',' '
	ELSE
	  flag = DEF_LOGICAL('PS_DELETED','FALSE',5,1,lgprc)
	  WRITE(lo,'(A)') ' ',
	1	' *** Omitting deleted patterns in processing ***',' '
	ENDIF
	RETURN
C---------------------------------------------------------------------------
3	write (lo,'(a)') ' DELMODSEL ERROR'
	RETURN 1
	END
C*************************************************************************
	SUBROUTINE DELMODEGET(DELETED)
C*************************************************************************
C Subroutine to set the DELETED Flag according to logical name PS_DELETED
C if PS_DELETED is not defined, DELETED is set to FALSE (don't use them)
C*************************************************************************
	LOGICAL DELETED
	LOGICAL flag,GET_LOGICAL
	CHARACTER*60 PARM
	INTEGER LEN
	CHARACTER*11 LGPRC
	PARAMETER (LGPRC='LNM$PROCESS')
	DELETED = .FALSE.
C check if logical is defined, if so read it
	flag = GET_LOGICAL('PS_DELETED',parm,60,len,lgprc)
	if (.not. flag .or. len .lt. 1) RETURN
	READ (parm(1:1),'(L)',err=3) DELETED
	RETURN
3	WRITE(lo,'(A)') ' ',
	1	' *** PS_DELETED has an unexpected value ***',' '
	RETURN
	END
