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