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