1 /* -- translated by f2c (version 20100827).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10 http://www.netlib.org/f2c/libf2c.zip
11 */
12
13 #include "libtinyf2c.h"
14
15 /* Table of constant values */
16
17 static integer c__1 = 1;
18
19 /* ----------------------------------------------------------------------- */
20 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
21 /* ----------------------------------------------------------------------- */
sgpwsn_(void)22 /* Subroutine */ int sgpwsn_(void)
23 {
24 /* System generated locals */
25 integer i__1, i__2;
26 icilist ici__1;
27
28 /* Builtin functions */
29 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
30 integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
31 , s_wsfe(cilist *), e_wsfe(void);
32
33 /* Local variables */
34 static integer i__, n, nc, iu, nx;
35 extern integer lenc_(char *, ftnlen);
36 static char line[100], cwnm[8], cwsn[8];
37 extern /* Subroutine */ int gliget_(char *, integer *, ftnlen), swcget_(
38 char *, char *, ftnlen, ftnlen), swiget_(char *, integer *,
39 ftnlen);
40 static integer maxwnu;
41
42 /* Fortran I/O blocks */
43 static icilist io___7 = { 0, cwnm, 0, "(A6,I2.2)", 8, 1 };
44 static cilist io___11 = { 0, 0, 0, "(A)", 0 };
45
46
47 gliget_("MSGUNIT", &iu, (ftnlen)7);
48 swiget_("MAXWNU", &maxwnu, (ftnlen)6);
49 n = 0;
50 s_copy(line, " ", (ftnlen)100, (ftnlen)1);
51 i__1 = maxwnu;
52 for (i__ = 1; i__ <= i__1; ++i__) {
53 s_wsfi(&io___7);
54 do_fio(&c__1, "WSNAME", (ftnlen)6);
55 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
56 e_wsfi();
57 swcget_(cwnm, cwsn, (ftnlen)8, (ftnlen)8);
58 nc = lenc_(cwsn, (ftnlen)8);
59 if (i__ < 10) {
60 nx = nc + 4;
61 i__2 = n;
62 ici__1.icierr = 0;
63 ici__1.icirnum = 1;
64 ici__1.icirlen = n + nx - i__2;
65 ici__1.iciunit = line + i__2;
66 ici__1.icifmt = "(TR1,I1,A1,A,A1)";
67 s_wsfi(&ici__1);
68 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
69 do_fio(&c__1, ":", (ftnlen)1);
70 do_fio(&c__1, cwsn, nc);
71 do_fio(&c__1, ",", (ftnlen)1);
72 e_wsfi();
73 } else {
74 nx = nc + 5;
75 i__2 = n;
76 ici__1.icierr = 0;
77 ici__1.icirnum = 1;
78 ici__1.icirlen = n + nx - i__2;
79 ici__1.iciunit = line + i__2;
80 ici__1.icifmt = "(TR1,I2,A1,A,A1)";
81 s_wsfi(&ici__1);
82 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
83 do_fio(&c__1, ":", (ftnlen)1);
84 do_fio(&c__1, cwsn, nc);
85 do_fio(&c__1, ",", (ftnlen)1);
86 e_wsfi();
87 }
88 n += nx;
89 /* L10: */
90 }
91 ici__1.icierr = 0;
92 ici__1.icirnum = 1;
93 ici__1.icirlen = 2;
94 ici__1.iciunit = line + (n - 1);
95 ici__1.icifmt = "(A2)";
96 s_wsfi(&ici__1);
97 do_fio(&c__1, " ;", (ftnlen)2);
98 e_wsfi();
99 io___11.ciunit = iu;
100 s_wsfe(&io___11);
101 do_fio(&c__1, line, n + 1);
102 e_wsfe();
103 return 0;
104 } /* sgpwsn_ */
105
106