2180
2181
2182
2183
2184
2185
2186
2187 INTEGER SCODE
2188
2189
2190 EXTERNAL subptr
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2309 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2310 $ RSRC_
2311 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2312 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2313 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2314 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2315
2316
2317 CHARACTER*1 DIAG, SIDE, TRANSA, TRANSB, UPLO
2318 INTEGER IA, IB, IC, INCX, INCY, ISCLR, IX, IY, JA, JB,
2319 $ JC, JX, JY, KDIM, MDIM, NDIM
2320 REAL USCLR, SCLR
2321 INTEGER DESCA( DLEN_ ), DESCB( DLEN_ ), DESCC( DLEN_ ),
2322 $ DESCX( DLEN_ ), DESCY( DLEN_ )
2323 REAL A( 2, 2 ), B( 2, 2 ), C( 2, 2 ), X( 2 ), Y( 2 )
2324 COMMON /pblasc/diag, side, transa, transb, uplo
2325 COMMON /pblasd/desca, descb, descc, descx, descy
2326 COMMON /pblasi/ia, ib, ic, incx, incy, isclr, ix, iy,
2327 $ ja, jb, jc, jx, jy
2328 COMMON /pblasm/a, b, c
2329 COMMON /pblasn/kdim, mdim, ndim
2330 COMMON /pblass/sclr, usclr
2331 COMMON /pblasv/x, y
2332
2333
2334
2335
2336
2337 IF( scode.EQ.11 ) THEN
2338
2339 CALL subptr( ndim, x, ix, jx, descx, incx, y, iy, jy, descy,
2340 $ incy )
2341
2342 ELSE IF( scode.EQ.12 ) THEN
2343
2344 CALL subptr( ndim, sclr, x, ix, jx, descx, incx )
2345
2346 ELSE IF( scode.EQ.13 ) THEN
2347
2348 CALL subptr( ndim, sclr, x, ix, jx, descx, incx, y, iy, jy,
2349 $ descy, incy )
2350
2351 ELSE IF( scode.EQ.14 ) THEN
2352
2353 CALL subptr( ndim, sclr, isclr, x, ix, jx, descx, incx )
2354
2355 ELSE IF( scode.EQ.15 ) THEN
2356
2357 CALL subptr( ndim, usclr, x, ix, jx, descx, incx )
2358
2359
2360
2361 ELSE IF( scode.EQ.21 ) THEN
2362
2363 CALL subptr( transa, mdim, ndim, sclr, a, ia, ja, desca, x, ix,
2364 $ jx, descx, incx, sclr, y, iy, jy, descy, incy )
2365
2366 ELSE IF( scode.EQ.22 ) THEN
2367
2368 CALL subptr( uplo, ndim, sclr, a, ia, ja, desca, x, ix, jx,
2369 $ descx, incx, sclr, y, iy, jy, descy, incy )
2370
2371 ELSE IF( scode.EQ.23 ) THEN
2372
2373 CALL subptr( uplo, transa, diag, ndim, a, ia, ja, desca, x, ix,
2374 $ jx, descx, incx )
2375
2376 ELSE IF( scode.EQ.24 ) THEN
2377
2378 CALL subptr( mdim, ndim, sclr, x, ix, jx, descx, incx, y, iy,
2379 $ jy, descy, incy, a, ia, ja, desca )
2380
2381 ELSE IF( scode.EQ.25 ) THEN
2382
2383 CALL subptr( uplo, ndim, sclr, x, ix, jx, descx, incx, a, ia,
2384 $ ja, desca )
2385
2386 ELSE IF( scode.EQ.26 ) THEN
2387
2388 CALL subptr( uplo, ndim, usclr, x, ix, jx, descx, incx, a, ia,
2389 $ ja, desca )
2390
2391 ELSE IF( scode.EQ.27 ) THEN
2392
2393 CALL subptr( uplo, ndim, sclr, x, ix, jx, descx, incx, y, iy,
2394 $ jy, descy, incy, a, ia, ja, desca )
2395
2396
2397
2398 ELSE IF( scode.EQ.31 ) THEN
2399
2400 CALL subptr( transa, transb, mdim, ndim, kdim, sclr, a, ia, ja,
2401 $ desca, b, ib, jb, descb, sclr, c, ic, jc, descc )
2402
2403 ELSE IF( scode.EQ.32 ) THEN
2404
2405 CALL subptr( side, uplo, mdim, ndim, sclr, a, ia, ja, desca, b,
2406 $ ib, jb, descb, sclr, c, ic, jc, descc )
2407
2408 ELSE IF( scode.EQ.33 ) THEN
2409
2410 CALL subptr( uplo, transa, ndim, kdim, sclr, a, ia, ja, desca,
2411 $ sclr, c, ic, jc, descc )
2412
2413 ELSE IF( scode.EQ.34 ) THEN
2414
2415 CALL subptr( uplo, transa, ndim, kdim, usclr, a, ia, ja, desca,
2416 $ usclr, c, ic, jc, descc )
2417
2418 ELSE IF( scode.EQ.35 ) THEN
2419
2420 CALL subptr( uplo, transa, ndim, kdim, sclr, a, ia, ja, desca,
2421 $ b, ib, jb, descb, sclr, c, ic, jc, descc )
2422
2423 ELSE IF( scode.EQ.36 ) THEN
2424
2425 CALL subptr( uplo, transa, ndim, kdim, sclr, a, ia, ja, desca,
2426 $ b, ib, jb, descb, usclr, c, ic, jc, descc )
2427
2428 ELSE IF( scode.EQ.37 ) THEN
2429
2430 CALL subptr( mdim, ndim, sclr, a, ia, ja, desca, sclr, c, ic,
2431 $ jc, descc )
2432
2433 ELSE IF( scode.EQ.38 ) THEN
2434
2435 CALL subptr( side, uplo, transa, diag, mdim, ndim, sclr, a, ia,
2436 $ ja, desca, b, ib, jb, descb )
2437
2438 ELSE IF( scode.EQ.39 ) THEN
2439
2440 CALL subptr( transa, mdim, ndim, sclr, a, ia, ja, desca, sclr,
2441 $ c, ic, jc, descc )
2442
2443 ELSE IF( scode.EQ.40 ) THEN
2444
2445 CALL subptr( uplo, transa, mdim, ndim, sclr, a, ia, ja, desca,
2446 $ sclr, c, ic, jc, descc )
2447
2448 END IF
2449
2450 RETURN
2451
2452
2453