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