[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dennou-ruby:000965] msgdmp for CDCL
�ⶶ(FIP)�͡����͡�
��Ƿ��Ǥ���
�������˾���Ƥޤ��� CDCL �ˤ����� msgdmp_ �����ؤ���ǽ�ˤ���
��Ǥ�������ʬ�Ǥ��ޤ����Τǡ�dcl-5.2C �ѤΥѥå���ź�դ��ޤ���
cd src/math1/syslib ���ư��ƤƤ����������ѥå��κ�����˺��켫��
���ʤ��Τǡ�syslib �ݤ��Ȥ�ź�դ��ޤ���������ƤߤƤ���������
�Ƥ뤳�Ȥϳ�ǧ���ޤ����������ʤߤ˺�����ϡ��Ť������������ä��ǥ�
�쥯�ȥ�� ../syslib.old �Ȥ��ơ��ʲ��Τ褦�ˤ��ޤ�����
% diff -c -r -N ../syslib.old . > ! ../patch-syslib
���̤�������Ǥ����Τ��ʤ���
���ơ�����ˤ�� RubyDCL �ˤ����Ƥϡ�ruby �ѤΥ��顼�ϥ�ɥ��
�ؿ����֤������뤳�Ȥǡ�������λ��ͫ���ܤ˹��ʤ��ƺѤ�褦�ˤ�
��ޤ������ˤ��Τ���Υץ�����������Ԥ��ޤ����ΤǡʤȤ�������
����ؤ��Υƥ��Ȥ� RubyDCL �ǹԤä��ˡ�CDCL �Τۤ������åץǡ���
�����лȤ���褦�ˤʤ�ޤ�����ǥѥå��η���ή���ޤ����嵭��
CDCL ���ѹ���Ԥä���Τ����������С��������Ȥ߹��ߤ�����
�פ��ޤ���
�ⶶ�������������櫓�ǡ�������Ȥ߹������Τ����������
�ΤǤ��������ߤκǿ���
ftp://www.gfd-dennou.org/arch/dcl/dcl-5.2-C.tar.gz ���顢�����
�ȤǤ⤽����ǥ��åץǡ��Ȥ��Ƥ���ʬ�Ϥ���ޤ������⤷����Ф���
��Ǽ�����ǥ������Ƥ���������ftp�ΰ�� cp ����Τ� dcl ��
�롼�פ���ʤ��Ƚ���ʤ��Τǡ�ï���ˤ�ä��㤤�ޤ��礦����ë����
�����ʤ��Τǡ�¿˻�ΤȤ����������ʤ������Ӥ���ǡˡ�����������
������ź�դ� tar.gz �ե������Ȥ��С�syslib ��ݤ����֤�������
�Ф����Ǥ����ޤ�����������������åץǡ��Ȥ��Ƥʤ����ϡ�ftp��
�ν����Ϥ�����ǹԤ��ޤ�����������ˤ��Ƥ⡢������ˤ����ܲȤؤ�
�����ߤϤ��ꤤ���ޤ�������ˡ���� SunOS 2.6 + gcc �Ǥ�����ǧ
���Ƥʤ��Τǡ��������ư���ǧ����Ƥ����Ķ��Ǥγ�ǧ�⤪�ꤤ����
����
��Ƿ�� �� horinout@xxxxxx
�������������Ȳʳظ��楻�� 611-0011 �����Ըޥ���
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/Makefile ./Makefile
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/Makefile Wed Aug 1 18:41:02 2001
--- ./Makefile Fri Nov 30 20:47:55 2001
***************
*** 40,45 ****
--- 40,49 ----
@xxxxxx -e "s!@xxxxxx!$(DBASEDIR)/!" \
glcqnp.g > glcqnp.c
+ msgdmp.o: msgdmp.c
+ msgdmp.c:
+ msgdmp_modify.csh
+
install: archive ranlib
archive:
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c ./msgdmp.c
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c Wed Aug 1 18:41:02 2001
--- ./msgdmp.c Fri Nov 30 20:48:37 2001
***************
*** 15,22 ****
/* ----------------------------------------------------------------------- */
/* Copyright (C) 2000 GFD Dennou Club. All rights reserved. */
/* ----------------------------------------------------------------------- */
! /* Subroutine */ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
! clev_len, ftnlen csub_len, ftnlen cmsg_len)
{
/* Initialized data */
--- 15,22 ----
/* ----------------------------------------------------------------------- */
/* Copyright (C) 2000 GFD Dennou Club. All rights reserved. */
/* ----------------------------------------------------------------------- */
! /* Subroutine */ int msgdmp_dclorig(char *clev, char *csub, char *cmsg, int
! clev_len, int csub_len, int cmsg_len)
{
/* Initialized data */
***************
*** 132,134 ****
--- 132,276 ----
return 0;
} /* msgdmp_ */
+ /* ----------------------------------------------------
+ * switchable MSGDMP by T. Horinouchi 2001/11/30
+ *
+ * function msgdmp_ in the following is to be used in place of
+ * the original msgdmp_, which is renamed as msgdmp_dclorig above.
+ * the new msgdmp_ calls msgdmp_func whose default value is
+ * msgdmp_dclorig. Thus, the default behavior the msgdmp_ is the same
+ * as before. However, msgdmp_func can be replaced by using
+ * set_msgdmp_func. Also, only the behaviour on error can be modified
+ * with set_mgsdmp_err.
+ * ---------------------------------------------------- */
+
+ static int (*msgdmp_func)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len)
+ = msgdmp_dclorig ; /* <-- default function */
+
+ static int (*msgdmp_err_func)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len); /* no default */
+
+ static int msgdmp_err_replaceable (char *, char *, char *, int, int, int);
+ /* ^ defined below */
+
+ int set_msgdmp_func( int (*f)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len) )
+ {
+ msgdmp_func = f;
+ }
+
+ int set_msgdmp_err_func( int (*f)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len) )
+ {
+ msgdmp_err_func = f;
+ msgdmp_func = msgdmp_err_replaceable;
+ }
+
+ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
+ clev_len, ftnlen csub_len, ftnlen cmsg_len)
+ {
+ return( (*msgdmp_func)(clev, csub, cmsg,
+ clev_len, csub_len, cmsg_len) );
+ }
+
+ static int msgdmp_err_replaceable(char *clev, char *csub, char *cmsg, int
+ clev_len, int csub_len, int cmsg_len)
+ /* msgdmp_err_replaceable: by T Horinouchi 2001/11/30
+ same as msgdmp_dclorig except that msgdmp_err_func (to be set
+ by set_msgdmp_err_func) is called on error */
+ {
+ /* Initialized data */
+
+ static integer imsg = 0;
+
+ /* System generated locals */
+ address a__1[6], a__2[4];
+ integer i__1, i__2[6], i__3[4];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
+ char **, integer *, integer *, ftnlen), s_stop(char *, ftnlen);
+
+ /* Local variables */
+ extern integer lenc_(char *, ftnlen);
+ static char cprc[32];
+ static integer lprc, lmsg, nlev, lsub;
+ static logical llmsg;
+ static char clevx[1], cmsgx[200], csubx[32];
+ static integer iunit;
+ extern /* Subroutine */ int gliget_(char *, integer *, ftnlen);
+ extern logical lchreq_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int gllget_(char *, logical *, ftnlen), prcnam_(
+ integer *, char *, ftnlen), osabrt_(void);
+ static integer maxmsg, msglev;
+ extern /* Subroutine */ int prclvl_(integer *);
+ static integer lnsize;
+ extern /* Subroutine */ int mszdmp_(char *, integer *, integer *, ftnlen);
+
+ gliget_("MSGUNIT", &iunit, (ftnlen)7);
+ gliget_("MAXMSG", &maxmsg, (ftnlen)6);
+ gliget_("MSGLEV", &msglev, (ftnlen)6);
+ gliget_("NLNSIZE", &lnsize, (ftnlen)7);
+ gllget_("LLMSG", &llmsg, (ftnlen)5);
+ prclvl_(&nlev);
+ i__1 = min(nlev,1);
+ prcnam_(&i__1, cprc, (ftnlen)32);
+ s_copy(clevx, clev, (ftnlen)1, clev_len);
+ s_copy(csubx, csub, (ftnlen)32, csub_len);
+ lmsg = lenc_(cmsg, cmsg_len);
+ lprc = lenc_(cprc, (ftnlen)32);
+ lsub = lenc_(csubx, (ftnlen)32);
+ if (lchreq_(clevx, "E", (ftnlen)1, (ftnlen)1)) {
+ msgdmp_err_func(csub, cmsg, csub_len, cmsg_len);
+ }
+ if (imsg < maxmsg) {
+ if (lchreq_(clevx, "W", (ftnlen)1, (ftnlen)1) && msglev <= 1) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Warning (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** WARNING (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ } else if (lchreq_(clevx, "M", (ftnlen)1, (ftnlen)1) && msglev <= 0) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Message (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** MESSAGE (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ if (imsg == maxmsg) {
+ s_copy(cmsgx, "+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.", (
+ ftnlen)200, (ftnlen)42);
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ }
+ return 0;
+ } /* msgdmp_err_replaceable */
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c_orig ./msgdmp.c_orig
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp.c_orig Thu Jan 1 09:00:00 1970
--- ./msgdmp.c_orig Wed Aug 1 18:41:02 2001
***************
*** 0 ****
--- 1,134 ----
+ /* msgdmp.f -- translated by f2c (version 19990503).
+ You must link the resulting object file with the libraries:
+ -lf2c -lm (in that order)
+ */
+
+ #include "libtinyf2c.h"
+
+ /* Table of constant values */
+
+ static integer c__6 = 6;
+ static integer c__4 = 4;
+
+ /* ----------------------------------------------------------------------- */
+ /* MSGDMP */
+ /* ----------------------------------------------------------------------- */
+ /* Copyright (C) 2000 GFD Dennou Club. All rights reserved. */
+ /* ----------------------------------------------------------------------- */
+ /* Subroutine */ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
+ clev_len, ftnlen csub_len, ftnlen cmsg_len)
+ {
+ /* Initialized data */
+
+ static integer imsg = 0;
+
+ /* System generated locals */
+ address a__1[6], a__2[4];
+ integer i__1, i__2[6], i__3[4];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
+ char **, integer *, integer *, ftnlen), s_stop(char *, ftnlen);
+
+ /* Local variables */
+ extern integer lenc_(char *, ftnlen);
+ static char cprc[32];
+ static integer lprc, lmsg, nlev, lsub;
+ static logical llmsg;
+ static char clevx[1], cmsgx[200], csubx[32];
+ static integer iunit;
+ extern /* Subroutine */ int gliget_(char *, integer *, ftnlen);
+ extern logical lchreq_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int gllget_(char *, logical *, ftnlen), prcnam_(
+ integer *, char *, ftnlen), osabrt_(void);
+ static integer maxmsg, msglev;
+ extern /* Subroutine */ int prclvl_(integer *);
+ static integer lnsize;
+ extern /* Subroutine */ int mszdmp_(char *, integer *, integer *, ftnlen);
+
+ gliget_("MSGUNIT", &iunit, (ftnlen)7);
+ gliget_("MAXMSG", &maxmsg, (ftnlen)6);
+ gliget_("MSGLEV", &msglev, (ftnlen)6);
+ gliget_("NLNSIZE", &lnsize, (ftnlen)7);
+ gllget_("LLMSG", &llmsg, (ftnlen)5);
+ prclvl_(&nlev);
+ i__1 = min(nlev,1);
+ prcnam_(&i__1, cprc, (ftnlen)32);
+ s_copy(clevx, clev, (ftnlen)1, clev_len);
+ s_copy(csubx, csub, (ftnlen)32, csub_len);
+ lmsg = lenc_(cmsg, cmsg_len);
+ lprc = lenc_(cprc, (ftnlen)32);
+ lsub = lenc_(csubx, (ftnlen)32);
+ if (lchreq_(clevx, "E", (ftnlen)1, (ftnlen)1)) {
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "*** Error (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "***** ERROR (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ osabrt_();
+ s_stop("", (ftnlen)0);
+ }
+ if (imsg < maxmsg) {
+ if (lchreq_(clevx, "W", (ftnlen)1, (ftnlen)1) && msglev <= 1) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Warning (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** WARNING (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ } else if (lchreq_(clevx, "M", (ftnlen)1, (ftnlen)1) && msglev <= 0) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Message (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** MESSAGE (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ if (imsg == maxmsg) {
+ s_copy(cmsgx, "+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.", (
+ ftnlen)200, (ftnlen)42);
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ }
+ return 0;
+ } /* msgdmp_ */
+
diff -c -r -N /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp_modify.csh ./msgdmp_modify.csh
*** /home/muradar/horinout/davis/dcl-c/tmp/syslib.old/msgdmp_modify.csh Thu Jan 1 09:00:00 1970
--- ./msgdmp_modify.csh Fri Nov 30 20:35:45 2001
***************
*** 0 ****
--- 1,159 ----
+ #! /bin/tcsh -f
+
+ if ( -f msgdmp.c ) then
+ if ( ! -f msgdmp.c_orig ) then
+ mv msgdmp.c msgdmp.c_orig
+ else
+ rm msgdmp.c
+ endif
+ endif
+
+ ## replace "msgdmp_" with "msgdmp_dclorig" and "ftnlen" with "int"
+ ## is its arguments (to make tinyf2h.h unnecessary -- see the protpe
+ ## definition of msgdmp_func):
+ perl -ne 'if (/int +msgdmp_/) {s/msgdmp_/msgdmp_dclorig/;s/ftnlen/int/g;print;$h=1 if ( !(/\)$/) );} elsif ($h) {$h=0 if (/\)$/) ; s/ftnlen/int/g; print;} else {print;}' msgdmp.c_orig > msgdmp.c
+
+ cat >> msgdmp.c <<'EOF'
+ /* ----------------------------------------------------
+ * switchable MSGDMP by T. Horinouchi 2001/11/30
+ *
+ * function msgdmp_ in the following is to be used in place of
+ * the original msgdmp_, which is renamed as msgdmp_dclorig above.
+ * the new msgdmp_ calls msgdmp_func whose default value is
+ * msgdmp_dclorig. Thus, the default behavior the msgdmp_ is the same
+ * as before. However, msgdmp_func can be replaced by using
+ * set_msgdmp_func. Also, only the behaviour on error can be modified
+ * with set_mgsdmp_err.
+ * ---------------------------------------------------- */
+
+ static int (*msgdmp_func)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len)
+ = msgdmp_dclorig ; /* <-- default function */
+
+ static int (*msgdmp_err_func)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len); /* no default */
+
+ static int msgdmp_err_replaceable (char *, char *, char *, int, int, int);
+ /* ^ defined below */
+
+ int set_msgdmp_func( int (*f)(char *clev, char *csub, char *cmsg,
+ int clev_len, int csub_len, int cmsg_len) )
+ {
+ msgdmp_func = f;
+ }
+
+ int set_msgdmp_err_func( int (*f)(char *csub, char *cmsg,
+ int csub_len, int cmsg_len) )
+ {
+ msgdmp_err_func = f;
+ msgdmp_func = msgdmp_err_replaceable;
+ }
+
+ int msgdmp_(char *clev, char *csub, char *cmsg, ftnlen
+ clev_len, ftnlen csub_len, ftnlen cmsg_len)
+ {
+ return( (*msgdmp_func)(clev, csub, cmsg,
+ clev_len, csub_len, cmsg_len) );
+ }
+
+ static int msgdmp_err_replaceable(char *clev, char *csub, char *cmsg, int
+ clev_len, int csub_len, int cmsg_len)
+ /* msgdmp_err_replaceable: by T Horinouchi 2001/11/30
+ same as msgdmp_dclorig except that msgdmp_err_func (to be set
+ by set_msgdmp_err_func) is called on error */
+ {
+ /* Initialized data */
+
+ static integer imsg = 0;
+
+ /* System generated locals */
+ address a__1[6], a__2[4];
+ integer i__1, i__2[6], i__3[4];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
+ char **, integer *, integer *, ftnlen), s_stop(char *, ftnlen);
+
+ /* Local variables */
+ extern integer lenc_(char *, ftnlen);
+ static char cprc[32];
+ static integer lprc, lmsg, nlev, lsub;
+ static logical llmsg;
+ static char clevx[1], cmsgx[200], csubx[32];
+ static integer iunit;
+ extern /* Subroutine */ int gliget_(char *, integer *, ftnlen);
+ extern logical lchreq_(char *, char *, ftnlen, ftnlen);
+ extern /* Subroutine */ int gllget_(char *, logical *, ftnlen), prcnam_(
+ integer *, char *, ftnlen), osabrt_(void);
+ static integer maxmsg, msglev;
+ extern /* Subroutine */ int prclvl_(integer *);
+ static integer lnsize;
+ extern /* Subroutine */ int mszdmp_(char *, integer *, integer *, ftnlen);
+
+ gliget_("MSGUNIT", &iunit, (ftnlen)7);
+ gliget_("MAXMSG", &maxmsg, (ftnlen)6);
+ gliget_("MSGLEV", &msglev, (ftnlen)6);
+ gliget_("NLNSIZE", &lnsize, (ftnlen)7);
+ gllget_("LLMSG", &llmsg, (ftnlen)5);
+ prclvl_(&nlev);
+ i__1 = min(nlev,1);
+ prcnam_(&i__1, cprc, (ftnlen)32);
+ s_copy(clevx, clev, (ftnlen)1, clev_len);
+ s_copy(csubx, csub, (ftnlen)32, csub_len);
+ lmsg = lenc_(cmsg, cmsg_len);
+ lprc = lenc_(cprc, (ftnlen)32);
+ lsub = lenc_(csubx, (ftnlen)32);
+ if (lchreq_(clevx, "E", (ftnlen)1, (ftnlen)1)) {
+ msgdmp_err_func(csub, cmsg, csub_len, cmsg_len);
+ }
+ if (imsg < maxmsg) {
+ if (lchreq_(clevx, "W", (ftnlen)1, (ftnlen)1) && msglev <= 1) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Warning (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** WARNING (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ } else if (lchreq_(clevx, "M", (ftnlen)1, (ftnlen)1) && msglev <= 0) {
+ ++imsg;
+ if (llmsg) {
+ /* Writing concatenation */
+ i__2[0] = 11, a__1[0] = "- Message (";
+ i__2[1] = lsub, a__1[1] = csubx;
+ i__2[2] = 2, a__1[2] = "@xxxxxx ";
+ i__2[3] = lprc, a__1[3] = cprc;
+ i__2[4] = 2, a__1[4] = ") ";
+ i__2[5] = lmsg, a__1[5] = cmsg;
+ s_cat(cmsgx, a__1, i__2, &c__6, (ftnlen)200);
+ } else {
+ /* Writing concatenation */
+ i__3[0] = 13, a__2[0] = "*** MESSAGE (";
+ i__3[1] = 6, a__2[1] = csubx;
+ i__3[2] = 7, a__2[2] = ") *** ";
+ i__3[3] = lmsg, a__2[3] = cmsg;
+ s_cat(cmsgx, a__2, i__3, &c__4, (ftnlen)200);
+ }
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ if (imsg == maxmsg) {
+ s_copy(cmsgx, "+++ THE FOLLOWING MESSAGES ARE SUPPRESSED.", (
+ ftnlen)200, (ftnlen)42);
+ mszdmp_(cmsgx, &iunit, &lnsize, (ftnlen)200);
+ }
+ }
+ return 0;
+ } /* msgdmp_err_replaceable */
+ 'EOF'
syslib.tar.gz