Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief represent the structure of a full matrix
10 : !> \par History
11 : !> 08.2002 created [fawzi]
12 : !> \author Fawzi Mohamed
13 : ! **************************************************************************************************
14 : MODULE cp_fm_struct
15 : USE cp_blacs_env, ONLY: cp_blacs_env_release,&
16 : cp_blacs_env_type
17 : USE cp_log_handling, ONLY: cp_get_default_logger,&
18 : cp_logger_get_default_unit_nr,&
19 : cp_logger_type,&
20 : cp_to_string
21 : USE machine, ONLY: m_cpuid_vlen,&
22 : m_flush
23 : USE message_passing, ONLY: mp_para_env_release,&
24 : mp_para_env_type
25 : #include "../base/base_uses.f90"
26 :
27 : IMPLICIT NONE
28 : PRIVATE
29 :
30 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
31 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_fm_struct'
32 :
33 : ! the default blacs block sizes
34 : ! consider using #ifdefs to give them the optimal values
35 : ! these can be changed using scf_control
36 : ! *** these are used by default
37 : INTEGER, PRIVATE :: optimal_blacs_col_block_size = 64
38 : INTEGER, PRIVATE :: optimal_blacs_row_block_size = 64
39 : LOGICAL, PRIVATE :: force_block_size = .FALSE.
40 :
41 : PUBLIC :: cp_fm_struct_type, cp_fm_struct_p_type
42 : PUBLIC :: cp_fm_struct_create, cp_fm_struct_retain, cp_fm_struct_release, &
43 : cp_fm_struct_equivalent, &
44 : cp_fm_struct_get, cp_fm_struct_double, cp_fm_struct_config, &
45 : cp_fm_struct_get_nrow_block, cp_fm_struct_get_ncol_block, &
46 : cp_fm_struct_write_info
47 :
48 : ! **************************************************************************************************
49 : !> \brief keeps the information about the structure of a full matrix
50 : !> \param para_env the parallel environment of the matrices with this structure
51 : !> \param context the blacs context (parallel environment for scalapack),
52 : !> should be compatible with para_env
53 : !> \param descriptor the scalapack descriptor of the matrices, when using
54 : !> scalapack (ncol_block=descriptor(6), ncol_global=descriptor(4),
55 : !> nrow_block=descriptor(5), nrow_global=descriptor(3))
56 : !> \param ncol_block number of columns of a scalapack block
57 : !> \param nrow_block number of rows of a scalapack block
58 : !> \param nrow_global number of rows of the matrix
59 : !> \param ncol_global number of rows
60 : !> \param first_p_pos position of the first processor (for scalapack)
61 : !> \param row_indices real (global) indices of the rows (defined only for
62 : !> the local rows really used)
63 : !> \param col_indices real (global) indices of the cols (defined only for
64 : !> the local cols really used)
65 : !> \param nrow_locals nrow_locals(i) number of local rows of the matrix really
66 : !> used on the processors with context%mepos(1)==i
67 : !> \param ncol_locals ncol_locals(i) number of local rows of the matrix really
68 : !> used on the processors with context%mepos(2)==i
69 : !> \param ref_count reference count (see doc/ReferenceCounting.html)
70 : !> \param local_leading_dimension leading dimension of the data that is
71 : !> stored on this processor
72 : !>
73 : !> readonly attributes:
74 : !> \param nrow_local number of local rows really used on the actual processor
75 : !> \param ncol_local number of local cols really used on the actual processor
76 : !> \note
77 : !> use cp_fm_struct_get to extract information from this structure
78 : !> \par History
79 : !> 08.2002 created [fawzi]
80 : !> \author Fawzi Mohamed
81 : ! **************************************************************************************************
82 : TYPE cp_fm_struct_type
83 : TYPE(mp_para_env_type), POINTER :: para_env => NULL()
84 : TYPE(cp_blacs_env_type), POINTER :: context => NULL()
85 : INTEGER, DIMENSION(9) :: descriptor = -1
86 : INTEGER :: nrow_block = -1, ncol_block = -1, nrow_global = -1, ncol_global = -1
87 : INTEGER, DIMENSION(2) :: first_p_pos = -1
88 : INTEGER, DIMENSION(:), POINTER :: row_indices => NULL(), col_indices => NULL(), &
89 : nrow_locals => NULL(), ncol_locals => NULL()
90 : INTEGER :: ref_count = -1, local_leading_dimension = -1
91 : CONTAINS
92 : PROCEDURE, PASS(struct), NON_OVERRIDABLE :: g2p_row => cp_fm_indxg2p_row
93 : PROCEDURE, PASS(struct), NON_OVERRIDABLE :: g2p_col => cp_fm_indxg2p_col
94 : PROCEDURE, PASS(struct), NON_OVERRIDABLE :: g2l_row => cp_fm_indxg2l_row
95 : PROCEDURE, PASS(struct), NON_OVERRIDABLE :: g2l_col => cp_fm_indxg2l_col
96 : PROCEDURE, PASS(struct), NON_OVERRIDABLE :: l2g_row => cp_fm_indxl2g_row
97 : PROCEDURE, PASS(struct), NON_OVERRIDABLE :: l2g_col => cp_fm_indxl2g_col
98 : END TYPE cp_fm_struct_type
99 : ! **************************************************************************************************
100 : TYPE cp_fm_struct_p_type
101 : TYPE(cp_fm_struct_type), POINTER :: struct => NULL()
102 : END TYPE cp_fm_struct_p_type
103 :
104 : CONTAINS
105 :
106 : ! **************************************************************************************************
107 : !> \brief allocates and initializes a full matrix structure
108 : !> \param fmstruct the pointer that will point to the new structure
109 : !> \param para_env the parallel environment
110 : !> \param context the blacs context of this matrix
111 : !> \param nrow_global the number of row of the full matrix
112 : !> \param ncol_global the number of columns of the full matrix
113 : !> \param nrow_block the number of rows of a block of the matrix,
114 : !> omit or set to -1 to use the built-in defaults
115 : !> \param ncol_block the number of columns of a block of the matrix,
116 : !> omit or set to -1 to use the built-in defaults
117 : !> \param descriptor the scalapack descriptor of the matrix (if not given
118 : !> a new one is allocated
119 : !> \param first_p_pos ...
120 : !> \param local_leading_dimension the leading dimension of the locally stored
121 : !> data block
122 : !> \param template_fmstruct a matrix structure where to take the default values
123 : !> \param square_blocks ...
124 : !> \param force_block ...
125 : !> \par History
126 : !> 08.2002 created [fawzi]
127 : !> \author Fawzi Mohamed
128 : ! **************************************************************************************************
129 463278 : SUBROUTINE cp_fm_struct_create(fmstruct, para_env, context, nrow_global, &
130 : ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, &
131 : local_leading_dimension, template_fmstruct, square_blocks, force_block)
132 :
133 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
134 : TYPE(mp_para_env_type), TARGET, OPTIONAL :: para_env
135 : INTEGER, INTENT(in), OPTIONAL :: nrow_global, ncol_global
136 : INTEGER, INTENT(in), OPTIONAL :: nrow_block, ncol_block
137 : INTEGER, INTENT(in), OPTIONAL :: local_leading_dimension
138 : TYPE(cp_blacs_env_type), TARGET, OPTIONAL :: context
139 : INTEGER, DIMENSION(9), INTENT(in), OPTIONAL :: descriptor
140 : INTEGER, OPTIONAL, DIMENSION(2) :: first_p_pos
141 : TYPE(cp_fm_struct_type), POINTER, OPTIONAL :: template_fmstruct
142 : LOGICAL, OPTIONAL, INTENT(in) :: square_blocks
143 : LOGICAL, OPTIONAL, INTENT(in) :: force_block
144 :
145 : INTEGER :: i, nmax_block, vlen
146 : #if defined(__parallel)
147 : INTEGER :: iunit, stat
148 : INTEGER, EXTERNAL :: numroc
149 : TYPE(cp_logger_type), POINTER :: logger
150 : #endif
151 :
152 : LOGICAL :: my_square_blocks, my_force_block
153 :
154 5559336 : ALLOCATE (fmstruct)
155 :
156 463278 : IF (.NOT. PRESENT(template_fmstruct)) THEN
157 414440 : CPASSERT(PRESENT(context))
158 414440 : CPASSERT(PRESENT(nrow_global))
159 414440 : CPASSERT(PRESENT(ncol_global))
160 414440 : fmstruct%local_leading_dimension = 1
161 414440 : fmstruct%nrow_block = 0 ! populate default later
162 414440 : fmstruct%ncol_block = 0 ! populate default later
163 : ELSE
164 48838 : fmstruct%context => template_fmstruct%context
165 48838 : fmstruct%para_env => template_fmstruct%para_env
166 927922 : fmstruct%descriptor = template_fmstruct%descriptor
167 48838 : fmstruct%nrow_block = template_fmstruct%nrow_block
168 48838 : fmstruct%nrow_global = template_fmstruct%nrow_global
169 48838 : fmstruct%ncol_block = template_fmstruct%ncol_block
170 48838 : fmstruct%ncol_global = template_fmstruct%ncol_global
171 244190 : fmstruct%first_p_pos = template_fmstruct%first_p_pos
172 : fmstruct%local_leading_dimension = &
173 48838 : template_fmstruct%local_leading_dimension
174 : END IF
175 :
176 : ! allow to request default block size (zero or negative value)
177 463278 : IF (PRESENT(nrow_block)) fmstruct%nrow_block = nrow_block
178 463278 : IF (PRESENT(ncol_block)) fmstruct%ncol_block = ncol_block
179 463278 : IF (0 >= fmstruct%nrow_block) THEN
180 386685 : fmstruct%nrow_block = optimal_blacs_row_block_size
181 : END IF
182 463278 : IF (0 >= fmstruct%ncol_block) THEN
183 378405 : fmstruct%ncol_block = optimal_blacs_col_block_size
184 : END IF
185 463278 : CPASSERT(0 < fmstruct%nrow_block .AND. 0 < fmstruct%ncol_block)
186 :
187 463278 : IF (PRESENT(context)) THEN
188 414440 : fmstruct%context => context
189 414440 : fmstruct%para_env => context%para_env
190 : END IF
191 463278 : IF (PRESENT(para_env)) fmstruct%para_env => para_env
192 463278 : CALL fmstruct%context%retain()
193 463278 : CALL fmstruct%para_env%retain()
194 :
195 463278 : IF (PRESENT(nrow_global)) THEN
196 460934 : fmstruct%nrow_global = nrow_global
197 460934 : fmstruct%local_leading_dimension = 1
198 : END IF
199 463278 : IF (PRESENT(ncol_global)) THEN
200 463034 : fmstruct%ncol_global = ncol_global
201 : END IF
202 :
203 463278 : my_force_block = force_block_size
204 463278 : IF (PRESENT(force_block)) my_force_block = force_block
205 463278 : IF (.NOT. my_force_block) THEN
206 432429 : vlen = m_cpuid_vlen()
207 : nmax_block = (fmstruct%nrow_global + fmstruct%context%num_pe(1) - 1)/ &
208 432429 : (fmstruct%context%num_pe(1))
209 432429 : IF (1 < vlen) THEN ! flooring not ceiling (OOB)
210 432429 : fmstruct%nrow_block = fmstruct%nrow_block/vlen*vlen
211 432429 : nmax_block = nmax_block/vlen*vlen
212 : END IF
213 432429 : fmstruct%nrow_block = MAX(MIN(fmstruct%nrow_block, nmax_block), 1)
214 :
215 : nmax_block = (fmstruct%ncol_global + fmstruct%context%num_pe(2) - 1)/ &
216 432429 : (fmstruct%context%num_pe(2))
217 432429 : IF (1 < vlen) THEN ! flooring not ceiling (OOB)
218 432429 : fmstruct%ncol_block = fmstruct%ncol_block/vlen*vlen
219 432429 : nmax_block = nmax_block/vlen*vlen
220 : END IF
221 432429 : fmstruct%ncol_block = MAX(MIN(fmstruct%ncol_block, nmax_block), 1)
222 : END IF
223 :
224 : ! square matrix -> square blocks (otherwise, e.g., PDPOTRF fails)
225 463278 : my_square_blocks = fmstruct%nrow_global == fmstruct%ncol_global
226 : ! however, requesting non-square blocks takes precedence
227 463278 : IF (PRESENT(square_blocks)) my_square_blocks = square_blocks
228 463278 : IF (my_square_blocks) THEN
229 285371 : fmstruct%nrow_block = MIN(fmstruct%nrow_block, fmstruct%ncol_block)
230 285371 : fmstruct%ncol_block = fmstruct%nrow_block
231 : END IF
232 :
233 : ALLOCATE (fmstruct%nrow_locals(0:(fmstruct%context%num_pe(1) - 1)), &
234 2316390 : fmstruct%ncol_locals(0:(fmstruct%context%num_pe(2) - 1)))
235 463278 : IF (.NOT. PRESENT(template_fmstruct)) &
236 1243320 : fmstruct%first_p_pos = (/0, 0/)
237 463278 : IF (PRESENT(first_p_pos)) fmstruct%first_p_pos = first_p_pos
238 :
239 1303478 : fmstruct%nrow_locals = 0
240 926556 : fmstruct%ncol_locals = 0
241 : #if defined(__parallel)
242 : fmstruct%nrow_locals(fmstruct%context%mepos(1)) = &
243 : numroc(fmstruct%nrow_global, fmstruct%nrow_block, &
244 : fmstruct%context%mepos(1), fmstruct%first_p_pos(1), &
245 463278 : fmstruct%context%num_pe(1))
246 : fmstruct%ncol_locals(fmstruct%context%mepos(2)) = &
247 : numroc(fmstruct%ncol_global, fmstruct%ncol_block, &
248 : fmstruct%context%mepos(2), fmstruct%first_p_pos(2), &
249 463278 : fmstruct%context%num_pe(2))
250 2143678 : CALL fmstruct%para_env%sum(fmstruct%nrow_locals)
251 1389834 : CALL fmstruct%para_env%sum(fmstruct%ncol_locals)
252 1303478 : fmstruct%nrow_locals(:) = fmstruct%nrow_locals(:)/fmstruct%context%num_pe(2)
253 926556 : fmstruct%ncol_locals(:) = fmstruct%ncol_locals(:)/fmstruct%context%num_pe(1)
254 :
255 1766756 : IF (SUM(fmstruct%ncol_locals) .NE. fmstruct%ncol_global .OR. &
256 : SUM(fmstruct%nrow_locals) .NE. fmstruct%nrow_global) THEN
257 : ! try to collect some output if this is going to happen again
258 : ! this seems to trigger on blanc, but should really never happen
259 0 : logger => cp_get_default_logger()
260 0 : iunit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
261 0 : WRITE (iunit, *) "mepos", fmstruct%context%mepos(1:2), "numpe", fmstruct%context%num_pe(1:2)
262 0 : WRITE (iunit, *) "ncol_global", fmstruct%ncol_global
263 0 : WRITE (iunit, *) "nrow_global", fmstruct%nrow_global
264 0 : WRITE (iunit, *) "ncol_locals", fmstruct%ncol_locals
265 0 : WRITE (iunit, *) "nrow_locals", fmstruct%nrow_locals
266 0 : CALL m_flush(iunit)
267 : END IF
268 :
269 926556 : IF (SUM(fmstruct%ncol_locals) .NE. fmstruct%ncol_global) &
270 0 : CPABORT("sum of local cols not equal global cols")
271 1303478 : IF (SUM(fmstruct%nrow_locals) .NE. fmstruct%nrow_global) &
272 0 : CPABORT("sum of local row not equal global rows")
273 : #else
274 : ! block = full matrix
275 : fmstruct%nrow_block = fmstruct%nrow_global
276 : fmstruct%ncol_block = fmstruct%ncol_global
277 : fmstruct%nrow_locals(fmstruct%context%mepos(1)) = fmstruct%nrow_global
278 : fmstruct%ncol_locals(fmstruct%context%mepos(2)) = fmstruct%ncol_global
279 : #endif
280 :
281 : fmstruct%local_leading_dimension = MAX(fmstruct%local_leading_dimension, &
282 463278 : fmstruct%nrow_locals(fmstruct%context%mepos(1)))
283 463278 : IF (PRESENT(local_leading_dimension)) THEN
284 0 : IF (MAX(1, fmstruct%nrow_locals(fmstruct%context%mepos(1))) > local_leading_dimension) &
285 : CALL cp_abort(__LOCATION__, "local_leading_dimension too small ("// &
286 : cp_to_string(local_leading_dimension)//"<"// &
287 0 : cp_to_string(fmstruct%local_leading_dimension)//")")
288 0 : fmstruct%local_leading_dimension = local_leading_dimension
289 : END IF
290 :
291 463278 : NULLIFY (fmstruct%row_indices, fmstruct%col_indices)
292 :
293 : ! the max should go away
294 1389834 : ALLOCATE (fmstruct%row_indices(MAX(fmstruct%nrow_locals(fmstruct%context%mepos(1)), 1)))
295 5856326 : DO i = 1, SIZE(fmstruct%row_indices)
296 : #ifdef __parallel
297 5856326 : fmstruct%row_indices(i) = fmstruct%l2g_row(i, fmstruct%context%mepos(1))
298 : #else
299 : fmstruct%row_indices(i) = i
300 : #endif
301 : END DO
302 1389834 : ALLOCATE (fmstruct%col_indices(MAX(fmstruct%ncol_locals(fmstruct%context%mepos(2)), 1)))
303 6178010 : DO i = 1, SIZE(fmstruct%col_indices)
304 : #ifdef __parallel
305 6178010 : fmstruct%col_indices(i) = fmstruct%l2g_col(i, fmstruct%context%mepos(2))
306 : #else
307 : fmstruct%col_indices(i) = i
308 : #endif
309 : END DO
310 :
311 463278 : fmstruct%ref_count = 1
312 :
313 463278 : IF (PRESENT(descriptor)) THEN
314 0 : fmstruct%descriptor = descriptor
315 : ELSE
316 4632780 : fmstruct%descriptor = 0
317 : #if defined(__parallel)
318 : ! local leading dimension needs to be at least 1
319 : CALL descinit(fmstruct%descriptor, fmstruct%nrow_global, &
320 : fmstruct%ncol_global, fmstruct%nrow_block, &
321 : fmstruct%ncol_block, fmstruct%first_p_pos(1), &
322 : fmstruct%first_p_pos(2), fmstruct%context, &
323 463278 : fmstruct%local_leading_dimension, stat)
324 463278 : CPASSERT(stat == 0)
325 : #endif
326 : END IF
327 463278 : END SUBROUTINE cp_fm_struct_create
328 :
329 : ! **************************************************************************************************
330 : !> \brief retains a full matrix structure
331 : !> \param fmstruct the structure to retain
332 : !> \par History
333 : !> 08.2002 created [fawzi]
334 : !> \author Fawzi Mohamed
335 : ! **************************************************************************************************
336 1472417 : SUBROUTINE cp_fm_struct_retain(fmstruct)
337 : TYPE(cp_fm_struct_type), INTENT(INOUT) :: fmstruct
338 :
339 1472417 : CPASSERT(fmstruct%ref_count > 0)
340 1472417 : fmstruct%ref_count = fmstruct%ref_count + 1
341 1472417 : END SUBROUTINE cp_fm_struct_retain
342 :
343 : ! **************************************************************************************************
344 : !> \brief releases a full matrix structure
345 : !> \param fmstruct the structure to release
346 : !> \par History
347 : !> 08.2002 created [fawzi]
348 : !> \author Fawzi Mohamed
349 : ! **************************************************************************************************
350 1963642 : SUBROUTINE cp_fm_struct_release(fmstruct)
351 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
352 :
353 1963642 : IF (ASSOCIATED(fmstruct)) THEN
354 1935695 : CPASSERT(fmstruct%ref_count > 0)
355 1935695 : fmstruct%ref_count = fmstruct%ref_count - 1
356 1935695 : IF (fmstruct%ref_count < 1) THEN
357 463278 : CALL cp_blacs_env_release(fmstruct%context)
358 463278 : CALL mp_para_env_release(fmstruct%para_env)
359 463278 : IF (ASSOCIATED(fmstruct%row_indices)) THEN
360 463278 : DEALLOCATE (fmstruct%row_indices)
361 : END IF
362 463278 : IF (ASSOCIATED(fmstruct%col_indices)) THEN
363 463278 : DEALLOCATE (fmstruct%col_indices)
364 : END IF
365 463278 : IF (ASSOCIATED(fmstruct%nrow_locals)) THEN
366 463278 : DEALLOCATE (fmstruct%nrow_locals)
367 : END IF
368 463278 : IF (ASSOCIATED(fmstruct%ncol_locals)) THEN
369 463278 : DEALLOCATE (fmstruct%ncol_locals)
370 : END IF
371 463278 : DEALLOCATE (fmstruct)
372 : END IF
373 : END IF
374 1963642 : NULLIFY (fmstruct)
375 1963642 : END SUBROUTINE cp_fm_struct_release
376 :
377 : ! **************************************************************************************************
378 : !> \brief returns true if the two matrix structures are equivalent, false
379 : !> otherwise.
380 : !> \param fmstruct1 one of the full matrix structures to compare
381 : !> \param fmstruct2 the second of the full matrix structures to compare
382 : !> \return ...
383 : !> \par History
384 : !> 08.2002 created [fawzi]
385 : !> \author Fawzi Mohamed
386 : ! **************************************************************************************************
387 2287347 : FUNCTION cp_fm_struct_equivalent(fmstruct1, fmstruct2) RESULT(res)
388 : TYPE(cp_fm_struct_type), POINTER :: fmstruct1, fmstruct2
389 : LOGICAL :: res
390 :
391 : INTEGER :: i
392 :
393 2287347 : CPASSERT(ASSOCIATED(fmstruct1))
394 2287347 : CPASSERT(ASSOCIATED(fmstruct2))
395 2287347 : CPASSERT(fmstruct1%ref_count > 0)
396 2287347 : CPASSERT(fmstruct2%ref_count > 0)
397 2287347 : IF (ASSOCIATED(fmstruct1, fmstruct2)) THEN
398 : res = .TRUE.
399 : ELSE
400 : res = (fmstruct1%context == fmstruct2%context) .AND. &
401 : (fmstruct1%nrow_global == fmstruct2%nrow_global) .AND. &
402 : (fmstruct1%ncol_global == fmstruct2%ncol_global) .AND. &
403 : (fmstruct1%nrow_block == fmstruct2%nrow_block) .AND. &
404 : (fmstruct1%ncol_block == fmstruct2%ncol_block) .AND. &
405 : (fmstruct1%local_leading_dimension == &
406 461451 : fmstruct2%local_leading_dimension)
407 4614510 : DO i = 1, 9
408 4614510 : res = res .AND. (fmstruct1%descriptor(i) == fmstruct1%descriptor(i))
409 : END DO
410 : END IF
411 2287347 : END FUNCTION cp_fm_struct_equivalent
412 :
413 : ! **************************************************************************************************
414 : !> \brief returns the values of various attributes of the matrix structure
415 : !> \param fmstruct the structure you want info about
416 : !> \param para_env ...
417 : !> \param context ...
418 : !> \param descriptor ...
419 : !> \param ncol_block ...
420 : !> \param nrow_block ...
421 : !> \param nrow_global ...
422 : !> \param ncol_global ...
423 : !> \param first_p_pos ...
424 : !> \param row_indices ...
425 : !> \param col_indices ...
426 : !> \param nrow_local ...
427 : !> \param ncol_local ...
428 : !> \param nrow_locals ...
429 : !> \param ncol_locals ...
430 : !> \param local_leading_dimension ...
431 : !> \par History
432 : !> 08.2002 created [fawzi]
433 : !> \author Fawzi Mohamed
434 : ! **************************************************************************************************
435 6018782 : SUBROUTINE cp_fm_struct_get(fmstruct, para_env, context, &
436 : descriptor, ncol_block, nrow_block, nrow_global, &
437 : ncol_global, first_p_pos, row_indices, &
438 : col_indices, nrow_local, ncol_local, nrow_locals, ncol_locals, &
439 : local_leading_dimension)
440 : TYPE(cp_fm_struct_type), INTENT(IN) :: fmstruct
441 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
442 : TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: context
443 : INTEGER, DIMENSION(9), INTENT(OUT), OPTIONAL :: descriptor
444 : INTEGER, INTENT(out), OPTIONAL :: ncol_block, nrow_block, nrow_global, &
445 : ncol_global
446 : INTEGER, DIMENSION(2), INTENT(out), OPTIONAL :: first_p_pos
447 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: row_indices, col_indices
448 : INTEGER, INTENT(out), OPTIONAL :: nrow_local, ncol_local
449 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nrow_locals, ncol_locals
450 : INTEGER, INTENT(out), OPTIONAL :: local_leading_dimension
451 :
452 6018782 : IF (PRESENT(para_env)) para_env => fmstruct%para_env
453 6018782 : IF (PRESENT(context)) context => fmstruct%context
454 6018782 : IF (PRESENT(descriptor)) descriptor = fmstruct%descriptor
455 6018782 : IF (PRESENT(ncol_block)) ncol_block = fmstruct%ncol_block
456 6018782 : IF (PRESENT(nrow_block)) nrow_block = fmstruct%nrow_block
457 6018782 : IF (PRESENT(nrow_global)) nrow_global = fmstruct%nrow_global
458 6018782 : IF (PRESENT(ncol_global)) ncol_global = fmstruct%ncol_global
459 6018782 : IF (PRESENT(first_p_pos)) first_p_pos = fmstruct%first_p_pos
460 6018782 : IF (PRESENT(nrow_locals)) nrow_locals => fmstruct%nrow_locals
461 6018782 : IF (PRESENT(ncol_locals)) ncol_locals => fmstruct%ncol_locals
462 6018782 : IF (PRESENT(local_leading_dimension)) local_leading_dimension = &
463 41211 : fmstruct%local_leading_dimension
464 :
465 6018782 : IF (PRESENT(nrow_local)) nrow_local = fmstruct%nrow_locals(fmstruct%context%mepos(1))
466 6018782 : IF (PRESENT(ncol_local)) ncol_local = fmstruct%ncol_locals(fmstruct%context%mepos(2))
467 :
468 6018782 : IF (PRESENT(row_indices)) row_indices => fmstruct%row_indices
469 6018782 : IF (PRESENT(col_indices)) col_indices => fmstruct%col_indices
470 6018782 : END SUBROUTINE cp_fm_struct_get
471 :
472 : ! **************************************************************************************************
473 : !> \brief Write nicely formatted info about the FM struct to the given I/O unit
474 : !> \param fmstruct a cp_fm_struct_type instance
475 : !> \param io_unit the I/O unit to use for writing
476 : ! **************************************************************************************************
477 3 : SUBROUTINE cp_fm_struct_write_info(fmstruct, io_unit)
478 : TYPE(cp_fm_struct_type), INTENT(IN) :: fmstruct
479 : INTEGER, INTENT(IN) :: io_unit
480 :
481 : INTEGER, PARAMETER :: oblock_size = 8
482 :
483 : CHARACTER(len=30) :: fm
484 : INTEGER :: oblock
485 :
486 3 : WRITE (fm, "(A,I2,A)") "(A,I5,A,I5,A,", oblock_size, "I6)"
487 :
488 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of matrix columns: ", fmstruct%ncol_global
489 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of matrix rows: ", fmstruct%nrow_global
490 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of block columns: ", fmstruct%ncol_block
491 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of block rows: ", fmstruct%nrow_block
492 :
493 3 : WRITE (io_unit, '(A)') "CP_FM_STRUCT | Number of local columns: "
494 6 : DO oblock = 0, (SIZE(fmstruct%ncol_locals) - 1)/oblock_size
495 3 : WRITE (io_unit, fm) "CP_FM_STRUCT | CPUs ", &
496 3 : oblock*oblock_size, "..", (oblock + 1)*oblock_size - 1, ": ", &
497 9 : fmstruct%ncol_locals(oblock*oblock_size:MIN(SIZE(fmstruct%ncol_locals), (oblock + 1)*oblock_size) - 1)
498 : END DO
499 :
500 3 : WRITE (io_unit, '(A)') "CP_FM_STRUCT | Number of local rows: "
501 6 : DO oblock = 0, (SIZE(fmstruct%nrow_locals) - 1)/oblock_size
502 3 : WRITE (io_unit, fm) "CP_FM_STRUCT | CPUs ", &
503 3 : oblock*oblock_size, "..", (oblock + 1)*oblock_size - 1, ": ", &
504 9 : fmstruct%nrow_locals(oblock*oblock_size:MIN(SIZE(fmstruct%nrow_locals), (oblock + 1)*oblock_size) - 1)
505 : END DO
506 3 : END SUBROUTINE cp_fm_struct_write_info
507 :
508 : ! **************************************************************************************************
509 : !> \brief creates a struct with twice the number of blocks on each core.
510 : !> If matrix A has to be multiplied with B anc C, a
511 : !> significant speedup of pdgemm can be acchieved by joining the matrices
512 : !> in a new one with this structure (see arnoldi in rt_matrix_exp)
513 : !> \param fmstruct the struct to create
514 : !> \param struct struct of either A or B
515 : !> \param context ...
516 : !> \param col in which direction the matrix should be enlarged
517 : !> \param row in which direction the matrix should be enlarged
518 : !> \par History
519 : !> 06.2009 created [fschiff]
520 : !> \author Florian Schiffmann
521 : ! **************************************************************************************************
522 5202 : SUBROUTINE cp_fm_struct_double(fmstruct, struct, context, col, row)
523 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
524 : TYPE(cp_fm_struct_type), INTENT(INOUT) :: struct
525 : TYPE(cp_blacs_env_type), INTENT(INOUT), TARGET :: context
526 : LOGICAL, INTENT(in) :: col, row
527 :
528 : INTEGER :: n_doubled_items_in_partially_filled_block, ncol_block, ncol_global, newdim_col, &
529 : newdim_row, nfilled_blocks, nfilled_blocks_remain, nprocs_col, nprocs_row, nrow_block, &
530 : nrow_global
531 : TYPE(mp_para_env_type), POINTER :: para_env
532 :
533 : CALL cp_fm_struct_get(struct, nrow_global=nrow_global, &
534 : ncol_global=ncol_global, nrow_block=nrow_block, &
535 5202 : ncol_block=ncol_block)
536 5202 : newdim_row = nrow_global
537 5202 : newdim_col = ncol_global
538 5202 : nprocs_row = context%num_pe(1)
539 5202 : nprocs_col = context%num_pe(2)
540 5202 : para_env => struct%para_env
541 :
542 5202 : IF (col) THEN
543 5202 : IF (ncol_global == 0) THEN
544 120 : newdim_col = 0
545 : ELSE
546 : ! ncol_block nfilled_blocks_remain * ncol_block
547 : ! |<--->| |<--->|
548 : ! |-----|-----|-----|-----|---|
549 : ! | 0 | 1 | 2 | 0 | 1 | <- context%mepos(2)
550 : ! |-----|-----|-----|-----|---|
551 : ! |<--- nfilled_blocks -->|<-> -- items (columns) in partially filled blocks
552 : ! | * ncol_block |
553 5082 : n_doubled_items_in_partially_filled_block = 2*MOD(ncol_global, ncol_block)
554 5082 : nfilled_blocks = ncol_global/ncol_block
555 5082 : nfilled_blocks_remain = MOD(nfilled_blocks, nprocs_col)
556 5082 : newdim_col = 2*(nfilled_blocks/nprocs_col)
557 5082 : IF (n_doubled_items_in_partially_filled_block > ncol_block) THEN
558 : ! doubled number of columns in a partially filled block does not fit into a single block.
559 : ! Due to cyclic distribution of ScaLAPACK blocks, an extra block for each core needs to be added
560 : ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---|
561 : ! | 0 | 1 | 2 | 0 | --> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0|
562 : ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---|
563 : ! a a a b a1 a1 a1 a2 a2 a2 b1 empty empty b2
564 0 : newdim_col = newdim_col + 1
565 :
566 : ! the number of columns which does not fit into the added extra block
567 0 : n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - ncol_block
568 5082 : ELSE IF (nfilled_blocks_remain > 0) THEN
569 : ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
570 : ! | 0 | 1 | 2 | 0 | 1| -> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0 |
571 : ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
572 : ! a a a b b a1 a1 a1 a2 a2 a2 b1 b1 b2 empty b2
573 0 : newdim_col = newdim_col + 1
574 0 : n_doubled_items_in_partially_filled_block = 0
575 : END IF
576 :
577 5082 : newdim_col = (newdim_col*nprocs_col + nfilled_blocks_remain)*ncol_block + n_doubled_items_in_partially_filled_block
578 : END IF
579 : END IF
580 :
581 5202 : IF (row) THEN
582 0 : IF (nrow_global == 0) THEN
583 0 : newdim_row = 0
584 : ELSE
585 0 : n_doubled_items_in_partially_filled_block = 2*MOD(nrow_global, nrow_block)
586 0 : nfilled_blocks = nrow_global/nrow_block
587 0 : nfilled_blocks_remain = MOD(nfilled_blocks, nprocs_row)
588 0 : newdim_row = 2*(nfilled_blocks/nprocs_row)
589 0 : IF (n_doubled_items_in_partially_filled_block > nrow_block) THEN
590 0 : newdim_row = newdim_row + 1
591 0 : n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - nrow_block
592 0 : ELSE IF (nfilled_blocks_remain > 0) THEN
593 0 : newdim_row = newdim_row + 1
594 0 : n_doubled_items_in_partially_filled_block = 0
595 : END IF
596 :
597 0 : newdim_row = (newdim_row*nprocs_row + nfilled_blocks_remain)*nrow_block + n_doubled_items_in_partially_filled_block
598 : END IF
599 : END IF
600 :
601 : ! square_blocks=.FALSE. ensures that matrix blocks of the doubled matrix will have
602 : ! nrow_block x ncol_block shape even in case of a square doubled matrix
603 : CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
604 : context=context, &
605 : nrow_global=newdim_row, &
606 : ncol_global=newdim_col, &
607 : ncol_block=ncol_block, &
608 : nrow_block=nrow_block, &
609 5202 : square_blocks=.FALSE.)
610 :
611 5202 : END SUBROUTINE cp_fm_struct_double
612 : ! **************************************************************************************************
613 : !> \brief allows to modify the default settings for matrix creation
614 : !> \param nrow_block ...
615 : !> \param ncol_block ...
616 : !> \param force_block ...
617 : ! **************************************************************************************************
618 9801 : SUBROUTINE cp_fm_struct_config(nrow_block, ncol_block, force_block)
619 : INTEGER, INTENT(IN), OPTIONAL :: nrow_block, ncol_block
620 : LOGICAL, INTENT(IN), OPTIONAL :: force_block
621 :
622 : INTEGER :: vlen
623 :
624 9801 : vlen = m_cpuid_vlen()
625 9801 : IF (PRESENT(ncol_block)) THEN
626 9801 : IF (0 < ncol_block) THEN
627 9801 : optimal_blacs_col_block_size = (ncol_block + vlen - 1)/vlen*vlen
628 : END IF
629 : END IF
630 9801 : IF (PRESENT(nrow_block)) THEN
631 9801 : IF (0 < nrow_block) THEN
632 9801 : optimal_blacs_row_block_size = (nrow_block + vlen - 1)/vlen*vlen
633 : END IF
634 : END IF
635 9801 : IF (PRESENT(force_block)) force_block_size = force_block
636 :
637 9801 : END SUBROUTINE cp_fm_struct_config
638 :
639 : ! **************************************************************************************************
640 : !> \brief ...
641 : !> \return ...
642 : ! **************************************************************************************************
643 15209 : FUNCTION cp_fm_struct_get_nrow_block() RESULT(res)
644 : INTEGER :: res
645 :
646 15209 : res = optimal_blacs_row_block_size
647 15209 : END FUNCTION cp_fm_struct_get_nrow_block
648 :
649 : ! **************************************************************************************************
650 : !> \brief ...
651 : !> \return ...
652 : ! **************************************************************************************************
653 15209 : FUNCTION cp_fm_struct_get_ncol_block() RESULT(res)
654 : INTEGER :: res
655 :
656 15209 : res = optimal_blacs_col_block_size
657 15209 : END FUNCTION cp_fm_struct_get_ncol_block
658 :
659 : ! **************************************************************************************************
660 : !> \brief wrapper to scalapack function INDXG2P that computes the row process
661 : !> coordinate which possesses the entry of a distributed matrix specified
662 : !> by a global index INDXGLOB.
663 : !> \param struct ...
664 : !> \param INDXGLOB ...
665 : !> \return ...
666 : !> \author Mauro Del Ben [MDB] - 12.2012, modified by F. Stein
667 : ! **************************************************************************************************
668 10580534 : FUNCTION cp_fm_indxg2p_row(struct, INDXGLOB) RESULT(G2P)
669 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
670 : INTEGER, INTENT(IN) :: INDXGLOB
671 : INTEGER :: G2P
672 :
673 : #if defined(__parallel)
674 : INTEGER :: number_of_process_rows
675 : INTEGER, EXTERNAL :: indxg2p
676 : #endif
677 :
678 : #if defined(__parallel)
679 :
680 10580534 : CALL struct%context%get(number_of_process_rows=number_of_process_rows)
681 :
682 10580534 : G2P = indxg2p(INDXGLOB, struct%nrow_block, 0, struct%first_p_pos(1), number_of_process_rows)
683 :
684 : #else
685 : MARK_USED(struct)
686 : MARK_USED(indxglob)
687 :
688 : G2P = 0
689 :
690 : #endif
691 :
692 10580534 : END FUNCTION cp_fm_indxg2p_row
693 :
694 : ! **************************************************************************************************
695 : !> \brief wrapper to scalapack function INDXG2P that computes the col process
696 : !> coordinate which possesses the entry of a distributed matrix specified
697 : !> by a global index INDXGLOB.
698 : !> \param struct ...
699 : !> \param INDXGLOB ...
700 : !> \return ...
701 : !> \author Mauro Del Ben [MDB] - 12.2012, modified by F. Stein
702 : ! **************************************************************************************************
703 7697271 : FUNCTION cp_fm_indxg2p_col(struct, INDXGLOB) RESULT(G2P)
704 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
705 : INTEGER, INTENT(IN) :: INDXGLOB
706 : INTEGER :: G2P
707 :
708 : #if defined(__parallel)
709 : INTEGER :: number_of_process_columns
710 : INTEGER, EXTERNAL :: indxg2p
711 : #endif
712 :
713 : #if defined(__parallel)
714 :
715 7697271 : CALL struct%context%get(number_of_process_columns=number_of_process_columns)
716 :
717 7697271 : G2P = indxg2p(INDXGLOB, struct%ncol_block, 0, struct%first_p_pos(2), number_of_process_columns)
718 :
719 : #else
720 : MARK_USED(struct)
721 : MARK_USED(indxglob)
722 :
723 : G2P = 0
724 :
725 : #endif
726 :
727 7697271 : END FUNCTION cp_fm_indxg2p_col
728 :
729 : ! **************************************************************************************************
730 : !> \brief wrapper to scalapack function INDXG2L that computes the local index
731 : !> of a distributed matrix entry pointed to by the global index INDXGLOB.
732 : !>
733 : !> Arguments
734 : !> =========
735 : !>
736 : !> INDXGLOB (global input) INTEGER
737 : !> The global index of the distributed matrix entry.
738 : !>
739 : !> NB (global input) INTEGER
740 : !> Block size, size of the blocks the distributed matrix is
741 : !> split into.
742 : !>
743 : !> IPROC (local dummy) INTEGER
744 : !> Dummy argument in this case in order to unify the calling
745 : !> sequence of the tool-routines.
746 : !>
747 : !> ISRCPROC (local dummy) INTEGER
748 : !> Dummy argument in this case in order to unify the calling
749 : !> sequence of the tool-routines.
750 : !>
751 : !> NPROCS (global input) INTEGER
752 : !> The total number processes over which the distributed
753 : !> matrix is distributed.
754 : !>
755 : !> \param struct ...
756 : !> \param INDXGLOB ...
757 : !> \return ...
758 : !> \author Mauro Del Ben [MDB] - 12.2012
759 : ! **************************************************************************************************
760 1494329 : FUNCTION cp_fm_indxg2l_row(struct, INDXGLOB) RESULT(G2L)
761 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
762 : INTEGER, INTENT(IN) :: INDXGLOB
763 : INTEGER :: G2L
764 :
765 : #if defined(__parallel)
766 : INTEGER :: number_of_process_rows
767 : INTEGER, EXTERNAL :: indxg2l
768 : #endif
769 :
770 : #if defined(__parallel)
771 :
772 1494329 : CALL struct%context%get(number_of_process_rows=number_of_process_rows)
773 :
774 1494329 : G2L = indxg2l(INDXGLOB, struct%nrow_block, 0, struct%first_p_pos(1), number_of_process_rows)
775 :
776 : #else
777 : MARK_USED(struct)
778 :
779 : G2L = INDXGLOB
780 :
781 : #endif
782 :
783 1494329 : END FUNCTION cp_fm_indxg2l_row
784 :
785 : ! **************************************************************************************************
786 : !> \brief wrapper to scalapack function INDXG2L that computes the local index
787 : !> of a distributed matrix entry pointed to by the global index INDXGLOB.
788 : !>
789 : !> Arguments
790 : !> =========
791 : !>
792 : !> INDXGLOB (global input) INTEGER
793 : !> The global index of the distributed matrix entry.
794 : !>
795 : !> NB (global input) INTEGER
796 : !> Block size, size of the blocks the distributed matrix is
797 : !> split into.
798 : !>
799 : !> IPROC (local dummy) INTEGER
800 : !> Dummy argument in this case in order to unify the calling
801 : !> sequence of the tool-routines.
802 : !>
803 : !> ISRCPROC (local dummy) INTEGER
804 : !> Dummy argument in this case in order to unify the calling
805 : !> sequence of the tool-routines.
806 : !>
807 : !> NPROCS (global input) INTEGER
808 : !> The total number processes over which the distributed
809 : !> matrix is distributed.
810 : !>
811 : !> \param struct ...
812 : !> \param INDXGLOB ...
813 : !> \return ...
814 : !> \author Mauro Del Ben [MDB] - 12.2012
815 : ! **************************************************************************************************
816 581131 : FUNCTION cp_fm_indxg2l_col(struct, INDXGLOB) RESULT(G2L)
817 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
818 : INTEGER, INTENT(IN) :: INDXGLOB
819 : INTEGER :: G2L
820 :
821 : #if defined(__parallel)
822 : INTEGER :: number_of_process_columns
823 : INTEGER, EXTERNAL :: indxg2l
824 : #endif
825 :
826 : #if defined(__parallel)
827 :
828 581131 : CALL struct%context%get(number_of_process_columns=number_of_process_columns)
829 :
830 581131 : G2L = indxg2l(INDXGLOB, struct%ncol_block, 0, struct%first_p_pos(2), number_of_process_columns)
831 :
832 : #else
833 : MARK_USED(struct)
834 :
835 : G2L = INDXGLOB
836 :
837 : #endif
838 :
839 581131 : END FUNCTION cp_fm_indxg2l_col
840 :
841 : ! **************************************************************************************************
842 : !> \brief wrapper to scalapack function INDXL2G that computes the global index
843 : !> of a distributed matrix entry pointed to by the local index INDXLOC
844 : !> of the process indicated by IPROC.
845 : !>
846 : !> Arguments
847 : !> =========
848 : !>
849 : !> INDXLOC (global input) INTEGER
850 : !> The local index of the distributed matrix entry.
851 : !>
852 : !> NB (global input) INTEGER
853 : !> Block size, size of the blocks the distributed matrix is
854 : !> split into.
855 : !>
856 : !> IPROC (local input) INTEGER
857 : !> The coordinate of the process whose local array row or
858 : !> column is to be determined.
859 : !>
860 : !> ISRCPROC (global input) INTEGER
861 : !> The coordinate of the process that possesses the first
862 : !> row/column of the distributed matrix.
863 : !>
864 : !> NPROCS (global input) INTEGER
865 : !> The total number processes over which the distributed
866 : !> matrix is distributed.
867 : !>
868 : !> \param struct ...
869 : !> \param INDXLOC ...
870 : !> \param IPROC ...
871 : !> \return ...
872 : !> \author Mauro Del Ben [MDB] - 12.2012
873 : ! **************************************************************************************************
874 5418131 : FUNCTION cp_fm_indxl2g_row(struct, INDXLOC, IPROC) RESULT(L2G)
875 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
876 : INTEGER, INTENT(IN) :: INDXLOC, IPROC
877 : INTEGER :: L2G
878 :
879 : #if defined(__parallel)
880 : INTEGER :: number_of_process_rows
881 : INTEGER, EXTERNAL :: indxl2g
882 :
883 5418131 : CALL struct%context%get(number_of_process_rows=number_of_process_rows)
884 :
885 5418131 : L2G = indxl2g(INDXLOC, struct%nrow_block, IPROC, struct%first_p_pos(1), number_of_process_rows)
886 :
887 : #else
888 : MARK_USED(struct)
889 : MARK_USED(indxloc)
890 : MARK_USED(iproc)
891 :
892 : L2G = INDXLOC
893 :
894 : #endif
895 :
896 5418131 : END FUNCTION cp_fm_indxl2g_row
897 :
898 : ! **************************************************************************************************
899 : !> \brief wrapper to scalapack function INDXL2G that computes the global index
900 : !> of a distributed matrix entry pointed to by the local index INDXLOC
901 : !> of the process indicated by IPROC.
902 : !>
903 : !> Arguments
904 : !> =========
905 : !>
906 : !> INDXLOC (global input) INTEGER
907 : !> The local index of the distributed matrix entry.
908 : !>
909 : !> NB (global input) INTEGER
910 : !> Block size, size of the blocks the distributed matrix is
911 : !> split into.
912 : !>
913 : !> IPROC (local input) INTEGER
914 : !> The coordinate of the process whose local array row or
915 : !> column is to be determined.
916 : !>
917 : !> ISRCPROC (global input) INTEGER
918 : !> The coordinate of the process that possesses the first
919 : !> row/column of the distributed matrix.
920 : !>
921 : !> NPROCS (global input) INTEGER
922 : !> The total number processes over which the distributed
923 : !> matrix is distributed.
924 : !>
925 : !> \param struct ...
926 : !> \param INDXLOC ...
927 : !> \param IPROC ...
928 : !> \return ...
929 : !> \author Mauro Del Ben [MDB] - 12.2012
930 : ! **************************************************************************************************
931 5774892 : FUNCTION cp_fm_indxl2g_col(struct, INDXLOC, IPROC) RESULT(L2G)
932 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
933 : INTEGER, INTENT(IN) :: INDXLOC, IPROC
934 : INTEGER :: L2G
935 :
936 : #if defined(__parallel)
937 : INTEGER :: number_of_process_columns
938 : INTEGER, EXTERNAL :: indxl2g
939 :
940 5774892 : CALL struct%context%get(number_of_process_columns=number_of_process_columns)
941 :
942 5774892 : L2G = indxl2g(INDXLOC, struct%ncol_block, IPROC, struct%first_p_pos(2), number_of_process_columns)
943 :
944 : #else
945 : MARK_USED(struct)
946 : MARK_USED(indxloc)
947 : MARK_USED(iproc)
948 :
949 : L2G = INDXLOC
950 :
951 : #endif
952 :
953 5774892 : END FUNCTION cp_fm_indxl2g_col
954 :
955 0 : END MODULE cp_fm_struct
|
