	PROGRAM CMPR
C---------------------------------------------------------------------------
C Copyright 1988,1989,1990,1991,1992 by Brian H. Toby, E. I. du Pont de 
C Nemours and Co., and Air Products and Chemicals, Inc.
C
C Permission is granted for unlimited use, distribution and modification 
C of this manual and associated software, provided that modified software 
C and software based on this code must also be made freely available.
C---------------------------------------------------------------------------
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,GET_FNUMBER,flag,GET_LOGICAL,DEF_LOGICAL
        INTEGER  DEVCLASS, LIB$GETDVI
C can we avoid including $RMSDEF to define 1 symbol (RMS$_EOF)? 
C yes, but remember use an EXTERNAL & to change the reference to use a %LOC()
	EXTERNAL RMS$_EOF,SS$_NORMAL,DC$_TERM,DVI$_DEVCLASS
C the same goes for all of the above VMS symbols
	EXTERNAL LIB$GET_INPUT,CMPR_SUBCOMMANDS
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
	INTEGER*4 OLDHANDLER/-1/,LIB$ESTABLISH
	EXTERNAL ERRHAND
	CHARACTER*20 PARM,string*40,filename*80
	CHARACTER*2 suffix(0:9)
	data suffix/'  ','_1','_2','_3','_4','_5','_6','_7','_8','_9'/
	CHARACTER*4 command,ans*1
C    LOGICAL UNIT ASSIGNMENTS:
C	1	LO	TERMINAL OUTPUT
C	2	LI	TERMINAL INPUT
C	3	IN	(used in subroutines)
C	3	OUT	(used in subroutines)
C	14	LUNM	used for JCPDS
C	15	LPDF	used for JCPDS
C	16	LUNN	used for JCPDS
C	21	CMDIN	FILE CONTAINING LOGIC COMMANDS
	INTEGER CMDIN/21/
	LOGICAL CMDFL/.FALSE./
	CHARACTER*200 CMDSTR
C
	include 'cmpr.common/list'
	include '[-.shared]jcpds.parms/list'

	CHARACTER*1 QM
	REAL FCOR
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	INTEGER*4 CARDNO

	CHARACTER*80 fil_trunc
	INTEGER files(M$FIL),numf,ifil(M$FIL)
	INTEGER ln
	byte rem_zero
	CHARACTER*25	dataform,peakform
	logical ASKFL
	INTEGER IVAL(6)
	REAL FVAL(2)
C-----------------------------------------------------------------------
C Check if we are running CMPR from a terminal?
	CALL ASSIGN (LI,'SYS$INPUT')
	CALL ASSIGN (LO,'SYS$OUTPUT')
	STATUS = LIB$GETDVI(%LOC(DVI$_DEVCLASS),,
	1	'SYS$INPUT',DEVCLASS,string,ln)
	PROMPT = .FALSE.
	DEFAULT = .TRUE.
	IF (STATUS .EQ. %LOC(SS$_NORMAL) .and. 
	1	DEVCLASS .eq. %LOC(DC$_TERM)) then
	  PROMPT = .TRUE.
	  DEFAULT = .FALSE.
	ENDIF
C if this is a terminal, prompt for graphics type (& Open for graphics)
	ICRT = 0
	IF (PROMPT) CALL SETCRT(ICRT,lo,li,ANSI)
C Establish an alternate error handler
	IF (OLDHANDLER .eq. -1) OLDHANDLER = LIB$ESTABLISH(ERRHAND)
C determine the starting wavelength
	CALL WAVEGET(IW0,irad0,wave0,WAVE1,WAVE2)
C open the JCPDS-ICDD database 
	CALL PDF1OPEN(LUNM,LPDF,LUNN,PDFSTAT)
C-----------------------------------------------------------------------
C Display welcome message and pause
	write(lo,'(20x,A/)') '* * * Welcome to Program CMPR * * *'
	CALL COPYRGT(lo,PDFSTAT,.false.)
C get defaults, if any
	CALL LOADDEFS(STATUS)
