      SUBROUTINE ERRTXT (SEVRTY, STRING)
C
C          Prints an error message which includes the current ID#.
C
C          Normal format:          %modnam-sevrty-idnum, string
C          Continuation format:    %                     string
C
C          Where, modnam is the current module name set by ESTMOD
C                 sevrty is the severity of the problem -
C                        E=error, W=warning, I=informational
C                 idnum  is the pattern's PDF or Editor number as found
C                        on Card 1 (1) cols. 73-78 (PDFDATA.CMN)
C                 string are the character string containing the error text
C
C               SEVRTY - severity of problem; either F/E/W/I, or C to
C                        signify a Continuation line (see above).
C                        Can also indicate a command with a '*'.
C
C               STRING - character string containing the error text.
C                        A maximum of MAXCPL characters of text can
C                        be printed per line.  A maximum of 1024
C                        characters can be printed per call to ERRTXT.
C
C                        If SEVRTY='*', this is interpreted as a command.
C                               'D0' = Turn display of errors off
C                               'D1' = Turn display of errors on
C                               'T0' = Turn calling trace off
C                               'T1' = Turn calling trace on
C                               'F0' = Turn writing of error messages to
C                                      disk file OFF, close file
C                               'F1' = Turn writing of error messages to
C                                      disk file on, file name follows 'F1:',
C                                      ie., 'F1:filename.ext'
C                               'F2' = Same as 'F1' plus causes messages
C                                      to be written to both a disk file
C                                      and the screen.
C
C          Sample calling format:
C               CALL ERRTXT ('W', 'problem in mineral name.')
C               CALL ERRTXT ('C', CARD6(2)(1:67) )
C               CALL ERRTXT ('*', 'D0')
C
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
C          By: Mark Holomany, JCPDS     Date: 1-APR-1985
C          Changed by Brian H. Toby for Powder Suite, files are opened
C		in current directory; only if an error message will be
C		produced. January 1990
C
C------------------------------------------------------------------------

      IMPLICIT INTEGER (A-Z)
      CHARACTER*(*) SEVRTY, STRING
      CHARACTER*1   LOCSEV
      CHARACTER*3   COMAND
      CHARACTER*6   CURMOD
      LOGICAL       DISPLY, TRACE
      PARAMETER    (MAXCPL = 114)
      SAVE          DISPLY, TRACE, FSTAT

      LOGICAL FILEFLAG/.false./
      CHARACTER*80 FILENAME
      SAVE FILEFLAG,FILENAME

D	INCLUDE 'IORET.CMN'
D	INCLUDE 'MODCOM.CMN'
D	INCLUDE 'PDFDATA.CMN'
C\$INCLUDE:'IORET.CMN'
C\$INCLUDE:'MODCOM.CMN'
C\$INCLUDE:'PDFDATA.CMN'

      DATA  DISPLY /.TRUE./, TRACE /.FALSE./, FSTAT /0/
      DATA  COMAND /'DTF'/

      BEG = 1
      IF(SEVRTY .EQ. '*') THEN
         NCMND = INDEX (COMAND, STRING(1:1))
         GO TO (8010, 10, 20, 30), NCMND+1
C command D
10       IF(STRING(2:2) .EQ. '0') DISPLY = .FALSE.
         IF(STRING(2:2) .EQ. '1') DISPLY = .TRUE.
         GO TO 9000

C command T
20       IF(STRING(2:2) .EQ. '0') TRACE = .FALSE.
         IF(STRING(2:2) .EQ. '1') TRACE = .TRUE.
         GO TO 9000

C command F
30       IF(STRING(2:2) .EQ. '0') THEN
	     FILEFLAG = .FALSE.
            CLOSE (UNIT=ERROUT, STATUS='KEEP')
            FSTAT = 0
         ELSE IF(STRING(2:2) .EQ. '1') THEN
	     FILEFLAG = .TRUE.
C	     FILENAME = 'RET$SCRATCH:' // STRING(4:)
	     FILENAME = STRING(4:)
            FSTAT = 1
         ELSE IF(STRING(2:2) .EQ. '2') THEN
	     FILEFLAG = .TRUE.
C	     FILENAME = 'RET$SCRATCH:' // STRING(4:)
	     FILENAME = STRING(4:)
            FSTAT = 2
         ENDIF
         GO TO 9000
      ENDIF

      IF(.NOT. DISPLY) RETURN
        LS = LEN(STRING)
      IF(LS .LE. 0) THEN
         WRITE (*,*) '*** STRING ERROR ON CALL TO ERRTXT'
         WRITE (*,*) 'STRING = "',STRING(1:10),'"'
         RETURN
      ENDIF
      NCHRS = LS
      IF(LS .GT. MAXCPL) THEN
         LS = MIN0 (LS, 1024)
         NCHRS = MAXCPL
      ENDIF

      LOCSEV = SEVRTY
      CALL UPPER (LOCSEV)

C If we will be writing an error message to a file, check if the 
C file has yet been opened.
      IF (FILEFLAG .AND. (FSTAT .EQ. 1  .OR.  FSTAT .EQ. 2)) THEN
   	     FILEFLAG = .FALSE.
C If possible, open and delete any old file 
            OPEN (UNIT=ERROUT,
	1         FILE=FILENAME,
	2         STATUS='OLD',
  	3         ERR=33)
	    CLOSE(UNIT=ERROUT, DISP='DELETE')
33          OPEN (UNIT=ERROUT,
	1         FILE=FILENAME,
	2         STATUS='NEW')
      ENDIF

100   IF(LOCSEV .EQ. 'C') THEN
         IF(FSTAT .EQ. 0  .OR.  FSTAT .EQ. 2)
     1     WRITE(NOUT,1601) STRING(BEG:NCHRS)
         IF(FSTAT .EQ. 1  .OR.  FSTAT .EQ. 2)
     1     WRITE(ERROUT,1601) STRING(BEG:NCHRS)
1601     FORMAT(' %',17X,A)

      ELSE
         IF(CARD1(1)(73:73) .EQ. CHAR(0)) CARD1(1)(73:78) = ' '
         IF(FSTAT .EQ. 0  .OR.  FSTAT .EQ. 2)
     1     WRITE(NOUT,1602) MODULE,
     2                      LOCSEV,
     3                      CARD1(1)(73:78),
     4                      STRING(BEG:NCHRS)
         IF(FSTAT .EQ. 1  .OR.  FSTAT .EQ. 2)
     1     WRITE(ERROUT,1602) MODULE,
     2                      LOCSEV,
     3                      CARD1(1)(73:78),
     4                      STRING(BEG:NCHRS)
1602     FORMAT(' %',A6,  '-',A1,'-', A6,  ', ',A)
      ENDIF

C
C       ... Handle output strings > the maximum # of characters that
C       ... can fit on a line
      IF(NCHRS .LT. LS) THEN
         BEG = NCHRS + 1
         NCHRS = MIN0(NCHRS+MAXCPL, LS)
         LOCSEV = 'C'
         GO TO 100
      ENDIF

9000  CONTINUE
      RETURN
8010  CONTINUE
      WRITE (*,*) 'ERRTXT - INVALID COMMAND: ',STRING(1:1)
      GO TO 9000
      END
