(git:374b731)
Loading...
Searching...
No Matches
cp_fm_struct.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 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! **************************************************************************************************
14MODULE 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 kinds, ONLY: dp
22 USE machine, ONLY: 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 = 32
38 INTEGER, PRIVATE :: optimal_blacs_row_block_size = 32
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 END TYPE cp_fm_struct_type
92! **************************************************************************************************
93 TYPE cp_fm_struct_p_type
94 TYPE(cp_fm_struct_type), POINTER :: struct => null()
95 END TYPE cp_fm_struct_p_type
96
97CONTAINS
98
99! **************************************************************************************************
100!> \brief allocates and initializes a full matrix structure
101!> \param fmstruct the pointer that will point to the new structure
102!> \param para_env the parallel environment
103!> \param context the blacs context of this matrix
104!> \param nrow_global the number of row of the full matrix
105!> \param ncol_global the number of columns of the full matrix
106!> \param nrow_block the number of rows of a block of the matrix,
107!> omit or set to -1 to use the built-in defaults
108!> \param ncol_block the number of columns of a block of the matrix,
109!> omit or set to -1 to use the built-in defaults
110!> \param descriptor the scalapack descriptor of the matrix (if not given
111!> a new one is allocated
112!> \param first_p_pos ...
113!> \param local_leading_dimension the leading dimension of the locally stored
114!> data block
115!> \param template_fmstruct a matrix structure where to take the default values
116!> \param square_blocks ...
117!> \param force_block ...
118!> \par History
119!> 08.2002 created [fawzi]
120!> \author Fawzi Mohamed
121! **************************************************************************************************
122 SUBROUTINE cp_fm_struct_create(fmstruct, para_env, context, nrow_global, &
123 ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, &
124 local_leading_dimension, template_fmstruct, square_blocks, force_block)
125
126 TYPE(cp_fm_struct_type), POINTER :: fmstruct
127 TYPE(mp_para_env_type), TARGET, OPTIONAL :: para_env
128 INTEGER, INTENT(in), OPTIONAL :: nrow_global, ncol_global
129 INTEGER, INTENT(in), OPTIONAL :: nrow_block, ncol_block
130 INTEGER, INTENT(in), OPTIONAL :: local_leading_dimension
131 TYPE(cp_blacs_env_type), TARGET, OPTIONAL :: context
132 INTEGER, DIMENSION(9), INTENT(in), OPTIONAL :: descriptor
133 INTEGER, OPTIONAL, DIMENSION(2) :: first_p_pos
134 TYPE(cp_fm_struct_type), POINTER, OPTIONAL :: template_fmstruct
135 LOGICAL, OPTIONAL, INTENT(in) :: square_blocks
136 LOGICAL, OPTIONAL, INTENT(in) :: force_block
137
138 INTEGER :: dumblock
139#if defined(__SCALAPACK)
140 INTEGER :: iunit, stat
141 INTEGER, EXTERNAL :: numroc
142 TYPE(cp_logger_type), POINTER :: logger
143#endif
144
145 LOGICAL :: my_square_blocks, my_force_block
146
147#if defined(__parallel) && ! defined(__SCALAPACK)
148 cpabort("full matrices need scalapack for parallel runs ")
149#endif
150
151 ALLOCATE (fmstruct)
152
153 fmstruct%nrow_block = optimal_blacs_row_block_size
154 fmstruct%ncol_block = optimal_blacs_col_block_size
155
156 IF (.NOT. PRESENT(template_fmstruct)) THEN
157 cpassert(PRESENT(context))
158 cpassert(PRESENT(nrow_global))
159 cpassert(PRESENT(ncol_global))
160 fmstruct%local_leading_dimension = 1
161 ELSE
162 fmstruct%context => template_fmstruct%context
163 fmstruct%para_env => template_fmstruct%para_env
164 fmstruct%descriptor = template_fmstruct%descriptor
165 fmstruct%nrow_block = template_fmstruct%nrow_block
166 fmstruct%nrow_global = template_fmstruct%nrow_global
167 fmstruct%ncol_block = template_fmstruct%ncol_block
168 fmstruct%ncol_global = template_fmstruct%ncol_global
169 fmstruct%first_p_pos = template_fmstruct%first_p_pos
170 fmstruct%local_leading_dimension = &
171 template_fmstruct%local_leading_dimension
172 END IF
173
174 my_force_block = force_block_size
175 IF (PRESENT(force_block)) my_force_block = force_block
176
177 IF (PRESENT(context)) THEN
178 fmstruct%context => context
179 fmstruct%para_env => context%para_env
180 END IF
181 IF (PRESENT(para_env)) fmstruct%para_env => para_env
182 CALL fmstruct%context%retain()
183 CALL fmstruct%para_env%retain()
184
185 IF (PRESENT(nrow_global)) THEN
186 fmstruct%nrow_global = nrow_global
187 fmstruct%local_leading_dimension = 1
188 END IF
189 IF (PRESENT(ncol_global)) THEN
190 fmstruct%ncol_global = ncol_global
191 END IF
192
193 ! try to avoid small left-over blocks (anyway naive)
194 IF (PRESENT(nrow_block)) THEN
195 IF (nrow_block > 0) & ! allows setting the number of blocks to -1 to explicitly set to auto
196 fmstruct%nrow_block = nrow_block
197 END IF
198 IF (.NOT. my_force_block) THEN
199 dumblock = ceiling(real(fmstruct%nrow_global, kind=dp)/ &
200 REAL(fmstruct%context%num_pe(1), kind=dp))
201 fmstruct%nrow_block = max(1, min(fmstruct%nrow_block, dumblock))
202 END IF
203 IF (PRESENT(ncol_block)) THEN
204 IF (ncol_block > 0) & ! allows setting the number of blocks to -1 to explicitly set to auto
205 fmstruct%ncol_block = ncol_block
206 END IF
207 IF (.NOT. my_force_block) THEN
208 dumblock = ceiling(real(fmstruct%ncol_global, kind=dp)/ &
209 REAL(fmstruct%context%num_pe(2), kind=dp))
210 fmstruct%ncol_block = max(1, min(fmstruct%ncol_block, dumblock))
211 END IF
212
213 ! square matrix -> square blocks (otherwise some op fail)
214 my_square_blocks = fmstruct%nrow_global == fmstruct%ncol_global
215 IF (PRESENT(square_blocks)) my_square_blocks = square_blocks
216 IF (my_square_blocks) THEN
217 fmstruct%nrow_block = min(fmstruct%nrow_block, fmstruct%ncol_block)
218 fmstruct%ncol_block = fmstruct%nrow_block
219 END IF
220
221 ALLOCATE (fmstruct%nrow_locals(0:(fmstruct%context%num_pe(1) - 1)), &
222 fmstruct%ncol_locals(0:(fmstruct%context%num_pe(2) - 1)))
223 IF (.NOT. PRESENT(template_fmstruct)) &
224 fmstruct%first_p_pos = (/0, 0/)
225 IF (PRESENT(first_p_pos)) fmstruct%first_p_pos = first_p_pos
226
227 fmstruct%nrow_locals = 0
228 fmstruct%ncol_locals = 0
229#if defined(__SCALAPACK)
230 fmstruct%nrow_locals(fmstruct%context%mepos(1)) = &
231 numroc(fmstruct%nrow_global, fmstruct%nrow_block, &
232 fmstruct%context%mepos(1), fmstruct%first_p_pos(1), &
233 fmstruct%context%num_pe(1))
234 fmstruct%ncol_locals(fmstruct%context%mepos(2)) = &
235 numroc(fmstruct%ncol_global, fmstruct%ncol_block, &
236 fmstruct%context%mepos(2), fmstruct%first_p_pos(2), &
237 fmstruct%context%num_pe(2))
238 CALL fmstruct%para_env%sum(fmstruct%nrow_locals)
239 CALL fmstruct%para_env%sum(fmstruct%ncol_locals)
240 fmstruct%nrow_locals(:) = fmstruct%nrow_locals(:)/fmstruct%context%num_pe(2)
241 fmstruct%ncol_locals(:) = fmstruct%ncol_locals(:)/fmstruct%context%num_pe(1)
242
243 IF (sum(fmstruct%ncol_locals) .NE. fmstruct%ncol_global .OR. &
244 sum(fmstruct%nrow_locals) .NE. fmstruct%nrow_global) THEN
245 ! try to collect some output if this is going to happen again
246 ! this seems to trigger on blanc, but should really never happen
247 logger => cp_get_default_logger()
248 iunit = cp_logger_get_default_unit_nr(logger, local=.true.)
249 WRITE (iunit, *) "mepos", fmstruct%context%mepos(1:2), "numpe", fmstruct%context%num_pe(1:2)
250 WRITE (iunit, *) "ncol_global", fmstruct%ncol_global
251 WRITE (iunit, *) "nrow_global", fmstruct%nrow_global
252 WRITE (iunit, *) "ncol_locals", fmstruct%ncol_locals
253 WRITE (iunit, *) "nrow_locals", fmstruct%nrow_locals
254 CALL m_flush(iunit)
255 END IF
256
257 IF (sum(fmstruct%ncol_locals) .NE. fmstruct%ncol_global) &
258 cpabort("sum of local cols not equal global cols")
259 IF (sum(fmstruct%nrow_locals) .NE. fmstruct%nrow_global) &
260 cpabort("sum of local row not equal global rows")
261#else
262 ! block = full matrix
263 fmstruct%nrow_block = fmstruct%nrow_global
264 fmstruct%ncol_block = fmstruct%ncol_global
265 fmstruct%nrow_locals(fmstruct%context%mepos(1)) = fmstruct%nrow_global
266 fmstruct%ncol_locals(fmstruct%context%mepos(2)) = fmstruct%ncol_global
267#endif
268
269 fmstruct%local_leading_dimension = max(fmstruct%local_leading_dimension, &
270 fmstruct%nrow_locals(fmstruct%context%mepos(1)))
271 IF (PRESENT(local_leading_dimension)) THEN
272 IF (max(1, fmstruct%nrow_locals(fmstruct%context%mepos(1))) > local_leading_dimension) &
273 CALL cp_abort(__location__, "local_leading_dimension too small ("// &
274 cp_to_string(local_leading_dimension)//"<"// &
275 cp_to_string(fmstruct%local_leading_dimension)//")")
276 fmstruct%local_leading_dimension = local_leading_dimension
277 END IF
278
279 NULLIFY (fmstruct%row_indices, fmstruct%col_indices)
280 fmstruct%ref_count = 1
281
282 IF (PRESENT(descriptor)) THEN
283 fmstruct%descriptor = descriptor
284 ELSE
285 fmstruct%descriptor = 0
286#if defined(__SCALAPACK)
287 ! local leading dimension needs to be at least 1
288 CALL descinit(fmstruct%descriptor, fmstruct%nrow_global, &
289 fmstruct%ncol_global, fmstruct%nrow_block, &
290 fmstruct%ncol_block, fmstruct%first_p_pos(1), &
291 fmstruct%first_p_pos(2), fmstruct%context, &
292 fmstruct%local_leading_dimension, stat)
293 cpassert(stat == 0)
294#endif
295 END IF
296 END SUBROUTINE cp_fm_struct_create
297
298! **************************************************************************************************
299!> \brief retains a full matrix structure
300!> \param fmstruct the structure to retain
301!> \par History
302!> 08.2002 created [fawzi]
303!> \author Fawzi Mohamed
304! **************************************************************************************************
305 SUBROUTINE cp_fm_struct_retain(fmstruct)
306 TYPE(cp_fm_struct_type), INTENT(INOUT) :: fmstruct
307
308 cpassert(fmstruct%ref_count > 0)
309 fmstruct%ref_count = fmstruct%ref_count + 1
310 END SUBROUTINE cp_fm_struct_retain
311
312! **************************************************************************************************
313!> \brief releases a full matrix structure
314!> \param fmstruct the structure to release
315!> \par History
316!> 08.2002 created [fawzi]
317!> \author Fawzi Mohamed
318! **************************************************************************************************
319 SUBROUTINE cp_fm_struct_release(fmstruct)
320 TYPE(cp_fm_struct_type), POINTER :: fmstruct
321
322 IF (ASSOCIATED(fmstruct)) THEN
323 cpassert(fmstruct%ref_count > 0)
324 fmstruct%ref_count = fmstruct%ref_count - 1
325 IF (fmstruct%ref_count < 1) THEN
326 CALL cp_blacs_env_release(fmstruct%context)
327 CALL mp_para_env_release(fmstruct%para_env)
328 IF (ASSOCIATED(fmstruct%row_indices)) THEN
329 DEALLOCATE (fmstruct%row_indices)
330 END IF
331 IF (ASSOCIATED(fmstruct%col_indices)) THEN
332 DEALLOCATE (fmstruct%col_indices)
333 END IF
334 IF (ASSOCIATED(fmstruct%nrow_locals)) THEN
335 DEALLOCATE (fmstruct%nrow_locals)
336 END IF
337 IF (ASSOCIATED(fmstruct%ncol_locals)) THEN
338 DEALLOCATE (fmstruct%ncol_locals)
339 END IF
340 DEALLOCATE (fmstruct)
341 END IF
342 END IF
343 NULLIFY (fmstruct)
344 END SUBROUTINE cp_fm_struct_release
345
346! **************************************************************************************************
347!> \brief returns true if the two matrix structures are equivalent, false
348!> otherwise.
349!> \param fmstruct1 one of the full matrix structures to compare
350!> \param fmstruct2 the second of the full matrix structures to compare
351!> \return ...
352!> \par History
353!> 08.2002 created [fawzi]
354!> \author Fawzi Mohamed
355! **************************************************************************************************
356 FUNCTION cp_fm_struct_equivalent(fmstruct1, fmstruct2) RESULT(res)
357 TYPE(cp_fm_struct_type), POINTER :: fmstruct1, fmstruct2
358 LOGICAL :: res
359
360 INTEGER :: i
361
362 cpassert(ASSOCIATED(fmstruct1))
363 cpassert(ASSOCIATED(fmstruct2))
364 cpassert(fmstruct1%ref_count > 0)
365 cpassert(fmstruct2%ref_count > 0)
366 IF (ASSOCIATED(fmstruct1, fmstruct2)) THEN
367 res = .true.
368 ELSE
369 res = (fmstruct1%context == fmstruct2%context) .AND. &
370 (fmstruct1%nrow_global == fmstruct2%nrow_global) .AND. &
371 (fmstruct1%ncol_global == fmstruct2%ncol_global) .AND. &
372 (fmstruct1%nrow_block == fmstruct2%nrow_block) .AND. &
373 (fmstruct1%ncol_block == fmstruct2%ncol_block) .AND. &
374 (fmstruct1%local_leading_dimension == &
375 fmstruct2%local_leading_dimension)
376 DO i = 1, 9
377 res = res .AND. (fmstruct1%descriptor(i) == fmstruct1%descriptor(i))
378 END DO
379 END IF
380 END FUNCTION cp_fm_struct_equivalent
381
382! **************************************************************************************************
383!> \brief returns the values of various attributes of the matrix structure
384!> \param fmstruct the structure you want info about
385!> \param para_env ...
386!> \param context ...
387!> \param descriptor ...
388!> \param ncol_block ...
389!> \param nrow_block ...
390!> \param nrow_global ...
391!> \param ncol_global ...
392!> \param first_p_pos ...
393!> \param row_indices ...
394!> \param col_indices ...
395!> \param nrow_local ...
396!> \param ncol_local ...
397!> \param nrow_locals ...
398!> \param ncol_locals ...
399!> \param local_leading_dimension ...
400!> \par History
401!> 08.2002 created [fawzi]
402!> \author Fawzi Mohamed
403! **************************************************************************************************
404 SUBROUTINE cp_fm_struct_get(fmstruct, para_env, context, &
405 descriptor, ncol_block, nrow_block, nrow_global, &
406 ncol_global, first_p_pos, row_indices, &
407 col_indices, nrow_local, ncol_local, nrow_locals, ncol_locals, &
408 local_leading_dimension)
409 TYPE(cp_fm_struct_type), INTENT(INOUT) :: fmstruct
410 TYPE(mp_para_env_type), POINTER, OPTIONAL :: para_env
411 TYPE(cp_blacs_env_type), POINTER, OPTIONAL :: context
412 INTEGER, DIMENSION(9), INTENT(OUT), OPTIONAL :: descriptor
413 INTEGER, INTENT(out), OPTIONAL :: ncol_block, nrow_block, nrow_global, &
414 ncol_global, nrow_local, ncol_local, &
415 local_leading_dimension
416 INTEGER, DIMENSION(2), INTENT(out), OPTIONAL :: first_p_pos
417 INTEGER, DIMENSION(:), POINTER, OPTIONAL :: row_indices, col_indices, &
418 nrow_locals, ncol_locals
419
420 INTEGER i, nprow, npcol, myprow, mypcol
421#if defined(__SCALAPACK)
422 INTEGER, EXTERNAL :: indxl2g
423#endif
424
425 IF (PRESENT(para_env)) para_env => fmstruct%para_env
426 IF (PRESENT(context)) context => fmstruct%context
427 IF (PRESENT(descriptor)) descriptor = fmstruct%descriptor
428 IF (PRESENT(ncol_block)) ncol_block = fmstruct%ncol_block
429 IF (PRESENT(nrow_block)) nrow_block = fmstruct%nrow_block
430 IF (PRESENT(nrow_global)) nrow_global = fmstruct%nrow_global
431 IF (PRESENT(ncol_global)) ncol_global = fmstruct%ncol_global
432 IF (PRESENT(first_p_pos)) first_p_pos = fmstruct%first_p_pos
433 IF (PRESENT(nrow_locals)) nrow_locals => fmstruct%nrow_locals
434 IF (PRESENT(ncol_locals)) ncol_locals => fmstruct%ncol_locals
435 IF (PRESENT(local_leading_dimension)) local_leading_dimension = &
436 fmstruct%local_leading_dimension
437
438 myprow = fmstruct%context%mepos(1)
439 mypcol = fmstruct%context%mepos(2)
440 nprow = fmstruct%context%num_pe(1)
441 npcol = fmstruct%context%num_pe(2)
442
443 IF (PRESENT(nrow_local)) nrow_local = fmstruct%nrow_locals(myprow)
444 IF (PRESENT(ncol_local)) ncol_local = fmstruct%ncol_locals(mypcol)
445
446 IF (PRESENT(row_indices)) THEN
447 row_indices => fmstruct%row_indices
448 IF (.NOT. ASSOCIATED(row_indices)) THEN
449 ! the max should go away
450 ALLOCATE (fmstruct%row_indices(max(fmstruct%nrow_locals(myprow), 1)))
451 row_indices => fmstruct%row_indices
452#ifdef __SCALAPACK
453 DO i = 1, SIZE(row_indices)
454 row_indices(i) = &
455 indxl2g(i, fmstruct%nrow_block, myprow, fmstruct%first_p_pos(1), nprow)
456 END DO
457#else
458 DO i = 1, SIZE(row_indices)
459 row_indices(i) = i
460 END DO
461#endif
462 END IF
463 END IF
464
465 IF (PRESENT(col_indices)) THEN
466 col_indices => fmstruct%col_indices
467 IF (.NOT. ASSOCIATED(col_indices)) THEN
468 ALLOCATE (fmstruct%col_indices(max(fmstruct%ncol_locals(mypcol), 1)))
469 col_indices => fmstruct%col_indices
470#ifdef __SCALAPACK
471 DO i = 1, SIZE(col_indices)
472 col_indices(i) = &
473 indxl2g(i, fmstruct%ncol_block, mypcol, fmstruct%first_p_pos(2), npcol)
474 END DO
475#else
476 DO i = 1, SIZE(col_indices)
477 col_indices(i) = i
478 END DO
479#endif
480 END IF
481
482 END IF
483 END SUBROUTINE cp_fm_struct_get
484
485! **************************************************************************************************
486!> \brief Write nicely formatted info about the FM struct to the given I/O unit
487!> \param fmstruct a cp_fm_struct_type instance
488!> \param io_unit the I/O unit to use for writing
489! **************************************************************************************************
490 SUBROUTINE cp_fm_struct_write_info(fmstruct, io_unit)
491 TYPE(cp_fm_struct_type), INTENT(IN) :: fmstruct
492 INTEGER, INTENT(IN) :: io_unit
493
494 INTEGER, PARAMETER :: oblock_size = 8
495
496 CHARACTER(len=30) :: fm
497 INTEGER :: oblock
498
499 WRITE (fm, "(A,I2,A)") "(A,I5,A,I5,A,", oblock_size, "I6)"
500
501 WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of matrix columns: ", fmstruct%ncol_global
502 WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of matrix rows: ", fmstruct%nrow_global
503 WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of block columns: ", fmstruct%ncol_block
504 WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of block rows: ", fmstruct%nrow_block
505
506 WRITE (io_unit, '(A)') "CP_FM_STRUCT | Number of local columns: "
507 DO oblock = 0, (SIZE(fmstruct%ncol_locals) - 1)/oblock_size
508 WRITE (io_unit, fm) "CP_FM_STRUCT | CPUs ", &
509 oblock*oblock_size, "..", (oblock + 1)*oblock_size - 1, ": ", &
510 fmstruct%ncol_locals(oblock*oblock_size:min(SIZE(fmstruct%ncol_locals), (oblock + 1)*oblock_size) - 1)
511 END DO
512
513 WRITE (io_unit, '(A)') "CP_FM_STRUCT | Number of local rows: "
514 DO oblock = 0, (SIZE(fmstruct%nrow_locals) - 1)/oblock_size
515 WRITE (io_unit, fm) "CP_FM_STRUCT | CPUs ", &
516 oblock*oblock_size, "..", (oblock + 1)*oblock_size - 1, ": ", &
517 fmstruct%nrow_locals(oblock*oblock_size:min(SIZE(fmstruct%nrow_locals), (oblock + 1)*oblock_size) - 1)
518 END DO
519 END SUBROUTINE cp_fm_struct_write_info
520
521! **************************************************************************************************
522!> \brief creates a struct with twice the number of blocks on each core.
523!> If matrix A has to be multiplied with B anc C, a
524!> significant speedup of pdgemm can be acchieved by joining the matrices
525!> in a new one with this structure (see arnoldi in rt_matrix_exp)
526!> \param fmstruct the struct to create
527!> \param struct struct of either A or B
528!> \param context ...
529!> \param col in which direction the matrix should be enlarged
530!> \param row in which direction the matrix should be enlarged
531!> \par History
532!> 06.2009 created [fschiff]
533!> \author Florian Schiffmann
534! **************************************************************************************************
535 SUBROUTINE cp_fm_struct_double(fmstruct, struct, context, col, row)
536 TYPE(cp_fm_struct_type), POINTER :: fmstruct
537 TYPE(cp_fm_struct_type), INTENT(INOUT) :: struct
538 TYPE(cp_blacs_env_type), INTENT(INOUT), TARGET :: context
539 LOGICAL, INTENT(in) :: col, row
540
541 INTEGER :: n_doubled_items_in_partially_filled_block, ncol_block, ncol_global, newdim_col, &
542 newdim_row, nfilled_blocks, nfilled_blocks_remain, nprocs_col, nprocs_row, nrow_block, &
543 nrow_global
544 TYPE(mp_para_env_type), POINTER :: para_env
545
546 CALL cp_fm_struct_get(struct, nrow_global=nrow_global, &
547 ncol_global=ncol_global, nrow_block=nrow_block, &
548 ncol_block=ncol_block)
549 newdim_row = nrow_global
550 newdim_col = ncol_global
551 nprocs_row = context%num_pe(1)
552 nprocs_col = context%num_pe(2)
553 para_env => struct%para_env
554
555 IF (col) THEN
556 IF (ncol_global == 0) THEN
557 newdim_col = 0
558 ELSE
559 ! ncol_block nfilled_blocks_remain * ncol_block
560 ! |<--->| |<--->|
561 ! |-----|-----|-----|-----|---|
562 ! | 0 | 1 | 2 | 0 | 1 | <- context%mepos(2)
563 ! |-----|-----|-----|-----|---|
564 ! |<--- nfilled_blocks -->|<-> -- items (columns) in partially filled blocks
565 ! | * ncol_block |
566 n_doubled_items_in_partially_filled_block = 2*mod(ncol_global, ncol_block)
567 nfilled_blocks = ncol_global/ncol_block
568 nfilled_blocks_remain = mod(nfilled_blocks, nprocs_col)
569 newdim_col = 2*(nfilled_blocks/nprocs_col)
570 IF (n_doubled_items_in_partially_filled_block > ncol_block) THEN
571 ! doubled number of columns in a partially filled block does not fit into a single block.
572 ! Due to cyclic distribution of ScaLAPACK blocks, an extra block for each core needs to be added
573 ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---|
574 ! | 0 | 1 | 2 | 0 | --> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0|
575 ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---|
576 ! a a a b a1 a1 a1 a2 a2 a2 b1 empty empty b2
577 newdim_col = newdim_col + 1
578
579 ! the number of columns which does not fit into the added extra block
580 n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - ncol_block
581 ELSE IF (nfilled_blocks_remain > 0) THEN
582 ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
583 ! | 0 | 1 | 2 | 0 | 1| -> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0 |
584 ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
585 ! a a a b b a1 a1 a1 a2 a2 a2 b1 b1 b2 empty b2
586 newdim_col = newdim_col + 1
587 n_doubled_items_in_partially_filled_block = 0
588 END IF
589
590 newdim_col = (newdim_col*nprocs_col + nfilled_blocks_remain)*ncol_block + n_doubled_items_in_partially_filled_block
591 END IF
592 END IF
593
594 IF (row) THEN
595 IF (nrow_global == 0) THEN
596 newdim_row = 0
597 ELSE
598 n_doubled_items_in_partially_filled_block = 2*mod(nrow_global, nrow_block)
599 nfilled_blocks = nrow_global/nrow_block
600 nfilled_blocks_remain = mod(nfilled_blocks, nprocs_row)
601 newdim_row = 2*(nfilled_blocks/nprocs_row)
602 IF (n_doubled_items_in_partially_filled_block > nrow_block) THEN
603 newdim_row = newdim_row + 1
604 n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - nrow_block
605 ELSE IF (nfilled_blocks_remain > 0) THEN
606 newdim_row = newdim_row + 1
607 n_doubled_items_in_partially_filled_block = 0
608 END IF
609
610 newdim_row = (newdim_row*nprocs_row + nfilled_blocks_remain)*nrow_block + n_doubled_items_in_partially_filled_block
611 END IF
612 END IF
613
614 ! square_blocks=.FALSE. ensures that matrix blocks of the doubled matrix will have
615 ! nrow_block x ncol_block shape even in case of a square doubled matrix
616 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
617 context=context, &
618 nrow_global=newdim_row, &
619 ncol_global=newdim_col, &
620 ncol_block=ncol_block, &
621 nrow_block=nrow_block, &
622 square_blocks=.false.)
623
624 END SUBROUTINE cp_fm_struct_double
625! **************************************************************************************************
626!> \brief allows to modify the default settings for matrix creation
627!> \param nrow_block ...
628!> \param ncol_block ...
629!> \param force_block ...
630! **************************************************************************************************
631 SUBROUTINE cp_fm_struct_config(nrow_block, ncol_block, force_block)
632 INTEGER, INTENT(IN), OPTIONAL :: nrow_block, ncol_block
633 LOGICAL, INTENT(IN), OPTIONAL :: force_block
634
635 IF (PRESENT(ncol_block)) optimal_blacs_col_block_size = ncol_block
636 IF (PRESENT(nrow_block)) optimal_blacs_row_block_size = nrow_block
637 IF (PRESENT(force_block)) force_block_size = force_block
638
639 END SUBROUTINE cp_fm_struct_config
640
641! **************************************************************************************************
642!> \brief ...
643!> \return ...
644! **************************************************************************************************
645 FUNCTION cp_fm_struct_get_nrow_block() RESULT(res)
646 INTEGER :: res
647
648 res = optimal_blacs_row_block_size
649 END FUNCTION cp_fm_struct_get_nrow_block
650
651! **************************************************************************************************
652!> \brief ...
653!> \return ...
654! **************************************************************************************************
655 FUNCTION cp_fm_struct_get_ncol_block() RESULT(res)
656 INTEGER :: res
657
658 res = optimal_blacs_col_block_size
659 END FUNCTION cp_fm_struct_get_ncol_block
660
661END MODULE cp_fm_struct
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_blacs_env::cp_blacs_env_release
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
Definition cp_blacs_env.F:282
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_struct::cp_fm_struct_create
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
Definition cp_fm_struct.F:125
cp_fm_struct::cp_fm_struct_get_nrow_block
integer function, public cp_fm_struct_get_nrow_block()
...
Definition cp_fm_struct.F:646
cp_fm_struct::cp_fm_struct_get_ncol_block
integer function, public cp_fm_struct_get_ncol_block()
...
Definition cp_fm_struct.F:656
cp_fm_struct::cp_fm_struct_config
subroutine, public cp_fm_struct_config(nrow_block, ncol_block, force_block)
allows to modify the default settings for matrix creation
Definition cp_fm_struct.F:632
cp_fm_struct::cp_fm_struct_get
subroutine, public cp_fm_struct_get(fmstruct, para_env, context, descriptor, ncol_block, nrow_block, nrow_global, ncol_global, first_p_pos, row_indices, col_indices, nrow_local, ncol_local, nrow_locals, ncol_locals, local_leading_dimension)
returns the values of various attributes of the matrix structure
Definition cp_fm_struct.F:409
cp_fm_struct::cp_fm_struct_double
subroutine, public cp_fm_struct_double(fmstruct, struct, context, col, row)
creates a struct with twice the number of blocks on each core. If matrix A has to be multiplied with ...
Definition cp_fm_struct.F:536
cp_fm_struct::cp_fm_struct_equivalent
logical function, public cp_fm_struct_equivalent(fmstruct1, fmstruct2)
returns true if the two matrix structures are equivalent, false otherwise.
Definition cp_fm_struct.F:357
cp_fm_struct::cp_fm_struct_retain
subroutine, public cp_fm_struct_retain(fmstruct)
retains a full matrix structure
Definition cp_fm_struct.F:306
cp_fm_struct::cp_fm_struct_write_info
subroutine, public cp_fm_struct_write_info(fmstruct, io_unit)
Write nicely formatted info about the FM struct to the given I/O unit.
Definition cp_fm_struct.F:491
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:320
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_unit_nr
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
Definition cp_log_handling.F:567
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_flush
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:106
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
message_passing::mp_para_env_release
subroutine, public mp_para_env_release(para_env)
releases the para object (to be called when you don't want anymore the shared copy of this object)
Definition message_passing.F:2027
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_fm_struct::cp_fm_struct_p_type
Definition cp_fm_struct.F:93
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763