C-----------------------------------------------------------------------
C read files defined with a logical name
	DO I=0,M$FIL-1
	  filename = ' '
	  parm = 'CMPR_FILE'//suffix(I)
	  flag = GET_LOGICAL(parm(:lench(parm)),filename,80,ln,lgprc)
	  if (flag .and. ln .gt. 0) then
C try to read data & peaks 
	    call READDATA(filename,MFILE+1,STATUS,.true.,.true.,
	1	dataform,peakform,.FALSE.)
	    IF (npoint(MFILE+1) .gt. 0) then
C data were read
	      ln = lench(cfilnam(MFILE+1))
	      cfilnam(MFILE+1) = cfilnam(MFILE+1)(:ln)//
	1		'/FORM='//dataform
	      MFILE = MFILE+1
C set attributes to defaults, don't prompt and ignore IVAL,FVAL
	      call setattr(1, MFILE, IVAL, FVAL, .true., .false., .true.)
	    ELSEif (NPKS(MFILE+1) .gt. 0) THEN
C peaks only were read
	      ln = lench(filename)
	      MFILE = MFILE+1
	      cfilnam(MFILE) = filename(:ln) // '/FORM=' //peakform
C set attributes to defaults, don't prompt and ignore IVAL, FVAL
	      call setattr(1, MFILE, IVAL, FVAL, .true., .false., .true.)
	    ELSE
C nothing was read
	      WRITE(LO,106) 7,'CMPR_FILE'//suffix(I),
	1		filename(:lench(filename))//' -- no data/peaks'
106	      FORMAT (1x,a1,'ERROR OPENING/READING ',a,': ',A)
	      CALL PS_PAUSE(PROMPT)
	    ENDIF
	  ELSE
	    GOTO 12
	  ENDIF
	ENDDO
12	IF (MFILE .gt. 0) THEN
	  CALL PS_PAUSE(PROMPT)
	  goto 1
	ENDIF
C read files defined with prompted input
14	IF (PROMPT) THEN
	  CALL RDDATA(STATUS,.FALSE.)
	ENDIF
C-----------------------------------------------------------------------
C list available files
1	IF (.not. CMDFL) CALL TERASE(ICRT,lo,li)
	IF (ANSI .and. .not. CMDFL) then
	  IF (DEFAULT) THEN 
	    string = '  Auto'
	  ELSE
	    string = 'Manual'
	  ENDIF
 	  write (LO,'(1x,4a1,$)') "33,'[','7','m'
 	  write (LO,231) "33,'#3',ver_no,string,"33,'#4',ver_no,string
231	  FORMAT(1x,a1,a2,1x,'CMPR',1x,a5,21x,a6,' ')
 	  write (LO,'(1x,4a1,$)') "33,'[','0','m'
	elseIF (.not. CMDFL) THEN
	  ans = '1'
	  if (prompt) ans = ' '
	  IF (DEFAULT) THEN 
	    string = '  Auto mode'
	  ELSE
	    string = 'Manual mode'
	  ENDIF
	  write (LO,232) ans,ver_no,string
232	  FORMAT(a1,72('-'),/,2x,'CMPR',1x,a5,49x,A11,/,1x,72('-'),/)
	endif
	IF (iw0 .eq. 0 .and. wave0 .gt. 0.) then 
	  write(lo,'(a,f7.4)') ' Default wavelength: ',wave0
	ELSEIF (iw0 .eq. 1) then 
	  write(lo,233) irad0,'Ka 1',wave0
233	  format(' Default wavelength: ',a,1x,a4,' (',f7.4,')')
	ELSEIF (iw0 .eq. 2) then 
	  write(lo,233) irad0,'Ka 2',wave0
	ELSEIF (iw0 .eq. 3) then 
	  write(lo,233) irad0,'Ka bar',wave0
	ENDIF
2	IF (.not. CMDFL) THEN
	  WRITE (LO,24)
