3
4
5
6
7
8
9 CHARACTER*1 ADIST
10 INTEGER ICONTXT, IGD, LDA, M, MCCOL, MCROW, MNB, MYCOL,
11 $ MYROW, N, NPCOL, NPROW
12
13
14 COMPLEX A( LDA, * )
15
16
17
18
19
20
21
22
23
24
25
26
27 REAL ONE, TWO
28 parameter( one = 1.0e+0, two = 2.0e+0 )
29
30
31 INTEGER KINT, KINT2, KLEN, KMOD, KPPOS, NLEN, NNUM,
32 $ NTLEN
33 REAL TEMP
34
35
36 LOGICAL LSAME
37 INTEGER ICEIL, NUMROC
39
40
41 EXTERNAL cgerv2d, cgesd2d
42
43
45
46
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 cgerv2d( 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 cgesd2d( 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
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 cgerv2d( 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 cgesd2d( 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
131
integer function iceil(inum, idenom)
integer function numroc(n, nb, iproc, isrcproc, nprocs)