OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
btprim.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine btsetup (mem, memlen, cmem, cmemlen, outnum, testsdrv, testbsbr, testcomb, testaux, iam, nnodes)
integer function ibtmyproc ()
integer function ibtnprocs ()
subroutine btsend (dtype, n, buff, dest, msgid)
subroutine btrecv (dtype, n, buff, src, msgid)
integer function ibtsizeof (type)
subroutine btmpierr (rout, ierr0)

Function/Subroutine Documentation

◆ btmpierr()

subroutine btmpierr ( character*(*) rout,
integer ierr0 )

Definition at line 361 of file btprim.f.

362 CHARACTER*(*) ROUT
363 INTEGER IERR0
364* ..
365* .. include files ..
366 include 'mpif.h'
367* ..
368* .. Common blocks ..
369 COMMON /btmpi/ btcomm, ierr
370 INTEGER BTCOMM, IERR
371*
372 WRITE(*,1000) rout, ierr
373 CALL mpi_abort(btcomm, ierr0, ierr)
374*
375 1000 FORMAT('Error #',i20,' from routine ',a)
376 RETURN
mpi_abort
subroutine mpi_abort(comm, ierrcode, ierr)
Definition mpi.f:153

◆ btrecv()

subroutine btrecv ( integer dtype,
integer n,
real, dimension(*) buff,
integer src,
integer msgid )

Definition at line 206 of file btprim.f.

207*
208* -- BLACS tester (version 1.0) --
209* University of Tennessee
210* December 15, 1994
211*
212*
213* .. Scalar Arguments ..
214 INTEGER N, DTYPE, SRC, MSGID
215* ..
216* .. Array Arguments ..
217 REAL BUFF(*)
218* ..
219*
220* PURPOSE
221* =======
222* BTRECV: Globally blocking receive.
223*
224* Arguments
225* =========
226* DTYPE (input) INTEGER
227* Indicates what data type BUFF is:
228* 1 = RAW BYTES
229* 3 = INTEGER
230* 4 = SINGLE PRECISION REAL
231* 6 = DOUBLE PRECISION REAL
232* 5 = SINGLE PRECISION COMPLEX
233* 7 = DOUBLE PRECISION COMPLEX
234*
235* N (input) INTEGER
236* The number of elements of type DTYPE in BUFF.
237*
238* BUFF (output) INTEGER
239* The buffer to receive into.
240*
241* SRC (input) INTEGER
242* The source of the message.
243*
244* MSGID (input) INTEGER
245* The message ID.
246*
247* =====================================================================
248* ..
249* .. Local Scalars ..
250 INTEGER MPIDTYPE
251* ..
252* .. Include Files ..
253 include 'mpif.h'
254* ..
255* .. Local Arrays ..
256 INTEGER STAT(MPI_STATUS_SIZE)
257* ..
258* .. Common Blocks ..
259 COMMON /btmpi/ btcomm, ierr
260 INTEGER BTCOMM, IERR
261*
262 IF( dtype .EQ. 1 ) THEN
263 mpidtype = mpi_byte
264 ELSE IF( dtype .EQ. 3 ) THEN
265 mpidtype = mpi_integer
266 ELSE IF( dtype .EQ. 4 ) THEN
267 mpidtype = mpi_real
268 ELSE IF( dtype .EQ. 5 ) THEN
269 mpidtype = mpi_complex
270 ELSE IF( dtype .EQ. 6 ) THEN
271 mpidtype = mpi_double_precision
272 ELSE IF( dtype .EQ. 7 ) THEN
273 mpidtype = mpi_double_complex
274 END IF
275*
276 CALL mpi_recv( buff, n, mpidtype, src, 0, btcomm, stat, ierr )
277 IF (ierr.NE.0) CALL btmpierr("MPI_RECV", ierr)
278*
279 RETURN
280*
281* End of BTRECV
282*
btmpierr
subroutine btmpierr(rout, ierr0)
Definition btprim.f:362
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461

◆ btsend()

subroutine btsend ( integer dtype,
integer n,
real, dimension(*) buff,
integer dest,
integer msgid )

Definition at line 114 of file btprim.f.

