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 logical c_false = FALSE_;
18
19 /* ----------------------------------------------------------------------- */
20 /* UYPLBA : PLOT LABELS ( AT THE POINTS ) */
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
uyplba_(real * uy,char * ch,integer * nc,integer * n,real * upx,real * roffy,real * rsize,integer * irota,integer * icent,integer * index,ftnlen ch_len)24 /* Subroutine */ int uyplba_(real *uy, char *ch, integer *nc, integer *n,
25 real *upx, real *roffy, real *rsize, integer *irota, integer *icent,
26 integer *index, ftnlen ch_len)
27 {
28 /* System generated locals */
29 integer i__1;
30
31 /* Local variables */
32 static integer i__, lc;
33 static real vpx, vpy;
34 extern integer lenc_(char *, ftnlen);
35 extern /* Subroutine */ int sglget_(char *, logical *, ftnlen), msgdmp_(
36 char *, char *, char *, ftnlen, ftnlen, ftnlen);
37 static logical lclipz;
38 extern /* Subroutine */ int sglset_(char *, logical *, ftnlen), stftrf_(
39 real *, real *, real *, real *), sztxcl_(void), sztxop_(real *,
40 integer *, integer *, integer *), sztxzv_(real *, real *, char *,
41 ftnlen);
42
43 /* Parameter adjustments */
44 ch -= ch_len;
45 --uy;
46
47 /* Function Body */
48 if (*nc <= 0) {
49 msgdmp_("E", "UYPLBA", "CHARACTER LENGTH IS LESS THAN OR EQUAL TO ZE"
50 "RO.", (ftnlen)1, (ftnlen)6, (ftnlen)47);
51 }
52 if (*n <= 0) {
53 msgdmp_("E", "UYPLBA", "NUMBER OF POINTS IS INVALID.", (ftnlen)1, (
54 ftnlen)6, (ftnlen)28);
55 }
56 if (*rsize <= 0.f) {
57 msgdmp_("E", "UYPLBA", "TEXT HEIGHT IS LESS THAN ZERO.", (ftnlen)1, (
58 ftnlen)6, (ftnlen)30);
59 }
60 if (! (-1 <= *icent && *icent <= 1)) {
61 msgdmp_("E", "UYPLBA", "CENTERING OPTION IS INVALID.", (ftnlen)1, (
62 ftnlen)6, (ftnlen)28);
63 }
64 if (*index <= 0) {
65 msgdmp_("E", "UYPLBA", "TEXT INDEX IS INVALID.", (ftnlen)1, (ftnlen)6,
66 (ftnlen)22);
67 }
68 sglget_("LCLIP", &lclipz, (ftnlen)5);
69 sglset_("LCLIP", &c_false, (ftnlen)5);
70 i__1 = *irota * 90;
71 sztxop_(rsize, &i__1, icent, index);
72 i__1 = *n;
73 for (i__ = 1; i__ <= i__1; ++i__) {
74 lc = lenc_(ch + i__ * ch_len, ch_len);
75 stftrf_(upx, &uy[i__], &vpx, &vpy);
76 vpx += *roffy;
77 sztxzv_(&vpx, &vpy, ch + i__ * ch_len, lc);
78 /* L10: */
79 }
80 sztxcl_();
81 sglset_("LCLIP", &lclipz, (ftnlen)5);
82 return 0;
83 } /* uyplba_ */
84
85