Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 705293 : 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), TARGET, 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 8463516 : ALLOCATE (fmstruct)
155 :
156 705293 : IF (.NOT. PRESENT(template_fmstruct)) THEN
157 535953 : CPASSERT(PRESENT(context))
158 535953 : CPASSERT(PRESENT(nrow_global))
159 535953 : CPASSERT(PRESENT(ncol_global))
160 535953 : fmstruct%local_leading_dimension = 1
161 535953 : fmstruct%nrow_block = 0 ! populate default later
162 535953 : fmstruct%ncol_block = 0 ! populate default later
163 : ELSE
164 169340 : fmstruct%context => template_fmstruct%context
165 169340 : fmstruct%para_env => template_fmstruct%para_env
166 3217460 : fmstruct%descriptor = template_fmstruct%descriptor
167 169340 : fmstruct%nrow_block = template_fmstruct%nrow_block
168 169340 : fmstruct%nrow_global = template_fmstruct%nrow_global
169 169340 : fmstruct%ncol_block = template_fmstruct%ncol_block
170 169340 : fmstruct%ncol_global = template_fmstruct%ncol_global
171 846700 : fmstruct%first_p_pos = template_fmstruct%first_p_pos
172 : fmstruct%local_leading_dimension = &
173 169340 : template_fmstruct%local_leading_dimension
174 : END IF
175 :
176 : ! allow to request default block size (zero or negative value)
177 705293 : IF (PRESENT(nrow_block)) fmstruct%nrow_block = nrow_block
178 705293 : IF (PRESENT(ncol_block)) fmstruct%ncol_block = ncol_block
179 705293 : IF (0 >= fmstruct%nrow_block) THEN
180 524166 : fmstruct%nrow_block = optimal_blacs_row_block_size
181 : END IF
182 705293 : IF (0 >= fmstruct%ncol_block) THEN
183 515886 : fmstruct%ncol_block = optimal_blacs_col_block_size
184 : END IF
185 705293 : CPASSERT(0 < fmstruct%nrow_block .AND. 0 < fmstruct%ncol_block)
186 :
187 705293 : IF (PRESENT(context)) THEN
188 542779 : fmstruct%context => context
189 542779 : fmstruct%para_env => context%para_env
190 : END IF
191 705293 : IF (PRESENT(para_env)) fmstruct%para_env => para_env
192 705293 : CALL fmstruct%context%retain()
193 705293 : CALL fmstruct%para_env%retain()
194 :
195 705293 : IF (PRESENT(nrow_global)) THEN
196 695433 : fmstruct%nrow_global = nrow_global
197 695433 : fmstruct%local_leading_dimension = 1
198 : END IF
199 705293 : IF (PRESENT(ncol_global)) THEN
200 703043 : fmstruct%ncol_global = ncol_global
201 : END IF
202 :
203 705293 : my_force_block = force_block_size
204 705293 : IF (PRESENT(force_block)) my_force_block = force_block
205 705293 : IF (.NOT. my_force_block) THEN
206 690528 : vlen = m_cpuid_vlen()
207 : nmax_block = (fmstruct%nrow_global + fmstruct%context%num_pe(1) - 1)/ &
208 690528 : (fmstruct%context%num_pe(1))
209 690528 : IF (1 < vlen) THEN ! flooring not ceiling (OOB)
210 690528 : fmstruct%nrow_block = fmstruct%nrow_block/vlen*vlen
211 690528 : nmax_block = nmax_block/vlen*vlen
212 : END IF
213 690528 : 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 690528 : (fmstruct%context%num_pe(2))
217 690528 : IF (1 < vlen) THEN ! flooring not ceiling (OOB)
218 690528 : fmstruct%ncol_block = fmstruct%ncol_block/vlen*vlen
219 690528 : nmax_block = nmax_block/vlen*vlen
220 : END IF
221 690528 : 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 705293 : my_square_blocks = fmstruct%nrow_global == fmstruct%ncol_global
226 : ! however, requesting non-square blocks takes precedence
227 705293 : IF (PRESENT(square_blocks)) my_square_blocks = square_blocks
228 705293 : IF (my_square_blocks) THEN
229 459616 : fmstruct%nrow_block = MIN(fmstruct%nrow_block, fmstruct%ncol_block)
230 459616 : fmstruct%ncol_block = fmstruct%nrow_block
231 : END IF
232 :
233 : ALLOCATE (fmstruct%nrow_locals(0:(fmstruct%context%num_pe(1) - 1)), &
234 3526465 : fmstruct%ncol_locals(0:(fmstruct%context%num_pe(2) - 1)))
235 705293 : IF (.NOT. PRESENT(template_fmstruct)) THEN
236 1607859 : fmstruct%first_p_pos = [0, 0]
237 : END IF
238 705293 : IF (PRESENT(first_p_pos)) fmstruct%first_p_pos = first_p_pos
239 :
240 1962526 : fmstruct%nrow_locals = 0
241 1410586 : fmstruct%ncol_locals = 0
242 : #if defined(__parallel)
243 : fmstruct%nrow_locals(fmstruct%context%mepos(1)) = &
244 : numroc(fmstruct%nrow_global, fmstruct%nrow_block, &
245 : fmstruct%context%mepos(1), fmstruct%first_p_pos(1), &
246 705293 : fmstruct%context%num_pe(1))
247 : fmstruct%ncol_locals(fmstruct%context%mepos(2)) = &
248 : numroc(fmstruct%ncol_global, fmstruct%ncol_block, &
249 : fmstruct%context%mepos(2), fmstruct%first_p_pos(2), &
250 705293 : fmstruct%context%num_pe(2))
251 3219759 : CALL fmstruct%para_env%sum(fmstruct%nrow_locals)
252 2115879 : CALL fmstruct%para_env%sum(fmstruct%ncol_locals)
253 1962526 : fmstruct%nrow_locals(:) = fmstruct%nrow_locals(:)/fmstruct%context%num_pe(2)
254 1410586 : fmstruct%ncol_locals(:) = fmstruct%ncol_locals(:)/fmstruct%context%num_pe(1)
255 :
256 2667819 : IF (SUM(fmstruct%ncol_locals) /= fmstruct%ncol_global .OR. &
257 : SUM(fmstruct%nrow_locals) /= fmstruct%nrow_global) THEN
258 : ! try to collect some output if this is going to happen again
259 : ! this seems to trigger on blanc, but should really never happen
260 0 : logger => cp_get_default_logger()
261 0 : iunit = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
262 0 : WRITE (iunit, *) "mepos", fmstruct%context%mepos(1:2), "numpe", fmstruct%context%num_pe(1:2)
263 0 : WRITE (iunit, *) "ncol_global", fmstruct%ncol_global
264 0 : WRITE (iunit, *) "nrow_global", fmstruct%nrow_global
265 0 : WRITE (iunit, *) "ncol_locals", fmstruct%ncol_locals
266 0 : WRITE (iunit, *) "nrow_locals", fmstruct%nrow_locals
267 0 : CALL m_flush(iunit)
268 : END IF
269 :
270 1410586 : IF (SUM(fmstruct%ncol_locals) /= fmstruct%ncol_global) THEN
271 0 : CPABORT("sum of local cols not equal global cols")
272 : END IF
273 1962526 : IF (SUM(fmstruct%nrow_locals) /= fmstruct%nrow_global) THEN
274 0 : CPABORT("sum of local row not equal global rows")
275 : END IF
276 : #else
277 : ! block = full matrix
278 : fmstruct%nrow_block = fmstruct%nrow_global
279 : fmstruct%ncol_block = fmstruct%ncol_global
280 : fmstruct%nrow_locals(fmstruct%context%mepos(1)) = fmstruct%nrow_global
281 : fmstruct%ncol_locals(fmstruct%context%mepos(2)) = fmstruct%ncol_global
282 : #endif
283 :
284 : fmstruct%local_leading_dimension = MAX(fmstruct%local_leading_dimension, &
285 705293 : fmstruct%nrow_locals(fmstruct%context%mepos(1)))
286 705293 : IF (PRESENT(local_leading_dimension)) THEN
287 0 : IF (MAX(1, fmstruct%nrow_locals(fmstruct%context%mepos(1))) > local_leading_dimension) THEN
288 : CALL cp_abort(__LOCATION__, "local_leading_dimension too small ("// &
289 : cp_to_string(local_leading_dimension)//"<"// &
290 0 : cp_to_string(fmstruct%local_leading_dimension)//")")
291 : END IF
292 0 : fmstruct%local_leading_dimension = local_leading_dimension
293 : END IF
294 :
295 705293 : NULLIFY (fmstruct%row_indices, fmstruct%col_indices)
296 :
297 : ! the max should go away
298 2115879 : ALLOCATE (fmstruct%row_indices(MAX(fmstruct%nrow_locals(fmstruct%context%mepos(1)), 1)))
299 7781414 : DO i = 1, SIZE(fmstruct%row_indices)
300 : #ifdef __parallel
301 7781414 : fmstruct%row_indices(i) = fmstruct%l2g_row(i, fmstruct%context%mepos(1))
302 : #else
303 : fmstruct%row_indices(i) = i
304 : #endif
305 : END DO
306 2115879 : ALLOCATE (fmstruct%col_indices(MAX(fmstruct%ncol_locals(fmstruct%context%mepos(2)), 1)))
307 8584518 : DO i = 1, SIZE(fmstruct%col_indices)
308 : #ifdef __parallel
309 8584518 : fmstruct%col_indices(i) = fmstruct%l2g_col(i, fmstruct%context%mepos(2))
310 : #else
311 : fmstruct%col_indices(i) = i
312 : #endif
313 : END DO
314 :
315 705293 : fmstruct%ref_count = 1
316 :
317 705293 : IF (PRESENT(descriptor)) THEN
318 0 : fmstruct%descriptor = descriptor
319 : ELSE
320 7052930 : fmstruct%descriptor = 0
321 : #if defined(__parallel)
322 : ! local leading dimension needs to be at least 1
323 : CALL descinit(fmstruct%descriptor, fmstruct%nrow_global, &
324 : fmstruct%ncol_global, fmstruct%nrow_block, &
325 : fmstruct%ncol_block, fmstruct%first_p_pos(1), &
326 : fmstruct%first_p_pos(2), fmstruct%context, &
327 705293 : fmstruct%local_leading_dimension, stat)
328 705293 : CPASSERT(stat == 0)
329 : #endif
330 : END IF
331 705293 : END SUBROUTINE cp_fm_struct_create
332 :
333 : ! **************************************************************************************************
334 : !> \brief retains a full matrix structure
335 : !> \param fmstruct the structure to retain
336 : !> \par History
337 : !> 08.2002 created [fawzi]
338 : !> \author Fawzi Mohamed
339 : ! **************************************************************************************************
340 2465552 : SUBROUTINE cp_fm_struct_retain(fmstruct)
341 : TYPE(cp_fm_struct_type), INTENT(INOUT) :: fmstruct
342 :
343 2465552 : CPASSERT(fmstruct%ref_count > 0)
344 2465552 : fmstruct%ref_count = fmstruct%ref_count + 1
345 2465552 : END SUBROUTINE cp_fm_struct_retain
346 :
347 : ! **************************************************************************************************
348 : !> \brief releases a full matrix structure
349 : !> \param fmstruct the structure to release
350 : !> \par History
351 : !> 08.2002 created [fawzi]
352 : !> \author Fawzi Mohamed
353 : ! **************************************************************************************************
354 3216200 : SUBROUTINE cp_fm_struct_release(fmstruct)
355 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
356 :
357 3216200 : IF (ASSOCIATED(fmstruct)) THEN
358 3170837 : CPASSERT(fmstruct%ref_count > 0)
359 3170837 : fmstruct%ref_count = fmstruct%ref_count - 1
360 3170837 : IF (fmstruct%ref_count < 1) THEN
361 705285 : CALL cp_blacs_env_release(fmstruct%context)
362 705285 : CALL mp_para_env_release(fmstruct%para_env)
363 705285 : IF (ASSOCIATED(fmstruct%row_indices)) THEN
364 705285 : DEALLOCATE (fmstruct%row_indices)
365 : END IF
366 705285 : IF (ASSOCIATED(fmstruct%col_indices)) THEN
367 705285 : DEALLOCATE (fmstruct%col_indices)
368 : END IF
369 705285 : IF (ASSOCIATED(fmstruct%nrow_locals)) THEN
370 705285 : DEALLOCATE (fmstruct%nrow_locals)
371 : END IF
372 705285 : IF (ASSOCIATED(fmstruct%ncol_locals)) THEN
373 705285 : DEALLOCATE (fmstruct%ncol_locals)
374 : END IF
375 705285 : DEALLOCATE (fmstruct)
376 : END IF
377 : END IF
378 3216200 : NULLIFY (fmstruct)
379 3216200 : END SUBROUTINE cp_fm_struct_release
380 :
381 : ! **************************************************************************************************
382 : !> \brief returns true if the two matrix structures are equivalent, false
383 : !> otherwise.
384 : !> \param fmstruct1 one of the full matrix structures to compare
385 : !> \param fmstruct2 the second of the full matrix structures to compare
386 : !> \return ...
387 : !> \par History
388 : !> 08.2002 created [fawzi]
389 : !> \author Fawzi Mohamed
390 : ! **************************************************************************************************
391 4707567 : FUNCTION cp_fm_struct_equivalent(fmstruct1, fmstruct2) RESULT(res)
392 : TYPE(cp_fm_struct_type), POINTER :: fmstruct1, fmstruct2
393 : LOGICAL :: res
394 :
395 : INTEGER :: i
396 :
397 4707567 : CPASSERT(ASSOCIATED(fmstruct1))
398 4707567 : CPASSERT(ASSOCIATED(fmstruct2))
399 4707567 : CPASSERT(fmstruct1%ref_count > 0)
400 4707567 : CPASSERT(fmstruct2%ref_count > 0)
401 4707567 : IF (ASSOCIATED(fmstruct1, fmstruct2)) THEN
402 : res = .TRUE.
403 : ELSE
404 : res = (fmstruct1%context == fmstruct2%context) .AND. &
405 : (fmstruct1%nrow_global == fmstruct2%nrow_global) .AND. &
406 : (fmstruct1%ncol_global == fmstruct2%ncol_global) .AND. &
407 : (fmstruct1%nrow_block == fmstruct2%nrow_block) .AND. &
408 : (fmstruct1%ncol_block == fmstruct2%ncol_block) .AND. &
409 : (fmstruct1%local_leading_dimension == &
410 337263 : fmstruct2%local_leading_dimension)
411 3372630 : DO i = 1, 9
412 3372630 : res = res .AND. (fmstruct1%descriptor(i) == fmstruct1%descriptor(i))
413 : END DO
414 : END IF
415 4707567 : END FUNCTION cp_fm_struct_equivalent
416 :
417 : ! **************************************************************************************************
418 : !> \brief returns the values of various attributes of the matrix structure
419 : !> \param fmstruct the structure you want info about
420 : !> \param para_env ...
421 : !> \param context ...
422 : !> \param descriptor ...
423 : !> \param ncol_block ...
424 : !> \param nrow_block ...
425 : !> \param nrow_global ...
426 : !> \param ncol_global ...
427 : !> \param first_p_pos ...
428 : !> \param row_indices ...
429 : !> \param col_indices ...
430 : !> \param nrow_local ...
431 : !> \param ncol_local ...
432 : !> \param nrow_locals ...
433 : !> \param ncol_locals ...
434 : !> \param local_leading_dimension ...
435 : !> \par History
436 : !> 08.2002 created [fawzi]
437 : !> \author Fawzi Mohamed
438 : ! **************************************************************************************************
439 9198552 : SUBROUTINE cp_fm_struct_get(fmstruct, para_env, context, &
440 : descriptor, ncol_block, nrow_block, nrow_global, &
441 : ncol_global, first_p_pos, row_indices, &
442 : col_indices, nrow_local, ncol_local, nrow_locals, ncol_locals, &
443 : local_leading_dimension)
444 : TYPE(cp_fm_struct_type), INTENT(IN) :: fmstruct
445 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
446 : TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: context
447 : INTEGER, DIMENSION(9), INTENT(OUT), OPTIONAL :: descriptor
448 : INTEGER, INTENT(out), OPTIONAL :: ncol_block, nrow_block, nrow_global, &
449 : ncol_global
450 : INTEGER, DIMENSION(2), INTENT(out), OPTIONAL :: first_p_pos
451 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: row_indices, col_indices
452 : INTEGER, INTENT(out), OPTIONAL :: nrow_local, ncol_local
453 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nrow_locals, ncol_locals
454 : INTEGER, INTENT(out), OPTIONAL :: local_leading_dimension
455 :
456 9198552 : IF (PRESENT(para_env)) para_env => fmstruct%para_env
457 9198552 : IF (PRESENT(context)) context => fmstruct%context
458 9198552 : IF (PRESENT(descriptor)) descriptor = fmstruct%descriptor
459 9198552 : IF (PRESENT(ncol_block)) ncol_block = fmstruct%ncol_block
460 9198552 : IF (PRESENT(nrow_block)) nrow_block = fmstruct%nrow_block
461 9198552 : IF (PRESENT(nrow_global)) nrow_global = fmstruct%nrow_global
462 9198552 : IF (PRESENT(ncol_global)) ncol_global = fmstruct%ncol_global
463 9198552 : IF (PRESENT(first_p_pos)) first_p_pos = fmstruct%first_p_pos
464 9198552 : IF (PRESENT(nrow_locals)) nrow_locals => fmstruct%nrow_locals
465 9198552 : IF (PRESENT(ncol_locals)) ncol_locals => fmstruct%ncol_locals
466 9198552 : IF (PRESENT(local_leading_dimension)) local_leading_dimension = &
467 10183 : fmstruct%local_leading_dimension
468 :
469 9198552 : IF (PRESENT(nrow_local)) nrow_local = fmstruct%nrow_locals(fmstruct%context%mepos(1))
470 9198552 : IF (PRESENT(ncol_local)) ncol_local = fmstruct%ncol_locals(fmstruct%context%mepos(2))
471 :
472 9198552 : IF (PRESENT(row_indices)) row_indices => fmstruct%row_indices
473 9198552 : IF (PRESENT(col_indices)) col_indices => fmstruct%col_indices
474 9198552 : END SUBROUTINE cp_fm_struct_get
475 :
476 : ! **************************************************************************************************
477 : !> \brief Write nicely formatted info about the FM struct to the given I/O unit
478 : !> \param fmstruct a cp_fm_struct_type instance
479 : !> \param io_unit the I/O unit to use for writing
480 : ! **************************************************************************************************
481 3 : SUBROUTINE cp_fm_struct_write_info(fmstruct, io_unit)
482 : TYPE(cp_fm_struct_type), INTENT(IN) :: fmstruct
483 : INTEGER, INTENT(IN) :: io_unit
484 :
485 : INTEGER, PARAMETER :: oblock_size = 8
486 :
487 : CHARACTER(len=30) :: fm
488 : INTEGER :: oblock
489 :
490 3 : WRITE (fm, "(A,I2,A)") "(A,I5,A,I5,A,", oblock_size, "I6)"
491 :
492 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of matrix columns: ", fmstruct%ncol_global
493 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of matrix rows: ", fmstruct%nrow_global
494 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of block columns: ", fmstruct%ncol_block
495 3 : WRITE (io_unit, '(A,I12)') "CP_FM_STRUCT | No. of block rows: ", fmstruct%nrow_block
496 :
497 3 : WRITE (io_unit, '(A)') "CP_FM_STRUCT | Number of local columns: "
498 6 : DO oblock = 0, (SIZE(fmstruct%ncol_locals) - 1)/oblock_size
499 3 : WRITE (io_unit, fm) "CP_FM_STRUCT | CPUs ", &
500 3 : oblock*oblock_size, "..", (oblock + 1)*oblock_size - 1, ": ", &
501 9 : fmstruct%ncol_locals(oblock*oblock_size:MIN(SIZE(fmstruct%ncol_locals), (oblock + 1)*oblock_size) - 1)
502 : END DO
503 :
504 3 : WRITE (io_unit, '(A)') "CP_FM_STRUCT | Number of local rows: "
505 6 : DO oblock = 0, (SIZE(fmstruct%nrow_locals) - 1)/oblock_size
506 3 : WRITE (io_unit, fm) "CP_FM_STRUCT | CPUs ", &
507 3 : oblock*oblock_size, "..", (oblock + 1)*oblock_size - 1, ": ", &
508 9 : fmstruct%nrow_locals(oblock*oblock_size:MIN(SIZE(fmstruct%nrow_locals), (oblock + 1)*oblock_size) - 1)
509 : END DO
510 3 : END SUBROUTINE cp_fm_struct_write_info
511 :
512 : ! **************************************************************************************************
513 : !> \brief creates a struct with twice the number of blocks on each core.
514 : !> If matrix A has to be multiplied with B anc C, a
515 : !> significant speedup of pdgemm can be acchieved by joining the matrices
516 : !> in a new one with this structure (see arnoldi in rt_matrix_exp)
517 : !> \param fmstruct the struct to create
518 : !> \param struct struct of either A or B
519 : !> \param context ...
520 : !> \param col in which direction the matrix should be enlarged
521 : !> \param row in which direction the matrix should be enlarged
522 : !> \par History
523 : !> 06.2009 created [fschiff]
524 : !> \author Florian Schiffmann
525 : ! **************************************************************************************************
526 5318 : SUBROUTINE cp_fm_struct_double(fmstruct, struct, context, col, row)
527 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
528 : TYPE(cp_fm_struct_type), INTENT(INOUT) :: struct
529 : TYPE(cp_blacs_env_type), INTENT(INOUT), TARGET :: context
530 : LOGICAL, INTENT(in) :: col, row
531 :
532 : INTEGER :: n_doubled_items_in_partially_filled_block, ncol_block, ncol_global, newdim_col, &
533 : newdim_row, nfilled_blocks, nfilled_blocks_remain, nprocs_col, nprocs_row, nrow_block, &
534 : nrow_global
535 : TYPE(mp_para_env_type), POINTER :: para_env
536 :
537 : CALL cp_fm_struct_get(struct, nrow_global=nrow_global, &
538 : ncol_global=ncol_global, nrow_block=nrow_block, &
539 5318 : ncol_block=ncol_block)
540 5318 : newdim_row = nrow_global
541 5318 : newdim_col = ncol_global
542 5318 : nprocs_row = context%num_pe(1)
543 5318 : nprocs_col = context%num_pe(2)
544 5318 : para_env => struct%para_env
545 :
546 5318 : IF (col) THEN
547 5318 : IF (ncol_global == 0) THEN
548 120 : newdim_col = 0
549 : ELSE
550 : ! ncol_block nfilled_blocks_remain * ncol_block
551 : ! |<--->| |<--->|
552 : ! |-----|-----|-----|-----|---|
553 : ! | 0 | 1 | 2 | 0 | 1 | <- context%mepos(2)
554 : ! |-----|-----|-----|-----|---|
555 : ! |<--- nfilled_blocks -->|<-> -- items (columns) in partially filled blocks
556 : ! | * ncol_block |
557 5198 : n_doubled_items_in_partially_filled_block = 2*MOD(ncol_global, ncol_block)
558 5198 : nfilled_blocks = ncol_global/ncol_block
559 5198 : nfilled_blocks_remain = MOD(nfilled_blocks, nprocs_col)
560 5198 : newdim_col = 2*(nfilled_blocks/nprocs_col)
561 5198 : IF (n_doubled_items_in_partially_filled_block > ncol_block) THEN
562 : ! doubled number of columns in a partially filled block does not fit into a single block.
563 : ! Due to cyclic distribution of ScaLAPACK blocks, an extra block for each core needs to be added
564 : ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---|
565 : ! | 0 | 1 | 2 | 0 | --> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0|
566 : ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---|
567 : ! a a a b a1 a1 a1 a2 a2 a2 b1 empty empty b2
568 0 : newdim_col = newdim_col + 1
569 :
570 : ! the number of columns which does not fit into the added extra block
571 0 : n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - ncol_block
572 5198 : ELSE IF (nfilled_blocks_remain > 0) THEN
573 : ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
574 : ! | 0 | 1 | 2 | 0 | 1| -> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0 |
575 : ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
576 : ! a a a b b a1 a1 a1 a2 a2 a2 b1 b1 b2 empty b2
577 0 : newdim_col = newdim_col + 1
578 0 : n_doubled_items_in_partially_filled_block = 0
579 : END IF
580 :
581 5198 : newdim_col = (newdim_col*nprocs_col + nfilled_blocks_remain)*ncol_block + n_doubled_items_in_partially_filled_block
582 : END IF
583 : END IF
584 :
585 5318 : IF (row) THEN
586 0 : IF (nrow_global == 0) THEN
587 0 : newdim_row = 0
588 : ELSE
589 0 : n_doubled_items_in_partially_filled_block = 2*MOD(nrow_global, nrow_block)
590 0 : nfilled_blocks = nrow_global/nrow_block
591 0 : nfilled_blocks_remain = MOD(nfilled_blocks, nprocs_row)
592 0 : newdim_row = 2*(nfilled_blocks/nprocs_row)
593 0 : IF (n_doubled_items_in_partially_filled_block > nrow_block) THEN
594 0 : newdim_row = newdim_row + 1
595 0 : n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - nrow_block
596 0 : ELSE IF (nfilled_blocks_remain > 0) THEN
597 0 : newdim_row = newdim_row + 1
598 0 : n_doubled_items_in_partially_filled_block = 0
599 : END IF
600 :
601 0 : newdim_row = (newdim_row*nprocs_row + nfilled_blocks_remain)*nrow_block + n_doubled_items_in_partially_filled_block
602 : END IF
603 : END IF
604 :
605 : ! square_blocks=.FALSE. ensures that matrix blocks of the doubled matrix will have
606 : ! nrow_block x ncol_block shape even in case of a square doubled matrix
607 : CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
608 : context=context, &
609 : nrow_global=newdim_row, &
610 : ncol_global=newdim_col, &
611 : ncol_block=ncol_block, &
612 : nrow_block=nrow_block, &
613 5318 : square_blocks=.FALSE.)
614 :
615 5318 : END SUBROUTINE cp_fm_struct_double
616 : ! **************************************************************************************************
617 : !> \brief allows to modify the default settings for matrix creation
618 : !> \param nrow_block ...
619 : !> \param ncol_block ...
620 : !> \param force_block ...
621 : ! **************************************************************************************************
622 11087 : SUBROUTINE cp_fm_struct_config(nrow_block, ncol_block, force_block)
623 : INTEGER, INTENT(IN), OPTIONAL :: nrow_block, ncol_block
624 : LOGICAL, INTENT(IN), OPTIONAL :: force_block
625 :
626 : INTEGER :: vlen
627 :
628 11087 : vlen = m_cpuid_vlen()
629 11087 : IF (PRESENT(ncol_block)) THEN
630 11087 : IF (0 < ncol_block) THEN
631 11087 : optimal_blacs_col_block_size = (ncol_block + vlen - 1)/vlen*vlen
632 : END IF
633 : END IF
634 11087 : IF (PRESENT(nrow_block)) THEN
635 11087 : IF (0 < nrow_block) THEN
636 11087 : optimal_blacs_row_block_size = (nrow_block + vlen - 1)/vlen*vlen
637 : END IF
638 : END IF
639 11087 : IF (PRESENT(force_block)) force_block_size = force_block
640 :
641 11087 : END SUBROUTINE cp_fm_struct_config
642 :
643 : ! **************************************************************************************************
644 : !> \brief ...
645 : !> \return ...
646 : ! **************************************************************************************************
647 32440 : FUNCTION cp_fm_struct_get_nrow_block() RESULT(res)
648 : INTEGER :: res
649 :
650 32440 : res = optimal_blacs_row_block_size
651 32440 : END FUNCTION cp_fm_struct_get_nrow_block
652 :
653 : ! **************************************************************************************************
654 : !> \brief ...
655 : !> \return ...
656 : ! **************************************************************************************************
657 32440 : FUNCTION cp_fm_struct_get_ncol_block() RESULT(res)
658 : INTEGER :: res
659 :
660 32440 : res = optimal_blacs_col_block_size
661 32440 : END FUNCTION cp_fm_struct_get_ncol_block
662 :
663 : ! **************************************************************************************************
664 : !> \brief wrapper to scalapack function INDXG2P that computes the row process
665 : !> coordinate which possesses the entry of a distributed matrix specified
666 : !> by a global index INDXGLOB.
667 : !> \param struct ...
668 : !> \param INDXGLOB ...
669 : !> \return ...
670 : !> \author Mauro Del Ben [MDB] - 12.2012, modified by F. Stein
671 : ! **************************************************************************************************
672 13294639 : FUNCTION cp_fm_indxg2p_row(struct, INDXGLOB) RESULT(G2P)
673 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
674 : INTEGER, INTENT(IN) :: INDXGLOB
675 : INTEGER :: G2P
676 :
677 : #if defined(__parallel)
678 : INTEGER :: number_of_process_rows
679 : INTEGER, EXTERNAL :: indxg2p
680 : #endif
681 :
682 : #if defined(__parallel)
683 :
684 13294639 : CALL struct%context%get(number_of_process_rows=number_of_process_rows)
685 :
686 13294639 : G2P = indxg2p(INDXGLOB, struct%nrow_block, 0, struct%first_p_pos(1), number_of_process_rows)
687 :
688 : #else
689 : MARK_USED(struct)
690 : MARK_USED(indxglob)
691 :
692 : G2P = 0
693 :
694 : #endif
695 :
696 13294639 : END FUNCTION cp_fm_indxg2p_row
697 :
698 : ! **************************************************************************************************
699 : !> \brief wrapper to scalapack function INDXG2P that computes the col process
700 : !> coordinate which possesses the entry of a distributed matrix specified
701 : !> by a global index INDXGLOB.
702 : !> \param struct ...
703 : !> \param INDXGLOB ...
704 : !> \return ...
705 : !> \author Mauro Del Ben [MDB] - 12.2012, modified by F. Stein
706 : ! **************************************************************************************************
707 6864273 : FUNCTION cp_fm_indxg2p_col(struct, INDXGLOB) RESULT(G2P)
708 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
709 : INTEGER, INTENT(IN) :: INDXGLOB
710 : INTEGER :: G2P
711 :
712 : #if defined(__parallel)
713 : INTEGER :: number_of_process_columns
714 : INTEGER, EXTERNAL :: indxg2p
715 : #endif
716 :
717 : #if defined(__parallel)
718 :
719 6864273 : CALL struct%context%get(number_of_process_columns=number_of_process_columns)
720 :
721 6864273 : G2P = indxg2p(INDXGLOB, struct%ncol_block, 0, struct%first_p_pos(2), number_of_process_columns)
722 :
723 : #else
724 : MARK_USED(struct)
725 : MARK_USED(indxglob)
726 :
727 : G2P = 0
728 :
729 : #endif
730 :
731 6864273 : END FUNCTION cp_fm_indxg2p_col
732 :
733 : ! **************************************************************************************************
734 : !> \brief wrapper to scalapack function INDXG2L that computes the local index
735 : !> of a distributed matrix entry pointed to by the global index INDXGLOB.
736 : !>
737 : !> Arguments
738 : !> =========
739 : !>
740 : !> INDXGLOB (global input) INTEGER
741 : !> The global index of the distributed matrix entry.
742 : !>
743 : !> NB (global input) INTEGER
744 : !> Block size, size of the blocks the distributed matrix is
745 : !> split into.
746 : !>
747 : !> IPROC (local dummy) INTEGER
748 : !> Dummy argument in this case in order to unify the calling
749 : !> sequence of the tool-routines.
750 : !>
751 : !> ISRCPROC (local dummy) INTEGER
752 : !> Dummy argument in this case in order to unify the calling
753 : !> sequence of the tool-routines.
754 : !>
755 : !> NPROCS (global input) INTEGER
756 : !> The total number processes over which the distributed
757 : !> matrix is distributed.
758 : !>
759 : !> \param struct ...
760 : !> \param INDXGLOB ...
761 : !> \return ...
762 : !> \author Mauro Del Ben [MDB] - 12.2012
763 : ! **************************************************************************************************
764 2595788 : FUNCTION cp_fm_indxg2l_row(struct, INDXGLOB) RESULT(G2L)
765 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
766 : INTEGER, INTENT(IN) :: INDXGLOB
767 : INTEGER :: G2L
768 :
769 : #if defined(__parallel)
770 : INTEGER :: number_of_process_rows
771 : INTEGER, EXTERNAL :: indxg2l
772 : #endif
773 :
774 : #if defined(__parallel)
775 :
776 2595788 : CALL struct%context%get(number_of_process_rows=number_of_process_rows)
777 :
778 2595788 : G2L = indxg2l(INDXGLOB, struct%nrow_block, 0, struct%first_p_pos(1), number_of_process_rows)
779 :
780 : #else
781 : MARK_USED(struct)
782 :
783 : G2L = INDXGLOB
784 :
785 : #endif
786 :
787 2595788 : END FUNCTION cp_fm_indxg2l_row
788 :
789 : ! **************************************************************************************************
790 : !> \brief wrapper to scalapack function INDXG2L that computes the local index
791 : !> of a distributed matrix entry pointed to by the global index INDXGLOB.
792 : !>
793 : !> Arguments
794 : !> =========
795 : !>
796 : !> INDXGLOB (global input) INTEGER
797 : !> The global index of the distributed matrix entry.
798 : !>
799 : !> NB (global input) INTEGER
800 : !> Block size, size of the blocks the distributed matrix is
801 : !> split into.
802 : !>
803 : !> IPROC (local dummy) INTEGER
804 : !> Dummy argument in this case in order to unify the calling
805 : !> sequence of the tool-routines.
806 : !>
807 : !> ISRCPROC (local dummy) INTEGER
808 : !> Dummy argument in this case in order to unify the calling
809 : !> sequence of the tool-routines.
810 : !>
811 : !> NPROCS (global input) INTEGER
812 : !> The total number processes over which the distributed
813 : !> matrix is distributed.
814 : !>
815 : !> \param struct ...
816 : !> \param INDXGLOB ...
817 : !> \return ...
818 : !> \author Mauro Del Ben [MDB] - 12.2012
819 : ! **************************************************************************************************
820 493681 : FUNCTION cp_fm_indxg2l_col(struct, INDXGLOB) RESULT(G2L)
821 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
822 : INTEGER, INTENT(IN) :: INDXGLOB
823 : INTEGER :: G2L
824 :
825 : #if defined(__parallel)
826 : INTEGER :: number_of_process_columns
827 : INTEGER, EXTERNAL :: indxg2l
828 : #endif
829 :
830 : #if defined(__parallel)
831 :
832 493681 : CALL struct%context%get(number_of_process_columns=number_of_process_columns)
833 :
834 493681 : G2L = indxg2l(INDXGLOB, struct%ncol_block, 0, struct%first_p_pos(2), number_of_process_columns)
835 :
836 : #else
837 : MARK_USED(struct)
838 :
839 : G2L = INDXGLOB
840 :
841 : #endif
842 :
843 493681 : END FUNCTION cp_fm_indxg2l_col
844 :
845 : ! **************************************************************************************************
846 : !> \brief wrapper to scalapack function INDXL2G that computes the global index
847 : !> of a distributed matrix entry pointed to by the local index INDXLOC
848 : !> of the process indicated by IPROC.
849 : !>
850 : !> Arguments
851 : !> =========
852 : !>
853 : !> INDXLOC (global input) INTEGER
854 : !> The local index of the distributed matrix entry.
855 : !>
856 : !> NB (global input) INTEGER
857 : !> Block size, size of the blocks the distributed matrix is
858 : !> split into.
859 : !>
860 : !> IPROC (local input) INTEGER
861 : !> The coordinate of the process whose local array row or
862 : !> column is to be determined.
863 : !>
864 : !> ISRCPROC (global input) INTEGER
865 : !> The coordinate of the process that possesses the first
866 : !> row/column of the distributed matrix.
867 : !>
868 : !> NPROCS (global input) INTEGER
869 : !> The total number processes over which the distributed
870 : !> matrix is distributed.
871 : !>
872 : !> \param struct ...
873 : !> \param INDXLOC ...
874 : !> \param IPROC ...
875 : !> \return ...
876 : !> \author Mauro Del Ben [MDB] - 12.2012
877 : ! **************************************************************************************************
878 7101812 : FUNCTION cp_fm_indxl2g_row(struct, INDXLOC, IPROC) RESULT(L2G)
879 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
880 : INTEGER, INTENT(IN) :: INDXLOC, IPROC
881 : INTEGER :: L2G
882 :
883 : #if defined(__parallel)
884 : INTEGER :: number_of_process_rows
885 : INTEGER, EXTERNAL :: indxl2g
886 :
887 7101812 : CALL struct%context%get(number_of_process_rows=number_of_process_rows)
888 :
889 7101812 : L2G = indxl2g(INDXLOC, struct%nrow_block, IPROC, struct%first_p_pos(1), number_of_process_rows)
890 :
891 : #else
892 : MARK_USED(struct)
893 : MARK_USED(indxloc)
894 : MARK_USED(iproc)
895 :
896 : L2G = INDXLOC
897 :
898 : #endif
899 :
900 7101812 : END FUNCTION cp_fm_indxl2g_row
901 :
902 : ! **************************************************************************************************
903 : !> \brief wrapper to scalapack function INDXL2G that computes the global index
904 : !> of a distributed matrix entry pointed to by the local index INDXLOC
905 : !> of the process indicated by IPROC.
906 : !>
907 : !> Arguments
908 : !> =========
909 : !>
910 : !> INDXLOC (global input) INTEGER
911 : !> The local index of the distributed matrix entry.
912 : !>
913 : !> NB (global input) INTEGER
914 : !> Block size, size of the blocks the distributed matrix is
915 : !> split into.
916 : !>
917 : !> IPROC (local input) INTEGER
918 : !> The coordinate of the process whose local array row or
919 : !> column is to be determined.
920 : !>
921 : !> ISRCPROC (global input) INTEGER
922 : !> The coordinate of the process that possesses the first
923 : !> row/column of the distributed matrix.
924 : !>
925 : !> NPROCS (global input) INTEGER
926 : !> The total number processes over which the distributed
927 : !> matrix is distributed.
928 : !>
929 : !> \param struct ...
930 : !> \param INDXLOC ...
931 : !> \param IPROC ...
932 : !> \return ...
933 : !> \author Mauro Del Ben [MDB] - 12.2012
934 : ! **************************************************************************************************
935 7940713 : FUNCTION cp_fm_indxl2g_col(struct, INDXLOC, IPROC) RESULT(L2G)
936 : CLASS(cp_fm_struct_type), INTENT(IN) :: struct
937 : INTEGER, INTENT(IN) :: INDXLOC, IPROC
938 : INTEGER :: L2G
939 :
940 : #if defined(__parallel)
941 : INTEGER :: number_of_process_columns
942 : INTEGER, EXTERNAL :: indxl2g
943 :
944 7940713 : CALL struct%context%get(number_of_process_columns=number_of_process_columns)
945 :
946 7940713 : L2G = indxl2g(INDXLOC, struct%ncol_block, IPROC, struct%first_p_pos(2), number_of_process_columns)
947 :
948 : #else
949 : MARK_USED(struct)
950 : MARK_USED(indxloc)
951 : MARK_USED(iproc)
952 :
953 : L2G = INDXLOC
954 :
955 : #endif
956 :
957 7940713 : END FUNCTION cp_fm_indxl2g_col
958 :
959 0 : END MODULE cp_fm_struct
|