115*
116* -- BLACS tester (version 1.0) --
117* University of Tennessee
118* December 15, 1994
119*
120* .. Scalar Arguments ..
121 INTEGER N, DTYPE, DEST, MSGID
122* ..
123* .. Array Arguments ..
124 REAL BUFF(*)
125* ..
126*
127* PURPOSE
128* =======
129* BTSEND: Communication primitive used to send messages independent
130* of the BLACS. May safely be either locally or globally blocking.
131*
132* Arguments
133* =========
134* DTYPE (input) INTEGER
135* Indicates what data type BUFF is (same as PVM):
136* 1 = RAW BYTES
137* 3 = INTEGER
138* 4 = SINGLE PRECISION REAL
139* 6 = DOUBLE PRECISION REAL
140* 5 = SINGLE PRECISION COMPLEX
141* 7 = DOUBLE PRECISION COMPLEX
142*
143* N (input) INTEGER
144* The number of elements of type DTYPE in BUFF.
145*
146* BUFF (input) accepted as INTEGER array
147* The array to be communicated. Its true data type is
148* indicated by DTYPE.
149*
150* DEST (input) INTEGER
151* The destination of the message.
152*
153* MSGID (input) INTEGER
154* The message ID (AKA message tag or type).
155*
156* =====================================================================
157* .. External Functions ..
158 INTEGER IBTMYPROC, IBTNPROCS, IBTSIZEOF
159 EXTERNAL ibtmyproc, ibtnprocs, ibtsizeof
160* ..
161* .. Local Scalars ..
162 INTEGER I, IAM, MPIDTYPE
163* ..
164* .. Include Files ..
165 include 'mpif.h'
166* ..
167* .. Common Blocks ..
168 COMMON /btmpi/ btcomm, ierr
169 INTEGER BTCOMM, IERR
170*
171 IF( dtype .EQ. 1 ) THEN
172 mpidtype = mpi_byte
173 ELSE IF( dtype .EQ. 3 ) THEN
174 mpidtype = mpi_integer
175 ELSE IF( dtype .EQ. 4 ) THEN
176 mpidtype = mpi_real
177 ELSE IF( dtype .EQ. 5 ) THEN
178 mpidtype = mpi_complex
179 ELSE IF( dtype .EQ. 6 ) THEN
180 mpidtype = mpi_double_precision
181 ELSE IF( dtype .EQ. 7 ) THEN
182 mpidtype = mpi_double_complex
183 END IF
184*
185* Send the message
186*
187 IF( dest .EQ. -1 ) THEN
188 iam = ibtmyproc()
189 DO 10 i = 0, ibtnprocs()-1
190 IF( i .NE. iam ) THEN
191 CALL mpi_send(buff, n, mpidtype, i, 0, btcomm, ierr)
192 IF (ierr.NE.0) CALL btmpierr("MPI_SEND", ierr)
193 END IF
194 10 CONTINUE
195 ELSE
196 CALL mpi_send(buff, n, mpidtype, dest, 0, btcomm, ierr)
197 IF (ierr.NE.0) CALL btmpierr("MPI_SEND", ierr)
198 END IF
199*
200 RETURN
201*
202* End BTSEND
203*
ibtnprocs
integer function ibtnprocs()
Definition btprim.f:81
ibtmyproc
integer function ibtmyproc()
Definition btprim.f:47
ibtsizeof
integer function ibtsizeof(type)
Definition btprim.f:286
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480

◆ btsetup()

subroutine btsetup ( integer, dimension(memlen) mem,
integer memlen,
character*1, dimension(cmemlen) cmem,
integer cmemlen,
integer outnum,
logical testsdrv,
logical testbsbr,
logical testcomb,
logical testaux,
integer iam,
integer nnodes )

Definition at line 1 of file btprim.f.

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: Sets up communicator and initiliazes MPI if needed.
21*
22* ====================================================================
23*
24* ..
25* .. Local Scalars
26 LOGICAL INIT
27* ..
28* .. Include Files ..
29 include 'mpif.h'
30* ..
31* .. Common Blocks ..
32 COMMON /btmpi/ btcomm, ierr
33 INTEGER BTCOMM, IERR
34* ..
35* .. Executable Statements ..
36*
37 ierr = 0
38 CALL mpi_initialized(init, ierr)
39 IF (.NOT.init) CALL mpi_init(ierr)
40 IF (ierr.NE.0) CALL btmpierr("mpi_init", ierr)
41 CALL mpi_comm_dup(mpi_comm_world, btcomm, ierr)
42 IF (ierr.NE.0) CALL btmpierr("MPI_COMM_DUP", ierr)
43*
44 RETURN
mpi_comm_dup
subroutine mpi_comm_dup(comm, comm2, ierr)
Definition mpi.f:230
mpi_init
subroutine mpi_init(ierr)
Definition mpi.f:342
mpi_initialized
subroutine mpi_initialized(flag, ierr)
Definition mpi.f:350

◆ ibtmyproc()

integer function ibtmyproc

Definition at line 46 of file btprim.f.

