1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
!
! Copyright (C) 2002 FPMD group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
MODULE descriptors
!
IMPLICIT NONE
SAVE
INTEGER ldim_block, ldim_cyclic, ldim_block_cyclic, ldim_block_sca
INTEGER gind_block, gind_cyclic, gind_block_cyclic, gind_block_sca
EXTERNAL ldim_block, ldim_cyclic, ldim_block_cyclic, ldim_block_sca
EXTERNAL gind_block, gind_cyclic, gind_block_cyclic, gind_block_sca
! Descriptor for linear algebra data distribution (like in Cannon's algorithm)
!
! Remember here we use square matrixes block distributed on a square grid of processors
!
TYPE la_descriptor
INTEGER :: ir = 0 ! globla index of the first row in the local block of the distributed matrix
INTEGER :: nr = 0 ! number of row in the local block of the distributed matrix
INTEGER :: ic = 0 ! global index of the first column in the local block of the distributed matrix
INTEGER :: nc = 0 ! number of column in the local block of the distributed matrix
INTEGER :: nrcx = 0 ! leading dimension of the distribute matrix (greather than nr and nc)
INTEGER :: active_node = 0 ! if > 0 the proc holds a block of the lambda matrix
INTEGER :: n = 0 ! global dimension of the matrix
INTEGER :: nx = 0 ! global leading dimension ( >= n )
INTEGER :: npr = 0 ! number of row processors
INTEGER :: npc = 0 ! number of column processors
INTEGER :: myr = 0 ! processor row index
INTEGER :: myc = 0 ! processor column index
INTEGER :: comm = 0 ! communicator
INTEGER :: mype = 0 ! processor index ( from 0 to desc( la_npr_ ) * desc( la_npc_ ) - 1 )
INTEGER :: nrl = 0 ! number of local rows, when the matrix rows are cyclically distributed across proc
INTEGER :: nrlx = 0 ! leading dimension, when the matrix is distributed by row
END TYPE
!
CONTAINS
!------------------------------------------------------------------------
!
SUBROUTINE descla_local_dims( i2g, nl, n, nx, np, me )
IMPLICIT NONE
INTEGER, INTENT(OUT) :: i2g ! global index of the first local element
INTEGER, INTENT(OUT) :: nl ! local number of elements
INTEGER, INTENT(IN) :: n ! number of actual element in the global array
INTEGER, INTENT(IN) :: nx ! dimension of the global array (nx>=n) to be distributed
INTEGER, INTENT(IN) :: np ! number of processors
INTEGER, INTENT(IN) :: me ! taskid for which i2g and nl are computed
!
! note that we can distribute a global array larger than the
! number of actual elements. This could be required for performance
! reasons, and to have an equal partition of matrix having different size
! like matrixes of spin-up and spin-down
!
#if __SCALAPACK
nl = ldim_block_sca( nx, np, me )
i2g = gind_block_sca( 1, nx, np, me )
#else
nl = ldim_block( nx, np, me )
i2g = gind_block( 1, nx, np, me )
#endif
! This is to try to keep a matrix N * N into the same
! distribution of a matrix NX * NX, useful to have
! the matrix of spin-up distributed in the same way
! of the matrix of spin-down
!
IF( i2g + nl - 1 > n ) nl = n - i2g + 1
IF( nl < 0 ) nl = 0
RETURN
!
END SUBROUTINE descla_local_dims
!
!
SUBROUTINE descla_init( descla, n, nx, np, me, comm, includeme )
!
IMPLICIT NONE
TYPE(la_descriptor), INTENT(OUT) :: descla
INTEGER, INTENT(IN) :: n ! the size of this matrix
INTEGER, INTENT(IN) :: nx ! the max among different matrixes sharing
! this descriptor or the same data distribution
INTEGER, INTENT(IN) :: np(2), me(2), comm
INTEGER, INTENT(IN) :: includeme
INTEGER :: ir, nr, ic, nc, lnode, nrcx, nrl, nrlx
INTEGER :: ip, npp
IF( np(1) /= np(2) ) &
CALL errore( ' descla_init ', ' only square grid of proc are allowed ', 2 )
IF( n < 0 ) &
CALL errore( ' descla_init ', ' dummy argument n less than 1 ', 3 )
IF( nx < n ) &
CALL errore( ' descla_init ', ' dummy argument nx less than n ', 4 )
IF( np(1) < 1 ) &
CALL errore( ' descla_init ', ' dummy argument np less than 1 ', 5 )
! find the block maximum dimensions
#if __SCALAPACK
nrcx = ldim_block_sca( nx, np(1), 0 )
#else
nrcx = ldim_block( nx, np(1), 0 )
DO ip = 1, np(1) - 1
nrcx = MAX( nrcx, ldim_block( nx, np(1), ip ) )
END DO
#endif
!
! find local dimensions, if appropriate
!
IF( includeme == 1 ) THEN
!
CALL descla_local_dims( ir, nr, n, nx, np(1), me(1) )
CALL descla_local_dims( ic, nc, n, nx, np(2), me(2) )
!
lnode = 1
!
ELSE
!
nr = 0
nc = 0
!
ir = 0
ic = 0
!
lnode = -1
!
END IF
descla%ir = ir ! globla index of the first row in the local block of lambda
descla%nr = nr ! number of row in the local block of lambda ( the "2" accounts for spin)
descla%ic = ic ! global index of the first column in the local block of lambda
descla%nc = nc ! number of column in the local block of lambda
descla%nrcx = nrcx ! leading dimension of the distribute lambda matrix
descla%active_node = lnode
! if > 0 the proc holds a block of the lambda matrix
descla%n = n ! global dimension of the matrix
descla%nx = nx ! global leading dimension
descla%npr = np(1) ! number of row processors
descla%npc = np(2) ! number of column processors
descla%myr = me(1) ! processor row index
descla%myc = me(2) ! processor column index
descla%comm = comm ! communicator
descla%mype = descla%myc + descla%myr * descla%npr
! processor index ( from 0 to desc( la_npr_ ) * desc( la_npc_ ) - 1 )
npp = np(1) * np(2)
! Compute local dimension of the cyclically distributed matrix
!
IF( includeme == 1 ) THEN
nrl = ldim_cyclic( n, npp, descla%mype )
ELSE
nrl = 0
END IF
nrlx = n / npp + 1
descla%nrl = nrl ! number of local rows, when the matrix rows are cyclically distributed across procs
descla%nrlx = nrlx ! leading dimension
IF( nr < 0 .OR. nc < 0 ) &
CALL errore( ' descla_init ', ' wrong valune for computed nr and nc ', 1 )
IF( nrcx < 1 ) &
CALL errore( ' descla_init ', ' wrong value for computed nrcx ', 2 )
IF( nrcx < nr ) &
CALL errore( ' descla_init ', ' nrcx < nr ', ( nr - nrcx ) )
IF( nrcx < nc ) &
CALL errore( ' descla_init ', ' nrcx < nc ', ( nc - nrcx ) )
IF( nrlx < nrl ) &
CALL errore( ' descla_init ', ' nrlx < nrl ', ( nrl - nrlx ) )
IF( nrl < 0 ) &
CALL errore( ' descla_init ', ' nrl < 0 ', ABS( nrl ) )
RETURN
END SUBROUTINE descla_init
END MODULE descriptors
|
