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 /* UZCGET / UZCSET / UZCSTX */
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
uzcget_0_(int n__,char * cp,char * cpara,ftnlen cp_len,ftnlen cpara_len)24 /* Subroutine */ int uzcget_0_(int n__, char *cp, char *cpara, ftnlen cp_len,
25 ftnlen cpara_len)
26 {
27 /* Builtin functions */
28 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
29
30 /* Local variables */
31 static char cx[40];
32 static integer idx;
33 static char cpval[80];
34 extern /* Subroutine */ int rlcget_(char *, char *, integer *, ftnlen,
35 ftnlen), rtcget_(char *, char *, char *, integer *, ftnlen,
36 ftnlen, ftnlen), uzcqid_(char *, integer *, ftnlen), uzcqcl_(
37 integer *, char *, ftnlen), uzcqcp_(integer *, char *, ftnlen),
38 uzcqvl_(integer *, char *, ftnlen), uzcsvl_(integer *, char *,
39 ftnlen);
40
41 switch(n__) {
42 case 1: goto L_uzcset;
43 case 2: goto L_uzcstx;
44 }
45
46 uzcqid_(cp, &idx, cp_len);
47 uzcqvl_(&idx, cpara, cpara_len);
48 return 0;
49 /* ----------------------------------------------------------------------- */
50
51 L_uzcset:
52 uzcqid_(cp, &idx, cp_len);
53 uzcsvl_(&idx, cpara, cpara_len);
54 return 0;
55 /* ----------------------------------------------------------------------- */
56
57 L_uzcstx:
58 s_copy(cpval, cpara, (ftnlen)80, cpara_len);
59 uzcqid_(cp, &idx, cp_len);
60 uzcqcp_(&idx, cx, (ftnlen)40);
61 rtcget_("UZ", cx, cpval, &c__1, (ftnlen)2, (ftnlen)40, (ftnlen)80);
62 uzcqcl_(&idx, cx, (ftnlen)40);
63 rlcget_(cx, cpval, &c__1, (ftnlen)40, (ftnlen)80);
64 uzcsvl_(&idx, cpval, (ftnlen)80);
65 return 0;
66 } /* uzcget_ */
67
uzcget_(char * cp,char * cpara,ftnlen cp_len,ftnlen cpara_len)68 /* Subroutine */ int uzcget_(char *cp, char *cpara, ftnlen cp_len, ftnlen
69 cpara_len)
70 {
71 return uzcget_0_(0, cp, cpara, cp_len, cpara_len);
72 }
73
uzcset_(char * cp,char * cpara,ftnlen cp_len,ftnlen cpara_len)74 /* Subroutine */ int uzcset_(char *cp, char *cpara, ftnlen cp_len, ftnlen
75 cpara_len)
76 {
77 return uzcget_0_(1, cp, cpara, cp_len, cpara_len);
78 }
79
uzcstx_(char * cp,char * cpara,ftnlen cp_len,ftnlen cpara_len)80 /* Subroutine */ int uzcstx_(char *cp, char *cpara, ftnlen cp_len, ftnlen
81 cpara_len)
82 {
83 return uzcget_0_(2, cp, cpara, cp_len, cpara_len);
84 }
85
86