24	  FORMAT (' AVAILABLE FILES:',34X,'MIN',4X,'MAX',
	1	3X,'Wr Co Wi Lt Pk')
	  DO M=1,MFILE
	    filename = fil_trunc(cfilnam(M),41)
	    IF (NPKS(M) .EQ. 0) then 
	      WRITE(LO,22) M,filename(:41),START(M),FINISH(M),
     	2	fexists(M),PCOLOR(M),PWIDTH(M),PLTYP(M),'N'
22	      FORMAT (1x,I2,': ',A,1x,2F8.3,2x,L1,3i3,2x,A1)
	    ELSE
	      WRITE(LO,23) M,filename(:41),START(M),FINISH(M),
     	2	fexists(M),PCOLOR(M),PWIDTH(M),PLTYP(M),PPEAKS(M)
23	      FORMAT (1x,I2,': ',A,1x,2F8.3,2x,L1,4i3)
	    ENDIF
	  ENDDO
	ENDIF
C Get a command
3	IF (.NOT. CMDFL) THEN
	  WRITE(LO,'(A)') ' Enter a CMPR command (or HELP)' 
	  STATUS = CLI$DCL_PARSE(%VAL(0),CMPR_SUBCOMMANDS
	1	,LIB$GET_INPUT,LIB$GET_INPUT,'CMPR> ')
	else
	  CMDSTR = '-'
	  LN = 1
C loop reading for lines continued (with a trailing -)
	  DO WHILE(CMDSTR(LN:LN) .EQ. '-' .and. ln .lt. 200)
	    READ (21,'(a)',ERR=321) CMDSTR(LN:)
	    LN = LENCH(CMDSTR)
	  ENDDO
	  WRITE(LO,'(2A)') ' CMPR> ',CMDSTR(:LN)
	  STATUS = CLI$DCL_PARSE(CMDSTR(:LN),CMPR_SUBCOMMANDS
	1	,LIB$GET_INPUT,,)
	endif	
	IF (STATUS .eq. %LOC(RMS$_EOF)) then
	  IF (CMDFL) goto 321
	   goto 45
	ELSEIF (.not. STATUS) then
	  WRITE(LO,'(A)') ' *** ILLEGAL COMMAND ***'
	  IF (CMDFL) goto 321
	  IF (PROMPT) WRITE(LO,'(A)') 
	1	' Press ^B to edit your last command or enter HELP for '//
	2	'more information.',
	3	' Use the EXIT command to leave the program.',' '
	  goto 3
	ELSE
	  STATUS = CLI$GET_VALUE('$VERB',COMMAND)
	  IF (.not. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
	ENDIF
	numf = 0
C-----------------------------------------------------------------------

C*** HELP SUBCOMMAND ***
	IF (COMMAND .eq. 'HELP') then
	  STATUS = CLI$GET_VALUE('p1',parm,ln)
	  CALL TERASE(ICRT,lo,li)
	  call help(parm(1:ln),'cmpr_hlp',prompt)

C*** FILE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'FILE') then
	  STATUS = CLI$GET_VALUE('file_name',filename,len)
C is there a valid file name here?
322	  if ((.not. STATUS) .or. len .le. 0) THEN
	    write(lo,'(a)') 
	1	'$Enter the file name root (default type = .CMD): '
	    read (li,'(q,a)',end=3) len,filename
	  endif
	  OPEN(unit=CMDIN,file=filename(:len),defaultfile='.cmd',
	1	readonly,shared,status='old',err=323)
	  CMDFL = .true.
	  INQUIRE(unit=CMDIN,name=filename)
	  len = lench(filename)
	  WRITE(LO,'(3A)') ' Opening command file ',filename(:len)
	1	,'...'
	  GOTO 1
323	  WRITE(LO,'(2A)') ' Unable to open file ',filename(:len)
	  STATUS = .FALSE.
	  IF (PROMPT) GOTO 322
	  GOTO 3

C*** WAVELENGTH SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'WAVE') then
	  CALL WAVESEL(iw0,irad0,wave0,wave1,WAVE2,*3,li,lo,prompt)

C*** DEFAULT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'DEFA') then
	  CALL SETDEFS(STATUS)
	  IF (.not. STATUS) goto 3

