 	PROGRAM LOGIC
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---------------------------------------------------------------------------
C  Program to logically manipulate lists of "cards" in JCPDS database
C
C	Current code written by B. Toby based on code written by R. L. Harlow
C
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     	6	LP	PRINTER OUTPUT
C     	8	LUNC	CHEMISTRY INDEX
C	9	LUNm	JCPDS MASTER INDEX FILE
C     	10	LPDF	JCPDS D/I FILE 
C     	12	LUNn	JCPDS NAME FILE 
C	11	LINDX	TEMPORARY FILE FOR LISTINGS
C	21	CMDIN	FILE CONTAINING LOGIC COMMANDS
C
C*************************************************************************
	include 'LOGIC.common/list'
	include 'CVTSP.cmn/list'
C Program now sets the options used in the PDF2 display routines: CONST and
C and ISPACG
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,GET_LOGICAL,DEF_LOGICAL,GET_FNUMBER
        INTEGER  DEVCLASS, LIB$GETDVI
	EXTERNAL RMS$_EOF,SS$_NORMAL,DC$_TERM,DVI$_DEVCLASS
	EXTERNAL LIB$GET_INPUT,LOGIC_SUBCOMMANDS,DSC$K_DTYPE_F
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
	EXTERNAL ERRHAND
	INTEGER*4 OLDHANDLER/-1/,LIB$ESTABLISH
	CHARACTER*20 string,tmpscr*23,head*7
	CHARACTER*13 fromstr,nspawn*10,delstr*10
	CHARACTER*80 PARM,filename,Noutput
	CHARACTER*4 command,ans*1
	INTEGER*4 LEN,lspawn,loutput
	BYTE gparm/.false./
	INTEGER CMDIN/21/
	LOGICAL CMDFL/.FALSE./
	CHARACTER*200 CMDSTR
C-----------------------------------------------------------------------
	OPEN(unit=lo,file='sys$output',status='new')
	OPEN(unit=li,file='sys$input',status='new')
C open the PDF1 files
	CALL PDF1INIT(LUNM,LPDF,LUNn,*919)
C close the NAME and DI file since they are not needed here
!	CLOSE(unit=LPDF)
!	CLOSE(unit=LUNn)

C use DELETED patterns -- check PS_DELETED
	CALL DELMODEGET(DELETED)
	cnum = 1
	IF (Deleted) then
	  context(cnum) = 'DELETED/INCLUDE'
	  clen(cnum) = lench(context(cnum))
	ELSE
	  context(cnum) = 'DELETED/EXCLUDE'
	  clen(cnum) = lench(context(cnum))
	ENDIF

C is this a spawned process? If so define NSPAWN
	flag = GET_LOGICAL('LOGIC_SPAWN_FROM',NSPAWN,10,LSPAWN,lgprc)
	loutput = 0
	IF (LSPAWN .eq. 0) then 
	  fromstr = '             '
	else
	  fromstr = '(from '//nspawn(1:lspawn)//')'
C get name for output file (if defined)
	  flag = GET_LOGICAL('LOGIC_OUTPUT',NOUTPUT,80,LOUTPUT,lgprc)
	endif
C-----------------------------------------------------------------------
C Check if we are running from a terminal?
	PROMPT = .FALSE.
	STATUS = LIB$GETDVI(%LOC(DVI$_DEVCLASS),,
	1	'SYS$INPUT',DEVCLASS,string,len)
	IF (STATUS .EQ. %LOC(SS$_NORMAL) .and. DEVCLASS .eq. %LOC(DC$_TERM)) 
	1	PROMPT = .TRUE.
	BATCH = .not. PROMPT 
C-----------------------------------------------------------------------
C if this is a terminal, prompt for graphics type
	ICRT = 0
	IF (PROMPT) CALL SETCRT(ICRT,lo,li,ANSI)
C-----------------------------------------------------------------------
C Establish an alternate error handler
	IF (OLDHANDLER .eq. -1) OLDHANDLER = LIB$ESTABLISH(ERRHAND)
C determine the starting wavelength
	CALL WAVEGET(IW,irad0,wave0,WAVE1,WAVE2)
	IF (wave0 .ne. 0) THEN
	  const = wave0/2
	  ISPACG = '2'
	ENDIF
C-----------------------------------------------------------------------
C Display welcome message and pause
	write(lo,'(20x,A/)') '* * * Welcome to Program LOGIC * * *'
	CALL COPYRGT(lo,.TRUE.,.false.)
	call ps_pause(prompt)
	CALL TERASE(ICRT,lo,li)
C read a file defined with a logical name
	len = 0
	flag = GET_LOGICAL('LOGIC_FILE',filename,80,len,lgprc)
C read in the starting table
	call TBLINIT(filename,len,gparm,STATUS)
	IF (.not. STATUS) call ps_pause(prompt)
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
1	IF (.not. CMDFL) CALL TERASE(ICRT,lo,li)
	IF (wave0 .eq. 0.0) THEN 
	  head = 'D-space'
	ELSE
	  IF (IW .eq. 0) then 
	    write(head,fmt='(a2,f5.3)') irad0,wave0
	  ELSEIF (IW .eq. 1) then 
	    write(head,233) irad0,'Ka 1'
233	    format(a2,1x,a4)
	  ELSEIF (IW .eq. 2) then 
	    write(head,233) irad0,'Ka 2'
	  ELSEIF (IW .eq. 3) then 
	    write(head,233) irad0,'Ka b'
	  ELSE
	    head = 'W = ???'
	  ENDIF
	ENDIF
	IF (Deleted) then
	  DELSTR = 'Deleted   '
	ELSEIF (ANSI) then
	  DELSTR = '   '
	ELSE
	  DELSTR = 'No Deleted'
	ENDIF

	IF (.NOT. CMDFL) then
	  IF (ANSI) then
	    write (LO,'(5a1)') '$',"33,'[','7','m'
	    write (LO,231) "33,'#','3',ver_no,fromstr,delstr(1:3),head,
	1   		   "33,'#','4',ver_no,fromstr,delstr(1:3),head
