source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnwarn.F@ 3452

*
* $Id: mnwarn.F,v 1.1.1.1 2003-06-11 14:18:30 cmv Exp $
*
* $Log: not supported by cvs2svn $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
#include "minuit/pilot.h"
      SUBROUTINE MNWARN(COPT,CORG,CMES)
C     If COPT='W', CMES is a WARning message from CORG.
C     If COPT='D', CMES is a DEBug message from CORG.
C         If SET WARnings is in effect (the default), this routine
C             prints the warning message CMES coming from CORG.
C         If SET NOWarnings is in effect, the warning message is
C             stored in a circular buffer of length MAXMES.
C         If called with CORG=CMES='SHO', it prints the messages in
C             the circular buffer, FIFO, and empties the buffer.
#include "minuit/d506dp.inc"
#include "minuit/d506cm.inc"
      CHARACTER COPT*1, CORG*(*), CMES*(*), CTYP*7
      PARAMETER (MAXMES=10)
      CHARACTER     ORIGIN(MAXMES,2)*10, WARMES(MAXMES,2)*60
      COMMON/MN7WRC/ORIGIN,              WARMES
      COMMON/MN7WRI/NFCWAR(MAXMES,2),ICIRC(2)
      CHARACTER ENGLSH*20
C
      IF (CORG(1:3).EQ.'SHO' .AND. CMES(1:3).EQ.'SHO')  GO TO 200
C             Either print warning or put in buffer
      IF (COPT .EQ. 'W')  THEN
        ITYP = 1
        IF (LWARN) THEN
          WRITE (ISYSWR,'(A,A/A,A)') ' MINUIT WARNING IN ',CORG,
     +              ' ============== ',CMES
          RETURN
        ENDIF
      ELSE
        ITYP = 2
        IF (LREPOR) THEN
          WRITE (ISYSWR,'(A,A/A,A)') ' MINUIT DEBUG FOR  ',CORG,
     +              ' ============== ',CMES
          RETURN
        ENDIF
      ENDIF
C                 if appropriate flag is off, fill circular buffer
         IF (NWRMES(ITYP) .EQ. 0)  ICIRC(ITYP) = 0
         NWRMES(ITYP) = NWRMES(ITYP) + 1
         ICIRC(ITYP) = ICIRC(ITYP) + 1
         IF (ICIRC(ITYP) .GT. MAXMES) ICIRC(ITYP) = 1
         IC = ICIRC(ITYP)
         ORIGIN(IC,ITYP) = CORG
         WARMES(IC,ITYP) = CMES
         NFCWAR(IC,ITYP) = NFCN
      RETURN
C
C             'SHO WARnings', ask if any suppressed mess in buffer
  200 CONTINUE
      IF (COPT .EQ. 'W') THEN
        ITYP = 1
        CTYP = 'WARNING'
      ELSE
        ITYP = 2
        CTYP = '*DEBUG*'
      ENDIF
      IF (NWRMES(ITYP) .GT. 0) THEN
         ENGLSH = ' WAS SUPPRESSED.  '
         IF (NWRMES(ITYP) .GT. 1) ENGLSH = 'S WERE SUPPRESSED.'
         WRITE (ISYSWR,'(/1X,I5,A,A,A,A/)') NWRMES(ITYP),
     +    ' MINUIT ',CTYP,' MESSAGE', ENGLSH
         NM = NWRMES(ITYP)
         IC = 0
         IF (NM .GT. MAXMES) THEN
              WRITE (ISYSWR,'(A,I2,A)')  ' ONLY THE MOST RECENT ',
     +          MAXMES,' WILL BE LISTED BELOW.'
              NM = MAXMES
              IC = ICIRC(ITYP)
         ENDIF
         WRITE (ISYSWR,'(A)') '  CALLS  ORIGIN         MESSAGE'
           DO 300 I= 1, NM
           IC = IC + 1
           IF (IC .GT. MAXMES)  IC = 1
           WRITE (ISYSWR,'(1X,I6,1X,A,1X,A)')
     +           NFCWAR(IC,ITYP),ORIGIN(IC,ITYP),WARMES(IC,ITYP)
 300       CONTINUE
         NWRMES(ITYP) = 0
         WRITE (ISYSWR,'(1H )')
      ENDIF
      RETURN
      END