C*** EXIT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'EXIT') then
45	  IF (PROMPT) CALL TERASE(ICRT,lo,li)
C are there files to save?
	  DO i=1,MFILE
	    IF (.not. fexists(i)) then
	      CALL WRITEALL(.true.,*46)
	      call exit
	    ENDIF
	  ENDDO
46	  call exit

C*** QUIT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'QUIT') then
	  call exit

C*** DUMP SUBCOMMAND *** Not documented -- for debugging only
	ELSEIF (COMMAND .eq. 'DUMP') then
	  call GETFILNUM(files,numf,1,1,1,prompt,'to dump')
	  IF (numf .ne. 1) goto 33
	  CALL DUMPFILE(files(1),*3)

C*** DCL SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'DCL ') then
	  if (PROMPT) then
	    CALL TERASE(ICRT,lo,li)
	    WRITE(LO,'(A)') ' Spawning to DCL, type LOG to return to CMPR'
	    CALL LIB$SPAWN(,,,,,,,,,,'(CMPR)$ ')
	  ELSE
	    WRITE(LO,'(A)') ' Sorry, to spawn you must run interactively'
	  ENDIF

C*** PLOT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'PLOT') then
	  call GETFILNUM(files,numf,m$fil-1,1,8,prompt,'to be plotted')
	  IF (numf .le. 0 .or. numf .gt. m$fil) goto 33
	  CALL PLFILE(numf,files,STATUS)
	  IF (.not. STATUS) goto 3

C*** ADD OR SUBTRACT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'ADD' .or. COMMAND .eq. 'SUBT') then
	  if (MFILE .eq. M$FIL) goto 199
	  IF (COMMAND .eq. 'ADD') THEN
	    IDO = 1
	    call GETFILNUM(files,numf,2,2,2,prompt,'to be added')
	  ELSE
	    IDO = -1
	    call GETFILNUM(files,numf,2,2,2,prompt,'to be subtracted')
	  ENDIF
	  IF (NUMF .NE. 2) THEN 
	    type *,'ERROR -- WRONG NUMBER OF FILES FOR ADD/SUBTRACT'
	    GOTO 3
	  ENDIF
	  CALL ADFILE(files(1),files(2),IDO,*3)
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	  call setattr(1, MFILE, IVAL, FVAL, .true., DEFAULT, .true.)

C*** READ SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'READ') then
	  if (MFILE .eq. M$FIL) goto 199
	  CALL RDDATA(STATUS,.true.)
	  IF (.not. STATUS) GOTO 3

C*** DELETE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'DELE') then
	  STATUS = CLI$PRESENT('ALL')
	  IF (STATUS .eq. %LOC(CLI$_PRESENT) .or. 
	1	STATUS .eq. %LOC(CLI$_DEFAULTED)) THEN
	    MFILE = 0
	    do I=1,M$FIL
	      NPOINT(N) = 0
	      NPKS(n) = 0
	      NBKGP(n) = 0
	    ENDDO
	    IF (PROMPT) GOTO 14
	  else
	    call GETFILNUM(files,numf,1,1,1,prompt,'to remove')
	    IF (numf .ne. 1) goto 33
	    CALL DEFILE(files(1),*3)
	  endif

C*** WRITE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'WRIT') then
	  call GETFILNUM(files,numf,1,1,1,prompt,'to write')
	  IF (numf .ne. 1) goto 33
	  CALL WRITEDAT(FILES(1),*3)

C*** HKLPLOT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'HKLP') then
	  if (.NOT. PROMPT) THEN
	    WRITE(LO,'(A)') 
	1	' Sorry, this routine must be run interactively'
	    GOTO 3
	  ENDIF
	  call GETFILNUM(files,numf,2,1,2,prompt,
	1	'to show HKL & extinctions')
	  IF (numf .le. 0) goto 33
	  if (numf .eq. 1) files(2) = files(1)
	  CALL SHOWHKL(FILES(1),files(2))

C*** LOGIC SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'LOGI') then
	  if (PROMPT) then
	    CALL LIB$SPAWN('@PS_EXE:CMPR_TO_LOGIC')
	  ELSE
	    WRITE(LO,'(2a)') ' Sorry, you can only spawn into ',
	1	'LOGIC while running interactively'
	  ENDIF