231	    FORMAT(1x,3a1,'LOGIC',1x,a5,1x,a13,1x,a3,2x,a7)
 	    write (LO,'(5a1)') '$',"33,'[','0','m'
	  elseif (prompt) then
232	    FORMAT(a1,72('-'),/,2x,'LOGIC ',a5,2x,a13,10x,a10,15x,
	1	A7,/,1x,72('-'),/)
	    write (LO,232) ' ',ver_no,fromstr,delstr,head
	  else
	    write (LO,232) '1',ver_no,fromstr,delstr,head
	  endif
	  if (LOUTPUT .gt. 0) WRITE(lo,'(a)') ' Writing file: '//
	1	NOUTPUT(1:LOUTPUT)//' upon exit from LOGIC'
	  WRITE(lo,9300) NPHASE
9300	  FORMAT(50x,'NUMBER OF PHASES:',I6)
	  IF (cnum .gt. 1) then
	    WRITE(lo,820) 
820	    FORMAT(' Current LOGIC List:')
	    WRITE(lo,821) (i,CONTEXT(i)(1:min(clen(i),72))
	1		,i=max(1,cnum-10),cnum)
821	    FORMAT(3x,i2,') ',a)
	  endif
	endif
C Get a command
3	IF (.NOT. CMDFL) THEN
	  WRITE(LO,'(A)') ' Enter a LOGIC command (or HELP)' 
	  STATUS = CLI$DCL_PARSE(%VAL(0),LOGIC_SUBCOMMANDS
	1	,LIB$GET_INPUT,LIB$GET_INPUT,'LOGIC> ')
	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)') ' LOGIC> ',CMDSTR(:LN)
	  STATUS = CLI$DCL_PARSE(CMDSTR(:LN),LOGIC_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

C-----------------------------------------------------------------------
C*** COMMENT SUBCOMMAND ***
	IF (COMMAND .eq. 'COMM') then
	  STATUS = CLI$GET_VALUE('p1',parm,len)
	  if (len .eq. 0) then
	    write (lo,'(A)') '$Enter a comment line: '
	    read (li,'(q,a)') len,parm
	  ENDIF
	  if (len .eq. 0) goto 3
	  cnum = cnum + 1
	  context(cnum) = 'COMMENT '//parm(1:len)
	  clen(cnum) = len + 8

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,fmt='(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*** ADD SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'ADD ') then
	  CALL LOGSUB(1,*3)

C*** MATCH SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'MATC') then
	  CALL LOGSUB(2,*3)

C*** CULL SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'CULL') then
	  CALL LOGSUB(3,*3)

C*** INDEX SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'INDE') then
	  CALL WINDEX(*3)

C*** TABLES SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'TABL') then
	  IF (CLI$PRESENT('FULL')) THEN
	    CALL FULLTBL(*3)
	  ELSE
	    CALL TABLES(*3)
	  ENDIF

C*** BROWSE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'BROW') then
	  CALL BROWSE(gparm,*3)

C*** WAVELENGTH SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'WAVE') then
	  CALL WAVESEL(IW,irad0,wave0,wave1,WAVE2,*3,li,lo,prompt)
	  gparm = .false.
	  IF (wave0 .ne. 0) THEN
	    const = wave0/2
	    ISPACG = '2'
	  else
	    const = 0.77025
	    ISPACG = 'D'
	  ENDIF

C*** DELETED SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'DELE') then
	  CALL DELMODESEL(DELETED,*3,li,lo,prompt)
	  cnum = cnum + 1
	  IF (Deleted) then
	    context(cnum) = 'DELETED/INCLUDE'
	    clen(cnum) = lench(context(cnum))
	  ELSE
	    context(cnum) = 'DELETED/EXCLUDE'
	    clen(cnum) = lench(context(cnum))
	  ENDIF

C*** READ SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'READ') then
	  CALL TBLREAD(STATUS)
	  IF (.not. STATUS) THEN
	    CALL PS_PAUSE(prompt)
	    goto 3
	  ENDIF

C*** WRITE SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'WRIT') then
	  STATUS = CLI$GET_VALUE('file_name',filename,len)
C is there a valid file name here?
	  if ((.not. STATUS) .or. len .le. 0) THEN
	    write(lo,'(a)') 
	1	'$Enter the file name root (default type = .USRPDF): '
	    read (li,fmt='(q,a)',end=3) len,filename
	  endif
	  CALL TBLWRITE(filename,len,*3)

	  CALL PS_PAUSE(prompt)

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

C*** EXIT SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'EXIT') then
45	  IF (PROMPT) CALL TERASE(ICRT,lo,li)
	  IF (LOUTPUT .gt. 0) CALL TBLWRITE(noutput,loutput,*999)
999	  call exit

C*** DCL SUBCOMMAND ***
	ELSEIF (COMMAND .eq. 'DCL ') then
	  if (PROMPT) then
	    CALL TERASE(ICRT,lo,li)
	    WRITE(LO,'(A)') ' Spawning to DCL, enter LOG to return to LOGIC'
	    CALL LIB$SPAWN(,,,,,,,,,,'(LOGIC)$ ')
	  ELSE
	    WRITE(LO,fmt='('' Sorry, you can only spawn '',
	1	''while running interactively'')')
	  ENDIF
	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*****************************************************************************
919    stop 'PDF1INIT ERROR -- unable to open JCPDS PDF-1 database'
      end
