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 /* SGLGET / SGLSET / SGLSTX */
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
sglget_0_(int n__,char * cp,logical * lpara,ftnlen cp_len)24 /* Subroutine */ int sglget_0_(int n__, char *cp, logical *lpara, ftnlen
25 cp_len)
26 {
27 static char cl[40], cx[8];
28 static logical lp;
29 static integer idx;
30 extern /* Subroutine */ int sglqid_(char *, integer *, ftnlen), sglqcl_(
31 integer *, char *, ftnlen), sglqcp_(integer *, char *, ftnlen),
32 rllget_(char *, logical *, integer *, ftnlen), rtlget_(char *,
33 char *, logical *, integer *, ftnlen, ftnlen), sglqvl_(integer *,
34 logical *), sglsvl_(integer *, logical *);
35
36 switch(n__) {
37 case 1: goto L_sglset;
38 case 2: goto L_sglstx;
39 }
40
41 sglqid_(cp, &idx, cp_len);
42 sglqvl_(&idx, lpara);
43 return 0;
44 /* ----------------------------------------------------------------------- */
45
46 L_sglset:
47 sglqid_(cp, &idx, cp_len);
48 sglsvl_(&idx, lpara);
49 return 0;
50 /* ----------------------------------------------------------------------- */
51
52 L_sglstx:
53 lp = *lpara;
54 sglqid_(cp, &idx, cp_len);
55 /* / SHORT NAME / */
56 sglqcp_(&idx, cx, (ftnlen)8);
57 rtlget_("SG", cx, &lp, &c__1, (ftnlen)2, (ftnlen)8);
58 /* / LONG NAME / */
59 sglqcl_(&idx, cl, (ftnlen)40);
60 rllget_(cl, &lp, &c__1, (ftnlen)40);
61 sglsvl_(&idx, &lp);
62 return 0;
63 } /* sglget_ */
64
sglget_(char * cp,logical * lpara,ftnlen cp_len)65 /* Subroutine */ int sglget_(char *cp, logical *lpara, ftnlen cp_len)
66 {
67 return sglget_0_(0, cp, lpara, cp_len);
68 }
69
sglset_(char * cp,logical * lpara,ftnlen cp_len)70 /* Subroutine */ int sglset_(char *cp, logical *lpara, ftnlen cp_len)
71 {
72 return sglget_0_(1, cp, lpara, cp_len);
73 }
74
sglstx_(char * cp,logical * lpara,ftnlen cp_len)75 /* Subroutine */ int sglstx_(char *cp, logical *lpara, ftnlen cp_len)
76 {
77 return sglget_0_(2, cp, lpara, cp_len);
78 }
79
80