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__9 = 9;
18 static integer c__1 = 1;
19 static integer c__3 = 3;
20
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
MAIN__(void)24 /* Main program */ int MAIN__(void)
25 {
26 /* System generated locals */
27 integer i__1;
28 char ch__1[9], ch__2[9];
29
30 /* Builtin functions */
31 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
32 e_wsle(void);
33 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
34
35 /* Local variables */
36 static integer id, im, iy, itd;
37 extern /* Subroutine */ int date31_(integer *, integer *, integer *,
38 integer *), date32_(integer *, integer *, integer *, integer *);
39 static integer idate;
40 extern /* Character */ VOID cweek_(char *, ftnlen, integer *);
41 extern /* Subroutine */ int dateq3_(integer *, integer *, integer *);
42 extern integer iweek1_(integer *), iweek2_(integer *, integer *), iweek3_(
43 integer *, integer *, integer *);
44
45 /* Fortran I/O blocks */
46 static cilist io___6 = { 0, 6, 0, 0, 0 };
47 static cilist io___7 = { 0, 6, 0, 0, 0 };
48 static cilist io___8 = { 0, 6, 0, 0, 0 };
49 static cilist io___9 = { 0, 6, 0, 0, 0 };
50 static cilist io___10 = { 0, 6, 0, 0, 0 };
51 static cilist io___11 = { 0, 6, 0, 0, 0 };
52 static cilist io___12 = { 0, 6, 0, 0, 0 };
53 static cilist io___13 = { 0, 6, 0, 0, 0 };
54 static cilist io___14 = { 0, 6, 0, 0, 0 };
55
56
57 dateq3_(&iy, &im, &id);
58 date31_(&idate, &iy, &im, &id);
59 date32_(&iy, &im, &id, &itd);
60 s_wsle(&io___6);
61 do_lio(&c__9, &c__1, "*** TYPE-1", (ftnlen)10);
62 e_wsle();
63 s_wsle(&io___7);
64 do_lio(&c__9, &c__1, "DATE = ", (ftnlen)7);
65 do_lio(&c__3, &c__1, (char *)&idate, (ftnlen)sizeof(integer));
66 do_lio(&c__9, &c__1, " ;", (ftnlen)2);
67 e_wsle();
68 s_wsle(&io___8);
69 do_lio(&c__9, &c__1, "WEEK = ", (ftnlen)7);
70 i__1 = iweek1_(&idate);
71 cweek_(ch__2, (ftnlen)9, &i__1);
72 s_copy(ch__1, ch__2, (ftnlen)9, (ftnlen)9);
73 do_lio(&c__9, &c__1, ch__1, (ftnlen)9);
74 e_wsle();
75 s_wsle(&io___9);
76 do_lio(&c__9, &c__1, "*** TYPE-2", (ftnlen)10);
77 e_wsle();
78 s_wsle(&io___10);
79 do_lio(&c__9, &c__1, "YEAR = ", (ftnlen)7);
80 do_lio(&c__3, &c__1, (char *)&iy, (ftnlen)sizeof(integer));
81 do_lio(&c__9, &c__1, " ; TOTAL DAYS = ", (ftnlen)16);
82 do_lio(&c__3, &c__1, (char *)&itd, (ftnlen)sizeof(integer));
83 do_lio(&c__9, &c__1, " ;", (ftnlen)2);
84 e_wsle();
85 s_wsle(&io___11);
86 do_lio(&c__9, &c__1, "WEEK = ", (ftnlen)7);
87 i__1 = iweek2_(&iy, &itd);
88 cweek_(ch__2, (ftnlen)9, &i__1);
89 s_copy(ch__1, ch__2, (ftnlen)9, (ftnlen)9);
90 do_lio(&c__9, &c__1, ch__1, (ftnlen)9);
91 e_wsle();
92 s_wsle(&io___12);
93 do_lio(&c__9, &c__1, "*** TYPE-3", (ftnlen)10);
94 e_wsle();
95 s_wsle(&io___13);
96 do_lio(&c__9, &c__1, "YEAR = ", (ftnlen)7);
97 do_lio(&c__3, &c__1, (char *)&iy, (ftnlen)sizeof(integer));
98 do_lio(&c__9, &c__1, " ; MONTH = ", (ftnlen)11);
99 do_lio(&c__3, &c__1, (char *)&im, (ftnlen)sizeof(integer));
100 do_lio(&c__9, &c__1, " ; DAY = ", (ftnlen)9);
101 do_lio(&c__3, &c__1, (char *)&id, (ftnlen)sizeof(integer));
102 do_lio(&c__9, &c__1, " ;", (ftnlen)2);
103 e_wsle();
104 s_wsle(&io___14);
105 do_lio(&c__9, &c__1, "WEEK = ", (ftnlen)7);
106 i__1 = iweek3_(&iy, &im, &id);
107 cweek_(ch__2, (ftnlen)9, &i__1);
108 s_copy(ch__1, ch__2, (ftnlen)9, (ftnlen)9);
109 do_lio(&c__9, &c__1, ch__1, (ftnlen)9);
110 e_wsle();
111 return 0;
112 } /* MAIN__ */
113
date03_()114 /* Main program alias */ int date03_ () { MAIN__ (); return 0; }
115