*-----------------------------------------------------------------------
*     MSGDMP
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE MSGDMP(CLEV,CSUB,CMSG)

      CHARACTER CLEV*(*),CSUB*(*),CMSG*(*)

      LOGICAL   LCHREQ,LLMSG
      CHARACTER CLEVX*1,CSUBX*32,CPRC*32,CMSGX*200

      EXTERNAL  LCHREQ,LENC

      SAVE

      DATA      IMSG/0/


      CALL GLIGET('MSGUNIT',IUNIT)
      CALL GLIGET('MAXMSG',MAXMSG)
      CALL GLIGET('MSGLEV',MSGLEV)
      CALL GLIGET('NLNSIZE',LNSIZE)
      CALL GLLGET('LLMSG',LLMSG)
      CALL PRCLVL(NLEV)
      CALL PRCNAM(MIN(NLEV,1), CPRC)

      CLEVX=CLEV
      CSUBX=CSUB
      LMSG=LENC(CMSG)
      LPRC=LENC(CPRC)
      LSUB=LENC(CSUBX)

      IF (LCHREQ(CLEVX,'E')) THEN
        IF (LLMSG) THEN
          CMSGX='*** Error ('//CSUBX(1:LSUB)// '@ '
     #         //CPRC(1:LPRC) // ') ' //CMSG(1:LMSG)
        ELSE
          CMSGX='***** ERROR ('//CSUBX(1:6)//') ***  '//CMSG(1:LMSG)
        END IF
        CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
        CALL OSABRT
        STOP
      END IF
      IF (IMSG.LT.MAXMSG) THEN
        IF (LCHREQ(CLEVX,'W') .AND. MSGLEV.LE.1) THEN
          IMSG=IMSG+1
          IF (LLMSG) THEN
            CMSGX='- Warning ('//CSUBX(1:LSUB)// '@ '
     #           //CPRC(1:LPRC) // ') ' //CMSG(1:LMSG)
          ELSE
            CMSGX='*** WARNING ('//CSUBX(1:6)//') ***  '//CMSG(1:LMSG)
          END IF
          CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
        ELSE IF (LCHREQ(CLEVX,'M') .AND. MSGLEV.LE.0) THEN
          IMSG=IMSG+1
          IF (LLMSG) THEN
            CMSGX='- Message ('//CSUBX(1:LSUB)// '@ '
     #           //CPRC(1:LPRC) // ') '//CMSG(1:LMSG)
          ELSE
            CMSGX='*** MESSAGE ('//CSUBX(1:6)//') ***  '//CMSG(1:LMSG)
          END IF
          CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
        END IF
        IF (IMSG.EQ.MAXMSG) THEN
          CMSGX='+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.'
          CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
        END IF
      END IF

      END
