1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
c* ***************************************************************************
c* MALOC = < Minimal Abstraction Layer for Object-oriented C >
c* Copyright (C) 1994-- Michael Holst
c*
c* This library is free software; you can redistribute it and/or
c* modify it under the terms of the GNU Lesser General Public
c* License as published by the Free Software Foundation; either
c* version 2.1 of the License, or (at your option) any later version.
c*
c* This library is distributed in the hope that it will be useful,
c* but WITHOUT ANY WARRANTY; without even the implied warranty of
c* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
c* Lesser General Public License for more details.
c*
c* You should have received a copy of the GNU Lesser General Public
c* License along with this library; if not, write to the Free Software
c* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
c*
c* rcsid="$Id: mainf.f,v 1.10 2010/08/12 05:40:43 fetk Exp $"
c* ***************************************************************************
c*****************************************************************************
c* FORTRAN interface to vnm library:
c*
c* int function vrand();
c* int function vrndmx();
c* double function vepsma();
c* subroutine vtstrt(timer, name, len);
c* subroutine vtstop(timer, name, len);
c* int function vsystm(cmd, len);
c* subroutine vnmprt(int *unit, char *strng, int *len);
c*
c* timer --- integer timer number
c* name --- char timer name of length eq len (with no '\0')
c* cmd --- char command of length eq len (with no '\0')
c* val --- integer tag number
c* unit --- integer I/O unit number
c* strng --- char message of length eq len (with no '\0')
c*
c* FORTRAN interface to vio library:
c*
c* int function vioctr(type, frmt, host, lenh, file, lenf, cmode)
c* int function viodtr(sockn)
c* int function vioutl(sockn, mode)
c* subroutine vioint(sockn, ival, len)
c* subroutine vioflt(sockn, rval, len)
c* subroutine viodbl(sockn, dval, len)
c* subroutine viostr(sockn, sval, len)
c*
c* sockn --- integer socket number
c*
c* type --- char*4 vio device type (FILE,PIPE,UNIX,INET,MPI1)
c* frmt --- char*3 datatype (XDR,ASC)
c*
c* host --- char hostname of length eq lenh (with no '\0')
c* file --- char filename of length eq lenf (with no '\0')
c*
c* cmode --- char*1 'r' create for read, or 'w' create for write
c* mode --- char*1 'o' open, or 'c' close (both for read/write)
c*
c* ival --- int array of length len
c* rval --- float array of length len
c* dval --- double array of length len
c* sval --- char array of length len (no terminating '\0')
c*
c*****************************************************************************
program main
c* ***************************************************************************
c* File: mainf.f
c*
c* Purpose: Test the FORTRAN interface to the VNM and VIO libraries.
c*
c* Author: Michael Holst
c* ***************************************************************************
implicit none
integer vio1, vio2, rc
integer vioctr, viodtr, vioutl
integer vrand, vrndmx
double precision vepsma
call vtstrt(10, "Test Program", 12);
c* *** some VNM testing ***
call vnmprt(0, '0: This message is being sent to VNM unit 0',43)
call vnmprt(1, '1: This message is being sent to VNM unit 1',43)
call vnmprt(2, '2: This message is being sent to VNM unit 2',43)
call vnmpri(2, '2: A call to vrand() produces: ',34,vrand())
call vnmpri(2, '2: A call to vrndmx() produces: ',34,vrndmx())
call vnmprd(2, '2: A call to vepsma() produces: ',34,vepsma())
call vnmprt(2, '2: Sending "df" command to system ',34)
call vsystm('df', 2)
call vnmprt(2, '2: Returned from the "df" command ',34)
c* *** start (initialize) the VIO library ***
call viosta()
c* *** you can call the VIO initializer multiple times w/o error ***
call viosta()
call viosta()
call viosta()
c* *** construct VIO1 (socket 1) and VIO2 (socket 2) ***
vio1 = vioctr('INET', 'ASC', 'localhost',9, '1',1, 'w')
if (vio1 .lt. 0) call vnmprt(2,'2: vioctr vio1 failed',21)
vio2 = vioctr('INET', 'ASC', 'localhost',9, '2',1, 'w')
if (vio2 .lt. 0) call vnmprt(2,'2: vioctr vio2 failed',21)
c* *** open VIO1 and VIO2 connections for writing ***
rc = vioutl(vio1,'o')
if (rc .ne. 0) call vnmprt(2,'2: vioutl vio1 failed',21)
rc = vioutl(vio2,'o')
if (rc .ne. 0) call vnmprt(2,'2: vioutl vio2 failed',21)
c* *** write things to VIO1 and VIO2 ***
call myoutput(vio1)
call myoutput(vio2)
c* *** close VIO1 and VIO2 connections ***
rc = vioutl(vio1,'c')
if (rc .ne. 0) call vnmprt(2,'2: vioutl vio1 failed',21)
rc = vioutl(vio2,'c')
if (rc .ne. 0) call vnmprt(2,'2: vioutl vio2 failed',21)
c* *** destroy VIO1 and VIO2 ***
rc = viodtr(vio1)
if (rc .ne. 0) call vnmprt(2,'2: viodtr vio1 failed',21)
rc = viodtr(vio2)
if (rc .ne. 0) call vnmprt(2,'2: viodtr vio2 failed',21)
c* *** stop (de-initialize) the VIO library ***
call viostp()
c* *** you can call the VIO de-initializer multiple times w/o error ***
call viostp()
call viostp()
call viostp()
c* ************************************************************************
c* *** NOTE: once you call "viostp()" one time, you MUST call "viosta()"
c* *** BEFORE you can use any VIO routines again...otherwise an
c* *** error message is generated and you don't get any I/O.
c* *** I.e., any calls to the VIO routine must be preceeded by
c* *** at least one call to "viosta()", with no intervening calls
c* *** to "viostp()".
c* ************************************************************************
call vtstop(10, "Test Program", 12);
call vnmprt(2,'2: Stopping the program. ',43)
stop
end
c* ***************************************************************************
subroutine myoutput(vio)
integer vio
c* *** write out a single red triangle in BH format ***
call viostr(vio,'bhsingle',8)
call viostr(vio,'putl',4)
call vioint(vio,1,1)
call vioflt(vio,1.0,1)
call vioflt(vio,0.0,1)
call vioflt(vio,0.0,1)
call viostr(vio,'list',4)
call vioint(vio,7,1)
call viostr(vio,'fill',4)
call vioint(vio,1,1)
call vioint(vio,3,1)
call vioflt(vio,0.1,1)
call vioflt(vio,0.9,1)
call vioflt(vio,0.1,1)
call vioflt(vio,0.1,1)
call vioflt(vio,0.1,1)
call vioflt(vio,0.9,1)
call vioflt(vio,0.1,1)
call vioflt(vio,0.1,1)
call vioflt(vio,0.1,1)
call viostr(vio,'list',4)
call vioint(vio,-7,1)
call viostr(vio,'putl',4)
call vioint(vio,-1,1)
return
end
|
