1      SUBROUTINE BTSETUP( MEM, MEMLEN, CMEM, CMEMLEN, OUTNUM,
2     $                    TESTSDRV, TESTBSBR, TESTCOMB, TESTAUX,
3     $                    IAM, NNODES )
4*
5*  -- BLACS tester (version 1.0) --
6*  University of Tennessee
7*  December 15, 1994
8*
9*     .. Scalar Arguments ..
10      LOGICAL TESTSDRV, TESTBSBR, TESTCOMB, TESTAUX
11      INTEGER MEMLEN, CMEMLEN, OUTNUM, IAM, NNODES
12*     ..
13*     .. Array Arguments ..
14      INTEGER MEM(MEMLEN)
15      CHARACTER*1 CMEM(CMEMLEN)
16*     ..
17*
18*  Purpose
19*  =======
20*  BTSETUP:  Does nothing on non-PVM platforms
21*
22*  ====================================================================
23*     .. Executable Statements ..
24      RETURN
25      END
26*
27      INTEGER FUNCTION IBTMYPROC()
28*
29*  -- BLACS tester (version 1.0) --
30*  University of Tennessee
31*  December 15, 1994
32*
33*  Purpose
34*  =======
35*  IBTMYPROC: returns a process number between 0 .. NPROCS-1.  On
36*  systems not natively in this numbering scheme, translates to it.
37*
38*  ====================================================================
39*     .. External Subroutines ..
40      EXTERNAL MP_ENVIRON
41*     ..
42*     .. Local Scalars ..
43      INTEGER I, J
44*     ..
45*     .. Executable Statements ..
46      CALL MP_ENVIRON(I, J)
47      IBTMYPROC = J
48      RETURN
49*
50*     End of IBTMYPROC
51*
52      END
53*
54      INTEGER FUNCTION IBTNPROCS()
55*
56*  -- BLACS tester (version 1.0) --
57*  University of Tennessee
58*  December 15, 1994
59*
60*  Purpose
61*  =======
62*  IBTNPROCS: returns the number of processes in the machine.
63*
64*  ====================================================================
65*
66*     .. External Subroutines ..
67      EXTERNAL MP_ENVIRON
68*     ..
69*     .. Local Scalars ..
70      INTEGER I, J
71*     ..
72*     .. Executable Statements ..
73*
74      CALL MP_ENVIRON(I, J)
75      IBTNPROCS = I
76*
77      RETURN
78*
79*     End of IBTNPROCS
80*
81      END
82*
83      SUBROUTINE BTSEND(DTYPE, N, BUFF, DEST, MSGID)
84*
85*  -- BLACS tester (version 1.0) --
86*  University of Tennessee
87*  December 15, 1994
88*
89*     .. Scalar Arguments ..
90      INTEGER N, DTYPE, DEST, MSGID
91*     ..
92*     .. Array Arguments ..
93      REAL BUFF(*)
94*     ..
95*
96*     PURPOSE
97*     =======
98*     BTSEND: Communication primitive used to send messages independent
99*     of the BLACS.  May safely be either locally or globally blocking.
100*
101*     Arguments
102*     =========
103*     DTYPE    (input) INTEGER
104*              Indicates what data type BUFF is (same as PVM):
105*                1  =  RAW BYTES
106*                3  =  INTEGER
107*                4  =  SINGLE PRECISION REAL
108*                6  =  DOUBLE PRECISION REAL
109*                5  =  SINGLE PRECISION COMPLEX
110*                7  =  DOUBLE PRECISION COMPLEX
111*
112*     N        (input) INTEGER
113*              The number of elements of type DTYPE in BUFF.
114*
115*     BUFF     (input) accepted as INTEGER array
116*              The array to be communicated.  Its true data type is
117*              indicated by DTYPE.
118*
119*     DEST      (input) INTEGER
120*               The destination of the message.
121*
122*     MSGID     (input) INTEGER
123*               The message ID (AKA message tag or type).
124*
125* =====================================================================
126*     .. External Functions ..
127      INTEGER  IBTMYPROC, IBTNPROCS, IBTSIZEOF
128      EXTERNAL IBTMYPROC, IBTNPROCS, IBTSIZEOF
129*     ..
130*     .. Local Scalars ..
131      INTEGER I, IAM, LENGTH
132      INTEGER ISIZE, SSIZE, DSIZE, CSIZE, ZSIZE
133*     ..
134*     .. Save statement ..
135      SAVE  ISIZE, SSIZE, DSIZE, CSIZE, ZSIZE
136*     ..
137*     .. Data statements ..
138      DATA  ISIZE /-50/
139*     ..
140*     .. Executable Statements ..
141*
142*     On first call, initialize size variables
143*
144      IF( ISIZE .LT. 0 ) THEN
145         ISIZE = IBTSIZEOF('I')
146         SSIZE = IBTSIZEOF('S')
147         DSIZE = IBTSIZEOF('D')
148         CSIZE = IBTSIZEOF('C')
149         ZSIZE = IBTSIZEOF('Z')
150      END IF
151*
152*     Figure length of buffer
153*
154      IF( DTYPE .EQ. 1 ) THEN
155         LENGTH = N
156      ELSE IF( DTYPE .EQ. 3 ) THEN
157         LENGTH = N * ISIZE
158      ELSE IF( DTYPE .EQ. 4 ) THEN
159         LENGTH = N * SSIZE
160      ELSE IF( DTYPE .EQ. 5 ) THEN
161         LENGTH = N * CSIZE
162      ELSE IF( DTYPE .EQ. 6 ) THEN
163         LENGTH = N * DSIZE
164      ELSE IF( DTYPE .EQ. 7 ) THEN
165         LENGTH = N * ZSIZE
166      END IF
167*
168*     Send the message
169*
170      IF(DEST .EQ. -1)  THEN
171         IAM = IBTMYPROC()
172         DO 10 I = 0, IBTNPROCS()-1
173            IF( I .NE. IAM )
174     $         CALL MP_BSEND(BUFF, LENGTH, I, MSGID)
175   10    CONTINUE
176      ELSE
177         CALL MP_BSEND(BUFF, LENGTH, DEST, MSGID)
178      END IF
179*
180      RETURN
181*
182*     End BTSEND
183*
184      END
185*
186      SUBROUTINE BTRECV(DTYPE, N, BUFF, SRC, MSGID)
187*
188*  -- BLACS tester (version 1.0) --
189*  University of Tennessee
190*  December 15, 1994
191*
192*
193*     .. Scalar Arguments ..
194      INTEGER N, DTYPE, SRC, MSGID
195*     ..
196*     .. Array Arguments ..
197      REAL BUFF(*)
198*     ..
199*
200*     PURPOSE
201*     =======
202*     BTRECV: Globally blocking receive.
203*
204*     Arguments
205*     =========
206*     DTYPE    (input) INTEGER
207*              Indicates what data type BUFF is:
208*                1  =  RAW BYTES
209*                3  =  INTEGER
210*                4  =  SINGLE PRECISION REAL
211*                6  =  DOUBLE PRECISION REAL
212*                5  =  SINGLE PRECISION COMPLEX
213*                7  =  DOUBLE PRECISION COMPLEX
214*
215*     N        (input) INTEGER
216*              The number of elements of type DTYPE in BUFF.
217*
218*     BUFF     (output) INTEGER
219*              The buffer to receive into.
220*
221*     SRC      (input) INTEGER
222*              The source of the message.
223*
224*     MSGID    (input) INTEGER
225*              The message ID.
226*
227* =====================================================================
228*
229*     .. External Functions ..
230      INTEGER  IBTSIZEOF
231      EXTERNAL IBTSIZEOF
232*     ..
233*     .. Local Scalars ..
234      INTEGER LENGTH, TMP
235      INTEGER ISIZE, SSIZE, DSIZE, CSIZE, ZSIZE
236*     ..
237*     .. Save statement ..
238      SAVE  ISIZE, SSIZE, DSIZE, CSIZE, ZSIZE
239*     ..
240*     .. Data statements ..
241      DATA  ISIZE /-50/
242*     ..
243*     .. Executable Statements ..
244*
245*     On first call, initialize size variables
246*
247      IF( ISIZE .LT. 0 ) THEN
248         ISIZE = IBTSIZEOF('I')
249         SSIZE = IBTSIZEOF('S')
250         DSIZE = IBTSIZEOF('D')
251         CSIZE = IBTSIZEOF('C')
252         ZSIZE = IBTSIZEOF('Z')
253      END IF
254*
255*     Figure length of buffer
256*
257      IF( DTYPE .EQ. 1 ) THEN
258         LENGTH = N
259      ELSE IF( DTYPE .EQ. 3 ) THEN
260         LENGTH = N * ISIZE
261      ELSE IF( DTYPE .EQ. 4 ) THEN
262         LENGTH = N * SSIZE
263      ELSE IF( DTYPE .EQ. 5 ) THEN
264         LENGTH = N * CSIZE
265      ELSE IF( DTYPE .EQ. 6 ) THEN
266         LENGTH = N * DSIZE
267      ELSE IF( DTYPE .EQ. 7 ) THEN
268         LENGTH = N * ZSIZE
269      END IF
270*
271*     Receive the message
272*
273      CALL MP_BRECV(BUFF, LENGTH, SRC, MSGID, TMP)
274*
275      RETURN
276*
277*     End of BTRECV
278*
279      END
280*
281      INTEGER FUNCTION IBTSIZEOF(TYPE)
282*
283*  -- BLACS tester (version 1.0) --
284*  University of Tennessee
285*  December 15, 1994
286*
287*     .. Scalar Arguments ..
288      CHARACTER*1 TYPE
289*     ..
290*
291*  Purpose
292*  =======
293*  IBTSIZEOF: Returns the size, in bytes, of the 5 data types.
294*  If your platform has a different size for DOUBLE PRECISION, you must
295*  change the parameter statement in BLACSTEST as well.
296*
297*  Arguments
298*  =========
299*  TYPE     (input) CHARACTER*1
300*           The data type who's size is to be determined:
301*           'I' : INTEGER
302*           'S' : SINGLE PRECISION REAL
303*           'D' : DOUBLE PRECISION REAL
304*           'C' : SINGLE PRECISION COMPLEX
305*           'Z' : DOUBLE PRECISION COMPLEX
306*
307* =====================================================================
308*
309*     .. External Functions ..
310      LOGICAL  LSAME
311      EXTERNAL LSAME
312*     ..
313*     .. Local Scalars ..
314      INTEGER LENGTH
315*     ..
316*     .. Executable Statements ..
317*
318      IF( LSAME(TYPE, 'I') ) THEN
319         LENGTH = 4
320      ELSE IF( LSAME(TYPE, 'S') ) THEN
321         LENGTH = 4
322      ELSE IF( LSAME(TYPE, 'D') ) THEN
323         LENGTH = 8
324      ELSE IF( LSAME(TYPE, 'C') ) THEN
325         LENGTH = 8
326      ELSE IF( LSAME(TYPE, 'Z') ) THEN
327         LENGTH = 16
328      END IF
329      IBTSIZEOF = LENGTH
330*
331      RETURN
332      END
333