2183
2184
2185
2186
2187
2188
2189
2190 INTEGER SCODE
2191
2192
2193 EXTERNAL subptr
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
2309
2310
2311 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2312 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2313 $ RSRC_
2314 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2315 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2316 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2317 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2318
2319
2320 CHARACTER*1 DIAG, SIDE, TRANSA, TRANSB, UPLO
2321 INTEGER IA, IB, IC, INCX, INCY, ISCLR, IX, IY, JA, JB,
2322 $ JC, JX, JY, KDIM, MDIM, NDIM
2323 DOUBLE PRECISION USCLR
2324 COMPLEX*16 SCLR
2325 INTEGER DESCA( DLEN_ ), DESCB( DLEN_ ), DESCC( DLEN_ ),
2326 $ DESCX( DLEN_ ), DESCY( DLEN_ )
2327 COMPLEX*16 A( 2, 2 ), B( 2, 2 ), C( 2, 2 ), X( 2 ), Y( 2 )
2328 COMMON /pblasc/diag, side, transa, transb, uplo
2329 COMMON /pblasd/desca, descb, descc, descx, descy
2330 COMMON /pblasi/ia, ib, ic, incx, incy, isclr, ix, iy,
2331 $ ja, jb, jc, jx, jy
2332 COMMON /pblasm/a, b, c
2333 COMMON /pblasn/kdim, mdim, ndim
2334 COMMON /pblass/sclr, usclr
2335 COMMON /pblasv/x, y
2336
2337
2338
2339
2340
2341 IF( scode.EQ.11 ) THEN
2342
2343 CALL subptr( ndim, x, ix, jx, descx, incx, y, iy, jy, descy,
2344 $ incy )
2345
2346 ELSE IF( scode.EQ.12 ) THEN
2347
2348 CALL subptr( ndim, sclr, x, ix, jx, descx, incx )
2349
2350 ELSE IF( scode.EQ.13 ) THEN
2351
2352 CALL subptr( ndim, sclr, x, ix, jx, descx, incx, y, iy, jy,
2353 $ descy, incy )
2354
2355 ELSE IF( scode.EQ.14 ) THEN
2356
2357 CALL subptr( ndim, sclr, isclr, x, ix, jx, descx, incx )
2358
2359 ELSE IF( scode.EQ.15 ) THEN
2360
2361 CALL subptr( ndim, usclr, x, ix, jx, descx, incx )
2362
2363
2364
2365 ELSE IF( scode.EQ.21 ) THEN
2366
2367 CALL subptr( transa, mdim, ndim, sclr, a, ia, ja, desca, x, ix,
2368 $ jx, descx, incx, sclr, y, iy, jy, descy, incy )
2369
2370 ELSE IF( scode.EQ.22 ) THEN
2371
2372 CALL subptr( uplo, ndim, sclr, a, ia, ja, desca, x, ix, jx,
2373 $ descx, incx, sclr, y, iy, jy, descy, incy )
2374
2375 ELSE IF( scode.EQ.23 ) THEN
2376
2377 CALL subptr( uplo, transa, diag, ndim, a, ia, ja, desca, x, ix,
2378 $ jx, descx, incx )
2379
2380 ELSE IF( scode.EQ.24 ) THEN
2381
2382 CALL subptr( mdim, ndim, sclr, x, ix, jx, descx, incx, y, iy,
2383 $ jy, descy, incy, a, ia, ja, desca )
2384
2385 ELSE IF( scode.EQ.25 ) THEN
2386
2387 CALL subptr( uplo, ndim, sclr, x, ix, jx, descx, incx, a, ia,
2388 $ ja, desca )
2389
2390 ELSE IF( scode.EQ.26 ) THEN
2391
2392 CALL subptr( uplo, ndim, usclr, x, ix, jx, descx, incx, a, ia,
2393 $ ja, desca )
2394
2395 ELSE IF( scode.EQ.27 ) THEN
2396
2397 CALL subptr( uplo, ndim, sclr, x, ix, jx, descx, incx, y, iy,
2398 $ jy, descy, incy, a, ia, ja, desca )
2399
2400
2401
2402 ELSE IF( scode.EQ.31 ) THEN
2403
2404 CALL subptr( transa, transb, mdim, ndim, kdim, sclr, a, ia, ja,
2405 $ desca, b, ib, jb, descb, sclr, c, ic, jc, descc )
2406
2407 ELSE IF( scode.EQ.32 ) THEN
2408
2409 CALL subptr( side, uplo, mdim, ndim, sclr, a, ia, ja, desca, b,
2410 $ ib, jb, descb, sclr, c, ic, jc, descc )
2411
2412 ELSE IF( scode.EQ.33 ) THEN
2413
2414 CALL subptr( uplo, transa, ndim, kdim, sclr, a, ia, ja, desca,
2415 $ sclr, c, ic, jc, descc )
2416
2417 ELSE IF( scode.EQ.34 ) THEN
2418
2419 CALL subptr( uplo, transa, ndim, kdim, usclr, a, ia, ja, desca,
2420 $ usclr, c, ic, jc, descc )
2421
2422 ELSE IF( scode.EQ.35 ) THEN
2423
2424 CALL subptr( uplo, transa, ndim, kdim, sclr, a, ia, ja, desca,
2425 $ b, ib, jb, descb, sclr, c, ic, jc, descc )
2426
2427 ELSE IF( scode.EQ.36 ) THEN
2428
2429 CALL subptr( uplo, transa, ndim, kdim, sclr, a, ia, ja, desca,
2430 $ b, ib, jb, descb, usclr, c, ic, jc, descc )
2431
2432 ELSE IF( scode.EQ.37 ) THEN
2433
2434 CALL subptr( mdim, ndim, sclr, a, ia, ja, desca, sclr, c, ic,
2435 $ jc, descc )
2436
2437 ELSE IF( scode.EQ.38 ) THEN
2438
2439 CALL subptr( side, uplo, transa, diag, mdim, ndim, sclr, a, ia,
2440 $ ja, desca, b, ib, jb, descb )
2441
2442 ELSE IF( scode.EQ.39 ) THEN
2443
2444 CALL subptr( transa, mdim, ndim, sclr, a, ia, ja, desca, sclr,
2445 $ c, ic, jc, descc )
2446
2447 ELSE IF( scode.EQ.40 ) THEN
2448
2449 CALL subptr( uplo, transa, mdim, ndim, sclr, a, ia, ja, desca,
2450 $ sclr, c, ic, jc, descc )
2451
2452 END IF
2453
2454 RETURN
2455
2456
2457