SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pbztrget()

subroutine pbztrget ( integer  icontxt,
character*1  adist,
integer  m,
integer  n,
integer  mnb,
complex*16, dimension( lda, * )  a,
integer  lda,
integer  mcrow,
integer  mccol,
integer  igd,
integer  myrow,
integer  mycol,
integer  nprow,
integer  npcol 
)

Definition at line 1 of file pbztrget.f.

3*
4* -- PB-BLAS routine (version 2.1) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory.
6* April 28, 1996
7*
8* .. Scalar Arguments ..
9 CHARACTER*1 ADIST
10 INTEGER ICONTXT, IGD, LDA, M, MCCOL, MCROW, MNB, MYCOL,
11 $ MYROW, N, NPCOL, NPROW
12* ..
13* .. Array Arguments ..
14 COMPLEX*16 A( LDA, * )
15* ..
16*
17* Purpose
18* =======
19*
20* PBZTRGET forms a row block of A from scattered row subblocks if
21* ADIST = 'R', or forms a column block of A from scattered column
22* subblocks, if ADIST = 'C'.
23*
24* =====================================================================
25*
26* .. Parameters ..
27 REAL ONE, TWO
28 parameter( one = 1.0e+0, two = 2.0e+0 )
29* ..
30* .. Local Variables ..
31 INTEGER KINT, KINT2, KLEN, KMOD, KPPOS, NLEN, NNUM,
32 $ NTLEN
33 REAL TEMP
34* ..
35* .. External Functions ..
36 LOGICAL LSAME
37 INTEGER ICEIL, NUMROC
38 EXTERNAL lsame, iceil, numroc
39* ..
40* .. External Subroutines ..
41 EXTERNAL zgerv2d, zgesd2d
42* ..
43* .. Intrinsic Functions ..
44 INTRINSIC max, min, mod
45*
46* if A is a row block, it needs to communicate columnwise.
47*
48 IF( lsame( adist, 'R' ) ) THEN
49 kppos = mod( nprow+myrow-mcrow, nprow )
50 IF( mod( kppos, igd ).EQ.0 ) THEN
51 kint = igd
52 nlen = n
53 nnum = min( nprow/igd, mnb-mccol )
54 temp = real( nnum )
55 ntlen = n * nnum
56 nnum = igd * nnum
57 IF( kppos.GE.nnum ) GO TO 30
58 kppos = mod( kppos, nprow )
59*
60 10 CONTINUE
61 IF( temp.GT.one ) THEN
62 kint2 = 2 * kint
63 kmod = mod( kppos, kint2 )
64*
65 IF( kmod.EQ.0 ) THEN
66 IF( kppos+kint.LT.nnum ) THEN
67 klen = ntlen - (kppos/kint2)*(kint2/igd)*n
68 klen = min( klen-nlen, nlen )
69 CALL zgerv2d( icontxt, m, klen, a(1,nlen+1), lda,
70 $ mod(myrow+kint, nprow), mycol )
71 nlen = nlen + klen
72 END IF
73 ELSE
74 CALL zgesd2d( icontxt, m, nlen, a, lda,
75 $ mod(nprow+myrow-kint, nprow), mycol )
76 GO TO 30
77 END IF
78*
79 kint = kint2
80 temp = temp / two
81 GO TO 10
82 END IF
83 END IF
84*
85* if A is a column block, it needs to communicate rowwise.
86*
87 ELSE IF( lsame( adist, 'C' ) ) THEN
88*
89 kppos = mod( npcol+mycol-mccol, npcol )
90 IF( mod( kppos, igd ).EQ.0 ) THEN
91 kint = igd
92 nlen = n
93 nnum = min( npcol/igd, mnb-mcrow )
94 temp = real( nnum )
95 ntlen = n * nnum
96 nnum = igd * nnum
97 IF( kppos.GE.nnum ) GO TO 30
98 kppos = mod( kppos, npcol )
99*
100 20 CONTINUE
101 IF( temp.GT.one ) THEN
102 kint2 = 2 * kint
103 kmod = mod( kppos, kint2 )
104*
105 IF( kmod.EQ.0 ) THEN
106 IF( kppos+kint.LT.nnum ) THEN
107 klen = ntlen - (kppos/kint2)*(kint2/igd)*n
108 klen = min( klen-nlen, nlen )
109 CALL zgerv2d( icontxt, m, klen, a(1,nlen+1), lda,
110 $ myrow, mod(mycol+kint, npcol) )
111 nlen = nlen + klen
112 END IF
113 ELSE
114 CALL zgesd2d( icontxt, m, nlen, a, lda, myrow,
115 $ mod(npcol+mycol-kint, npcol) )
116 GO TO 30
117 END IF
118*
119 kint = kint2
120 temp = temp / two
121 GO TO 20
122 END IF
123 END IF
124 END IF
125*
126 30 CONTINUE
127*
128 RETURN
129*
130* End of PBZTRGET
131*
iceil
integer function iceil(inum, idenom)
Definition iceil.f:2
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition numroc.f:2
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the caller graph for this function: