* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
c     $Header: /gagax1/u/gildas/nic_message.for,v 1.11 1996/02/19 17:02:41 neri
c     $Log: nic_message.for,v $
c     Revision 1.21  1999/03/30 14:31:01  broguier
c     NIC.short replaced by nic.short
c
C Revision 1.20  98/02/03  10:08:12  10:08:12  neri (Roberto Neri)
C *** empty log message ***
C
C Revision 1.19  97/02/26  15:47:08  15:47:08  neri
C *** empty log message ***
C
C Revision 1.11  1996/02/19  17:02:41  neri
C *** empty log message ***
C
C Revision 1.5  95/03/30  11:31:57  11:31:57  broguier (Dominique Broguiere)
C *** empty log message ***
C
C Revision 1.2  94/11/18  15:00:48  15:00:48  broguier (Dominique Broguiere)
C *** empty log message ***
C
*
      SUBROUTINE MESSAGE(PRIO,SEVE,PROGRA,LINE)
C ----------------------------------------------------------------------
C NIC 	Internal routine
C
C	Output message according to current priority levels, and
C	set the severity information
C ----------------------------------------------------------------------
* Global variables:
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INTEGER MFILE, TPRIO, TFILE, CSEV
      COMMON /MESFIL/ MFILE, TPRIO, TFILE, CSEV
      SAVE /MESFIL/
* Dummy variables:
      CHARACTER*(*) PROGRA,LINE
      INTEGER PRIO, SEVE
* Local variables:
      CHARACTER*1   SEVERITY(4)
      INTEGER NL,LENC, N0, N2, I, LIN
      PARAMETER (LIN=132)
      DATA SEVERITY /'I','W','E','F'/
*------------------------------------------------------------------------
* Code:
      CSEV = MIN(MAX(SEVE,1),4)
      NL = LENC(LINE)
      N0 = LIN-(14+LENC(PROGRA))
      DO I=1, NL, N0
         N2 = MIN(NL,I+N0-1)
         IF (TPRIO.LE.PRIO) THEN
            WRITE(6,100) SEVERITY(CSEV),PROGRA,SCAN_NUMBER,LINE(I:N2)
         ENDIF
         IF (TFILE.LE.PRIO .OR. PRIO.EQ.0) THEN
            WRITE(MFILE,101) PRIO,SEVERITY(CSEV),PROGRA,
     $      SCAN_NUMBER,LINE(I:N2)
         ENDIF
      ENDDO
      RETURN
C+VMS
c100   FORMAT(1X,A,'-',A,',[',I4.4,'] ',A)
c101   FORMAT(1X,I2,'-',A,'-',A,',[',I4.4,'] ',A)
C-VMS
C+UNIX
100   FORMAT(A,'-',A,',[',I4.4,'] ',A)
101   FORMAT(I2,'-',A,'-',A,',[',I4.4,'] ',A)
C-UNIX
      END
*<FF>
      SUBROUTINE MESSAGE_LEVEL(IP)
      INTEGER IP
* entry point to set priority level
* returns the previous value.
      INTEGER MFILE, TPRIO, TFILE, CSEV, ISAVE
      COMMON /MESFIL/ MFILE, TPRIO, TFILE, CSEV
      SAVE /MESFIL/
      ISAVE = TPRIO
      TPRIO = IP
      IP = ISAVE
      END
*<FF>
      SUBROUTINE MESSAGE_INIT(LINE,IT,IP)
      CHARACTER*(*) LINE
      INTEGER IT,IP
*
      INTEGER SIC_GETLUN,SIC_OPEN,STATUS
      INTEGER MFILE, TPRIO, TFILE, CSEV
      COMMON /MESFIL/ MFILE, TPRIO, TFILE, CSEV
      SAVE /MESFIL/
* Open the message file
      STATUS = SIC_GETLUN(MFILE)
      IF (STATUS.NE.1) CALL SYSEXI(STATUS)
      STATUS = SIC_OPEN(MFILE,LINE,'NEW',.FALSE.)
      IF (STATUS.NE.0) CALL SYSEXI(STATUS)
      TFILE = IP
      TPRIO = IT
      END
*<FF>
      SUBROUTINE MESSAGE_COMPRESS (MESSFL,PRIO)
      CHARACTER*(*) MESSFL
      INTEGER PRIO
*
      INTEGER MFILE, TPRIO, TFILE, CSEV
      COMMON /MESFIL/ MFILE, TPRIO, TFILE, CSEV
      SAVE /MESFIL/
      INTEGER SFILE,STATUS,NL,IP,ID
      INTEGER LENC, SIC_GETLUN, SIC_PURGE, SIC_OPEN
      CHARACTER*256 NAME,FILE
*
      CALL GAGOUT('I-NIC,  Compressing message file in nic.short')
      REWIND(UNIT=MFILE,IOSTAT=STATUS)
c      IF (STATUS.NE.0) THEN
c         CALL GAGOUT('W-NIC,  Error rewinding NIC.MES file')
c         CALL PUTIOS('W-NIC,  ',STATUS)
c         RETURN
c      ENDIF
      NAME = 'nic'
      CALL SIC_PARSEF (NAME,FILE,'GAG_LOG:','.short')
      NL = LENC(FILE)
      STATUS = SIC_PURGE (FILE,1)
      STATUS = SIC_GETLUN(SFILE)
      IF (STATUS.NE.1) THEN
         CALL GAGOUT('W-NIC,  Error getting unit SFILE')
         CALL SYSEXI(STATUS)
      ENDIF
      STATUS = SIC_OPEN(SFILE,FILE,'NEW',.FALSE.)
      IF (STATUS.NE.0) THEN
         CALL GAGOUT('W-NIC,  Error opening '//FILE(1:NL))
         CALL PUTIOS('E-NIC,  ',STATUS)
         CALL SYSEXI(STATUS)
      ENDIF
*
      DO WHILE (.TRUE.)
         READ (MFILE,'(A)',END=10) NAME
         ID = INDEX (NAME,'-')-1
* AIX compiler being somewhat touchy with length of NAME(1:ID), use free
* format
         READ (NAME(1:ID),*) IP
         IF (IP.EQ.0 .OR. IP.GE.PRIO) THEN
            WRITE (SFILE,'(A)') NAME(1:LENC(NAME))
         ENDIF
      ENDDO
10    CLOSE(UNIT=MFILE)
      CLOSE(UNIT=SFILE)
      END