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 /* Common Block Declarations */
16
17 struct {
18 real qsize, ct, st;
19 integer icentz;
20 } szbtx1_;
21
22 #define szbtx1_1 szbtx1_
23
24 struct {
25 logical lcntl;
26 integer jsup, jsub, jrst;
27 real small, shift;
28 } szbtx2_;
29
30 #define szbtx2_1 szbtx2_
31
32 struct {
33 logical lclip;
34 } szbtx3_;
35
36 #define szbtx3_1 szbtx3_
37
38 /* Table of constant values */
39
40 static integer c__1 = 1;
41
42 /* ----------------------------------------------------------------------- */
43 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
44 /* ----------------------------------------------------------------------- */
sztxop_0_(int n__,real * rsize,integer * irota,integer * icent,integer * index)45 /* Subroutine */ int sztxop_0_(int n__, real *rsize, integer *irota, integer *
46 icent, integer *index)
47 {
48 /* System generated locals */
49 real r__1;
50
51 /* Builtin functions */
52 double cos(doublereal), sin(doublereal);
53 integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
54 ;
55
56 /* Local variables */
57 static integer iws;
58 extern real rd2r_(real *);
59 static char cobj[80];
60 static integer isub, isup, irst;
61 extern /* Subroutine */ int cdblk_(char *, ftnlen);
62 static real theta;
63 static integer ifont;
64 extern /* Subroutine */ int sgiget_(char *, integer *, ftnlen), sglget_(
65 char *, logical *, ftnlen), sgrget_(char *, real *, ftnlen);
66 static integer indexz;
67 extern /* Subroutine */ int swocls_(char *, ftnlen), szqidx_(integer *),
68 szsidx_(integer *), swoopn_(char *, char *, ftnlen, ftnlen);
69
70 /* Fortran I/O blocks */
71 static icilist io___9 = { 0, cobj, 0, "(F8.5,5I8)", 80, 1 };
72
73
74 switch(n__) {
75 case 1: goto L_sztxcl;
76 }
77
78 sgiget_("IFONT", &ifont, (ftnlen)5);
79 szbtx1_1.qsize = *rsize / 24.f;
80 r__1 = (real) (*irota);
81 theta = rd2r_(&r__1);
82 szbtx1_1.ct = szbtx1_1.qsize * cos(theta);
83 szbtx1_1.st = szbtx1_1.qsize * sin(theta);
84 szbtx1_1.icentz = *icent;
85 sglget_("LCNTL", &szbtx2_1.lcntl, (ftnlen)5);
86 sgiget_("ISUP", &isup, (ftnlen)4);
87 sgiget_("ISUB", &isub, (ftnlen)4);
88 sgiget_("IRST", &irst, (ftnlen)4);
89 sgrget_("SMALL", &szbtx2_1.small, (ftnlen)5);
90 sgrget_("SHIFT", &szbtx2_1.shift, (ftnlen)5);
91 sglget_("LCLIP", &szbtx3_1.lclip, (ftnlen)5);
92 sgiget_("IWS", &iws, (ftnlen)3);
93 szbtx2_1.jsup = isup + 1;
94 szbtx2_1.jsub = isub + 1;
95 szbtx2_1.jrst = irst + 1;
96 szqidx_(&indexz);
97 szsidx_(index);
98 s_wsfi(&io___9);
99 do_fio(&c__1, (char *)&(*rsize), (ftnlen)sizeof(real));
100 do_fio(&c__1, (char *)&(*irota), (ftnlen)sizeof(integer));
101 do_fio(&c__1, (char *)&(*icent), (ftnlen)sizeof(integer));
102 do_fio(&c__1, (char *)&(*index), (ftnlen)sizeof(integer));
103 do_fio(&c__1, (char *)&ifont, (ftnlen)sizeof(integer));
104 do_fio(&c__1, (char *)&iws, (ftnlen)sizeof(integer));
105 e_wsfi();
106 /* WRITE(COBJ,'(F8.5,5I8)') RSIZE,IROTA,ICENT,INDEX,IWS */
107 cdblk_(cobj, (ftnlen)80);
108 swoopn_("SZTX", cobj, (ftnlen)4, (ftnlen)80);
109 return 0;
110 /* ----------------------------------------------------------------------- */
111
112 L_sztxcl:
113 szsidx_(&indexz);
114 swocls_("SZTX", (ftnlen)4);
115 return 0;
116 } /* sztxop_ */
117
sztxop_(real * rsize,integer * irota,integer * icent,integer * index)118 /* Subroutine */ int sztxop_(real *rsize, integer *irota, integer *icent,
119 integer *index)
120 {
121 return sztxop_0_(0, rsize, irota, icent, index);
122 }
123
sztxcl_(void)124 /* Subroutine */ int sztxcl_(void)
125 {
126 return sztxop_0_(1, (real *)0, (integer *)0, (integer *)0, (integer *)0);
127 }
128
129