47*
48* -- BLACS tester (version 1.0) --
49* University of Tennessee
50* December 15, 1994
51*
52* Purpose
53* =======
54* IBTMYPROC: returns a process number between 0 .. NPROCS-1. On
55* systems not natively in this numbering scheme, translates to it.
56*
57* ====================================================================
58* ..
59* .. Include Files ..
60 include 'mpif.h'
61* ..
62* .. Local Scalars ..
63 INTEGER RANK
64* ..
65* .. Common Blocks ..
66 COMMON /btmpi/ btcomm, ierr
67 INTEGER BTCOMM, IERR
68* ..
69* .. Executable Statements ..
70*
71 CALL mpi_comm_rank(btcomm, rank, ierr)
72 IF (ierr.NE.0) CALL btmpierr("MPI_COMM_RANK", ierr)
73 ibtmyproc = rank
74 RETURN
75*
76* End of IBTMYPROC
77*
mpi_comm_rank
subroutine mpi_comm_rank(comm, rank, ierr)
Definition mpi.f:254

◆ ibtnprocs()

integer function ibtnprocs

Definition at line 80 of file btprim.f.

81*
82* -- BLACS tester (version 1.0) --
83* University of Tennessee
84* December 15, 1994
85*
86* Purpose
87* =======
88* IBTNPROCS: returns the number of processes in the machine.
89*
90* ====================================================================
91* ..
92* .. Include Files ..
93 include 'mpif.h'
94* ..
95* .. Local Scalars ..
96 INTEGER NPROC
97* ..
98* .. Common Blocks ..
99 COMMON /btmpi/ btcomm, ierr
100 INTEGER BTCOMM, IERR
101* ..
102* .. Executable Statements ..
103*
104 CALL mpi_comm_size(btcomm, nproc, ierr)
105 IF (ierr.NE.0) CALL btmpierr("MPI_COMM_SIZE", ierr)
106 ibtnprocs = nproc
107*
108 RETURN
109*
110* End of IBTNPROCS
111*
mpi_comm_size
subroutine mpi_comm_size(comm, size, ierr)
Definition mpi.f:263

◆ ibtsizeof()

integer function ibtsizeof ( character*1 type)

Definition at line 285 of file btprim.f.

286*
287* -- BLACS tester (version 1.0) --
288* University of Tennessee
289* December 15, 1994
290*
291* .. Scalar Arguments ..
292 CHARACTER*1 TYPE
293* ..
294*
295* Purpose
296* =======
297* IBTSIZEOF: Returns the size, in bytes, of the 5 data types.
298* If your platform has a different size for DOUBLE PRECISION, you must
299* change the parameter statement in BLACSTEST as well.
300*
301* Arguments
302* =========
303* TYPE (input) CHARACTER*1
304* The data type who's size is to be determined:
305* 'I' : INTEGER
306* 'S' : SINGLE PRECISION REAL
307* 'D' : DOUBLE PRECISION REAL
308* 'C' : SINGLE PRECISION COMPLEX
309* 'Z' : DOUBLE PRECISION COMPLEX
310*
311* =====================================================================
312*
313* .. External Functions ..
314 LOGICAL LSAME
315 EXTERNAL lsame
316* ..
317* .. Include Files ..
318 include 'mpif.h'
319* ..
320* .. Common Blocks ..
321 COMMON /btmpi/ btcomm, ierr
322 INTEGER BTCOMM, IERR
323* ..
324* .. Local Scalars ..
325 INTEGER LENGTH
326 LOGICAL INIT
327 DATA init /.false./
328* ..
329* .. Executable Statements ..
330*
331*
332* Initialize MPI, if necessary
333*
334 IF (.NOT.init) THEN
335 CALL mpi_initialized(init, ierr)
336 IF (.NOT.init) CALL mpi_init(ierr)
337 IF (ierr.NE.0) CALL btmpierr("mpi_init", ierr)
338 init = .true.
339 END IF
340*
341 IF( lsame(TYPE, 'I') ) THEN
342 CALL mpi_type_size( mpi_integer, length, ierr )
343 IF (ierr.NE.0) CALL btmpierr("MPI_TYPE_SIZE", ierr)
344 ELSE IF( lsame(TYPE, 'S') ) THEN
345 CALL mpi_type_size( mpi_real, length, ierr )
346 IF (ierr.NE.0) CALL btmpierr("MPI_TYPE_SIZE", ierr)
347 ELSE IF( lsame(TYPE, 'D') ) THEN
348 CALL mpi_type_size( mpi_double_precision, length, ierr )
349 IF (ierr.NE.0) CALL btmpierr("MPI_TYPE_SIZE", ierr)
350 ELSE IF( lsame(TYPE, 'C') ) THEN
351 CALL mpi_type_size( mpi_complex, length, ierr )
352 IF (ierr.NE.0) CALL btmpierr("MPI_TYPE_SIZE", ierr)
353 ELSE IF( lsame(TYPE, 'Z') ) THEN
354 CALL mpi_type_size( mpi_double_complex, length, ierr )
355 IF (ierr.NE.0) CALL btmpierr("MPI_TYPE_SIZE", ierr)
356 END IF
357 ibtsizeof = length
358*
359 RETURN
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53