C*** MANIP SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'MANI') then
	  call GETFILNUM(files,numf,1,0,1,prompt,'to pass to MANIP')
	  if (PROMPT) then
C 	Prepare to pass file
	    if (numf .ge. 1) then 
C	Check if file is on disk
	      if (.not. FEXISTS(files(1))) then		! file is not on disk
		Write (LO,'(a)') 
	1	' Warning the file you want to pass has not be written',
	2	'$Do you want to write it? (Default=Y) '
		read(LI,'(a1)',end=47) ans
		if (ans .ne. 'N' .and. ans .ne. 'n') CALL WRITESUB(FILES(1),*3)
	        if (.not. FEXISTS(files(1))) goto 3
	      endif
	      ln = lench(Cfilnam(FILES(1)))
	      flag = DEF_LOGICAL('MANIP_FILE',Cfilnam(FILES(1)),ln,0,lgprc)
	    endif
C now suspend CMPR and run MANIP as a subprocess
47	    CALL TERASE(ICRT,lo,li)
	    CALL LIB$SPAWN('@PS_EXE:CMPR_TO_MANIP')
C we are back in CMPR now -- read files defined with a logical name
	    k = 1
	    DO I=MFILE+1,M$FIL
	      flag = GET_LOGICAL('CMPR_PASS'//suffix(k)
	1			,filename,80,ln,lgjob)
	      if (.not. flag .or. ln .le. 0) goto 1
	      call READDATA(filename,I,STATUS,.true.,.true.,
	1	dataform,peakform,.true.)
	      IF (npoint(I) .gt. 0) then
C data were read
	        ln = lench(cfilnam(I))
	        cfilnam(I) = cfilnam(I)(:ln) // '/FORM=' //dataform
	      ELSEif (NPKS(I) .gt. 0) THEN
C peaks only were read
	        ln = lench(filename)
	        cfilnam(I) = filename(:ln) // '/FORM=' //peakform
	      ELSE
C nothing was read
		WRITE(LO,106) 7,'CMPR_PASS'//suffix(k),
	1		filename(:lench(filename))
		goto 2
	      ENDIF
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	      call setattr(1, I, IVAL, FVAL, .true., DEFAULT, .true.)
	      MFILE = I
	      k = k + 1
	    ENDDO
	    CALL TERASE(ICRT,lo,li)
	  ELSE
	    WRITE(LO,'(A)')
	1	' Sorry, to spawn into MANIP you must run interactively'
	  ENDIF
C*** COMBINE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'COMB') then
	  call GETFILNUM(files,numf,m$fil-1,2,8,prompt,'to be combined')
	  IF (numf .le. 1 .or. numf .gt. m$fil-1) goto 33
	  CALL CMFILE(numf,files,STATUS)
	  IF (.not. STATUS) THEN
	    call ps_pause(prompt)
	    GOTO 3
	  ENDIF
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	  call setattr(1, MFILE, IVAL, FVAL, .true., DEFAULT, .true.)
C*** D-GEN SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'DGEN') then
	  I = MFILE
	  IF (.NOT. PROMPT) THEN
	    WRITE(LO,'(2a)') ' Sorry, you can only run D-GEN ',
	1	'while running interactively'
	    goto 3
	  ENDIF
	  I = mfile
	  CALL DGEN(status)
	  IF (.not. STATUS) THEN
	    call ps_pause(prompt)
	    GOTO 3
	  ENDIF
	  if (mfile .ne. I) THEN
C set attributes to defaults, don't prompt, ignore IVAL,FVAL
	    call setattr(1, MFILE, IVAL, FVAL, .true., .false., .false.)
	    Ppeaks(mfile) = 9
C don't attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	    call setattr(1, MFILE, IVAL, FVAL, .false., DEFAULT, .true.)
	  ENDIF
