1*-----------------------------------------------------------------------
2*     MSGDMP
3*-----------------------------------------------------------------------
4*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
5*-----------------------------------------------------------------------
6      SUBROUTINE MSGDMP(CLEV,CSUB,CMSG)
7
8      CHARACTER CLEV*(*),CSUB*(*),CMSG*(*)
9
10      LOGICAL   LCHREQ,LLMSG
11      CHARACTER CLEVX*1,CSUBX*32,CPRC*32,CMSGX*200
12
13      EXTERNAL  LCHREQ,LENC
14
15      SAVE
16
17      DATA      IMSG/0/
18
19
20      CALL GLIGET('MSGUNIT',IUNIT)
21      CALL GLIGET('MAXMSG',MAXMSG)
22      CALL GLIGET('MSGLEV',MSGLEV)
23      CALL GLIGET('NLNSIZE',LNSIZE)
24      CALL GLLGET('LLMSG',LLMSG)
25      CALL PRCLVL(NLEV)
26      CALL PRCNAM(MIN(NLEV,1), CPRC)
27
28      CLEVX=CLEV
29      CSUBX=CSUB
30      LMSG=LENC(CMSG)
31      LPRC=LENC(CPRC)
32      LSUB=LENC(CSUBX)
33
34      IF (LCHREQ(CLEVX,'E')) THEN
35        IF (LLMSG) THEN
36          CMSGX='*** Error ('//CSUBX(1:LSUB)// '@ '
37     #         //CPRC(1:LPRC) // ') ' //CMSG(1:LMSG)
38        ELSE
39          CMSGX='***** ERROR ('//CSUBX(1:6)//') ***  '//CMSG(1:LMSG)
40        END IF
41        CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
42        CALL OSABRT
43        STOP
44      END IF
45      IF (IMSG.LT.MAXMSG) THEN
46        IF (LCHREQ(CLEVX,'W') .AND. MSGLEV.LE.1) THEN
47          IMSG=IMSG+1
48          IF (LLMSG) THEN
49            CMSGX='- Warning ('//CSUBX(1:LSUB)// '@ '
50     #           //CPRC(1:LPRC) // ') ' //CMSG(1:LMSG)
51          ELSE
52            CMSGX='*** WARNING ('//CSUBX(1:6)//') ***  '//CMSG(1:LMSG)
53          END IF
54          CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
55        ELSE IF (LCHREQ(CLEVX,'M') .AND. MSGLEV.LE.0) THEN
56          IMSG=IMSG+1
57          IF (LLMSG) THEN
58            CMSGX='- Message ('//CSUBX(1:LSUB)// '@ '
59     #           //CPRC(1:LPRC) // ') '//CMSG(1:LMSG)
60          ELSE
61            CMSGX='*** MESSAGE ('//CSUBX(1:6)//') ***  '//CMSG(1:LMSG)
62          END IF
63          CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
64        END IF
65        IF (IMSG.EQ.MAXMSG) THEN
66          CMSGX='+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.'
67          CALL MSZDMP(CMSGX,IUNIT,LNSIZE)
68        END IF
69      END IF
70
71      END
72