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