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__12 = 12;
18
19 /* ----------------------------------------------------------------------- */
20 /* UYPNUM : PLOT NUMBERS */
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
uypnum_(char * cside,integer * islct,real * uy,integer * n,ftnlen cside_len)24 /* Subroutine */ int uypnum_(char *cside, integer *islct, real *uy, integer *
25 n, ftnlen cside_len)
26 {
27 /* System generated locals */
28 integer i__1;
29
30 /* Local variables */
31 static integer i__;
32 static char ch[12*40];
33 extern /* Subroutine */ int chval_(char *, real *, char *, ftnlen, ftnlen)
34 ;
35 static char cfmtz[16];
36 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
37 ftnlen, ftnlen);
38 extern logical luychk_(char *, ftnlen);
39 extern /* Subroutine */ int uzcget_(char *, char *, ftnlen, ftnlen),
40 uyplbl_(char *, integer *, real *, char *, integer *, integer *,
41 ftnlen, ftnlen);
42
43 /* / CHECK ARGUMENTS / */
44 /* Parameter adjustments */
45 --uy;
46
47 /* Function Body */
48 if (! luychk_(cside, (ftnlen)1)) {
49 msgdmp_("E", "UYPNUM", "SIDE PARAMETER IS INVALID.", (ftnlen)1, (
50 ftnlen)6, (ftnlen)26);
51 }
52 if (! (0 <= *islct && *islct <= 2)) {
53 msgdmp_("E", "UYPNUM", "'ISLCT' IS INVALID.", (ftnlen)1, (ftnlen)6, (
54 ftnlen)19);
55 }
56 if (*n <= 0) {
57 msgdmp_("E", "UYPNUM", "NUMBER OF POINTS IS INVALID.", (ftnlen)1, (
58 ftnlen)6, (ftnlen)28);
59 } else if (*n > 40) {
60 msgdmp_("E", "UYPNUM", "WORKING AREA IS NOT ENOUGH.", (ftnlen)1, (
61 ftnlen)6, (ftnlen)27);
62 }
63 /* / GENERATE CHARACTERS / */
64 uzcget_("CYFMT", cfmtz, (ftnlen)5, (ftnlen)16);
65 i__1 = *n;
66 for (i__ = 1; i__ <= i__1; ++i__) {
67 chval_(cfmtz, &uy[i__], ch + (i__ - 1) * 12, (ftnlen)16, (ftnlen)12);
68 /* L10: */
69 }
70 /* / UYPLBL CALL / */
71 uyplbl_(cside, islct, &uy[1], ch, &c__12, n, (ftnlen)1, (ftnlen)12);
72 return 0;
73 } /* uypnum_ */
74
75