C*** SIMULATE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'SIMU') then
	  if (MFILE .eq. M$FIL) then
	    call GETFILNUM(files,numf,1,1,1,prompt,'to simulate')
	  else
	    call GETFILNUM(files,numf,m$fil-1,1,8,prompt,'to simulate')
	  endif
	  IF (numf .lt. 1) goto 33
	  I = mfile
	  CALL SIMULATE(files,numf,status)
	  IF (.not. STATUS) THEN
	    call ps_pause(prompt)
	    GOTO 3
	  ENDIF
	  if (mfile .ne. I) THEN
C set attributes to defaults, prompt based on DEFAULT and ignore IVAL,FVAL
	    call setattr(1, mfile, IVAL, FVAL, .true., DEFAULT, .true.)
	  ENDIF
C*** TITLE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'TITL') then
	  call GETFILNUM(files,numf,1,1,1,prompt,'for new title')
	  IF (numf .ne. 1) goto 33
	  STATUS = CLI$GET_VALUE('NEW_TITLE',title,ln)
	  if (STATUS .and. ln .gt. 0) THEN
	    ATITLE(files(1)) = TITLE
	  ELSE
	    WRITE(lo,'(A)') 
	1  ' Enter new title or blank line to keep the current title: ',
	2	' "'//ATITLE(files(1))(:LENCH(ATITLE(files(1))))//'"',
	3	'$>'
	    read(li,'(A)') title
	    IF (title .ne. ' ') ATITLE(files(1)) = TITLE
	  ENDIF
C*** SCALE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'SCAL') then
	  call GETFILNUM(files,numf,1,1,1,prompt,'to rescale')
	  CALL RESCALE(files,status)
	  IF (.not. STATUS) THEN
	    call ps_pause(prompt)
	    GOTO 3
	  ENDIF
C*** ATTRIBUTES SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'ATTR') then
	  askfl = .true.
C set attributes flags to defaults
          call CLRATTR(IVAL, FVAL)
	  FLAG = GET_NUMBER('COLOR',IVAL(1))
	  IF (.not. FLAG) ASKFL = .false.
	  FLAG = GET_NUMBER('WIDTH',IVAL(2))
	  IF (.not. FLAG) ASKFL = .false.
	  FLAG = GET_NUMBER('LINE',IVAL(3))
	  IF (.not. FLAG) ASKFL = .false.
	  FLAG = GET_NUMBER('PEAK',IVAL(4))
	  IF (.not. FLAG) ASKFL = .false.
	  FLAG = GET_FNUMBER('MAGNIFICATION',FVAL(2))
	  IF (.not. FLAG) THEN
	    IVAL(6) = 1
	    ASKFL = .false.
	  ENDIF
	  FLAG = GET_FNUMBER('OFFSET',FVAL(1))
	  IF (.not. FLAG) THEN
	    IVAL(5) = 1
	    ASKFL = .false.
	  ENDIF
	  IF (CLI$PRESENT('ALL') .eq. %LOC(CLI$_PRESENT)) THEN
	    NUMF = MFILE
	    do i=1,NUMF
		files(i) = i 
	    ENDDO
	  ELSE
	    call GETFILNUM(files,numf,m$fil,1,8,prompt,
	1	'to change attributes')
	  ENDIF

	  IF (numf .le. 0 .or. numf .gt. m$fil) goto 33
	  IF (ASKFL) WRITE 
	1	(LO,'(/,A,20i4)') ' Setting attributes for files: ',
	2	(files(i),i=1,numf)
	  call setattr(numf, files, IVAL, FVAL, .FALSE., ASKFL, .false.)
	ELSE
		type *,'UNKNOWN COMMAND:',command
		goto 3
	ENDIF
	goto 1
C----------------------------------------------------------------------------
321	CMDFL = .false.
	WRITE(LO,'(A)') ' ....Terminating command file'
	close (unit=CMDIN)
	call ps_pause(prompt)
	goto 1
C----------------------------------------------------------------------------
C error messages
199	write (LO,'(1x,3a)') 7,
	1 'ERROR -- You have no room to add more files, DELETE one first'
	goto 3
33	WRITE(lo,'(A)') ' Wrong number of files'
	goto 3
	end

