23 #include "../base/base_uses.f90"
28 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
29 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'cp_blacs_env'
36 PUBLIC :: cp_blacs_env_type
53 TYPE,
EXTENDS(cp_blacs_type) :: cp_blacs_env_type
54 INTEGER :: my_pid = -1, n_pid = -1, ref_count = -1
55 TYPE(mp_para_env_type),
POINTER :: para_env => null()
56 INTEGER,
DIMENSION(:, :),
POINTER :: blacs2mpi => null()
57 INTEGER,
DIMENSION(:, :),
POINTER :: mpi2blacs => null()
58 LOGICAL :: repeatable = .false.
60 PROCEDURE,
PUBLIC, pass, non_overridable :: create => cp_blacs_env_create_low
61 PROCEDURE,
PUBLIC, pass, non_overridable :: retain => cp_blacs_env_retain
62 PROCEDURE,
PUBLIC, pass, non_overridable :: release => cp_blacs_env_release_low
63 PROCEDURE,
PUBLIC, pass, non_overridable :: get => get_blacs_info
64 PROCEDURE,
PUBLIC, pass, non_overridable :: write => cp_blacs_env_write
65 END TYPE cp_blacs_env_type
88 SUBROUTINE get_blacs_info(blacs_env, my_process_row, my_process_column, &
89 my_process_number, number_of_process_rows, &
90 number_of_process_columns, number_of_processes, &
91 para_env, blacs2mpi, mpi2blacs)
92 CLASS(cp_blacs_env_type),
INTENT(IN) :: blacs_env
93 INTEGER,
INTENT(OUT),
OPTIONAL :: my_process_row, my_process_column, my_process_number, &
94 number_of_process_rows, number_of_process_columns, number_of_processes
95 TYPE(mp_para_env_type),
OPTIONAL,
POINTER :: para_env
96 INTEGER,
DIMENSION(:, :),
OPTIONAL,
POINTER :: blacs2mpi, mpi2blacs
98 IF (
PRESENT(my_process_row)) my_process_row = blacs_env%mepos(1)
99 IF (
PRESENT(my_process_column)) my_process_column = blacs_env%mepos(2)
100 IF (
PRESENT(my_process_number)) my_process_number = blacs_env%my_pid
101 IF (
PRESENT(number_of_process_rows)) number_of_process_rows = blacs_env%num_pe(1)
102 IF (
PRESENT(number_of_process_columns)) number_of_process_columns = blacs_env%num_pe(2)
103 IF (
PRESENT(number_of_processes)) number_of_processes = blacs_env%n_pid
104 IF (
PRESENT(para_env)) para_env => blacs_env%para_env
105 IF (
PRESENT(blacs2mpi)) blacs2mpi => blacs_env%blacs2mpi
106 IF (
PRESENT(mpi2blacs)) mpi2blacs => blacs_env%mpi2blacs
108 END SUBROUTINE get_blacs_info
122 SUBROUTINE cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
123 TYPE(cp_blacs_env_type),
INTENT(OUT),
POINTER :: blacs_env
124 TYPE(mp_para_env_type),
INTENT(INOUT),
TARGET :: para_env
125 INTEGER,
INTENT(IN),
OPTIONAL :: blacs_grid_layout
126 LOGICAL,
INTENT(IN),
OPTIONAL :: blacs_repeatable, row_major
127 INTEGER,
DIMENSION(:),
INTENT(IN),
OPTIONAL :: grid_2d
130 CALL blacs_env%create(para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
146 SUBROUTINE cp_blacs_env_create_low(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
147 CLASS(cp_blacs_env_type),
INTENT(OUT) :: blacs_env
148 TYPE(mp_para_env_type),
TARGET,
INTENT(INOUT) :: para_env
149 INTEGER,
INTENT(IN),
OPTIONAL :: blacs_grid_layout
150 LOGICAL,
INTENT(IN),
OPTIONAL :: blacs_repeatable, row_major
151 INTEGER,
DIMENSION(:),
INTENT(IN), &
154 INTEGER :: ipcol, iprow
155 #if defined(__parallel)
156 INTEGER :: gcd_max, ipe, jpe, &
157 my_blacs_grid_layout, &
159 LOGICAL :: my_blacs_repeatable, &
165 CALL cp_abort(__location__, &
166 "to USE the blacs environment "// &
167 "you need the blacs/scalapack library : recompile with -D__SCALAPACK (and link scalapack and blacs) ")
175 npe = para_env%num_pe
178 IF (
PRESENT(grid_2d))
THEN
183 IF (nprow*npcol .NE. npe)
THEN
186 IF (
PRESENT(blacs_grid_layout)) my_blacs_grid_layout = blacs_grid_layout
188 SELECT CASE (my_blacs_grid_layout)
193 DO ipe = 1, ceiling(sqrt(real(npe,
dp)))
195 IF (ipe*jpe .NE. npe) cycle
196 IF (
gcd(ipe, jpe) >= gcd_max)
THEN
199 gcd_max =
gcd(ipe, jpe)
211 my_row_major = .true.
212 IF (
PRESENT(row_major)) my_row_major = row_major
213 IF (my_row_major)
THEN
214 CALL blacs_env%gridinit(para_env,
"Row-major", nprow, npcol)
216 CALL blacs_env%gridinit(para_env,
"Col-major", nprow, npcol)
220 blacs_env%my_pid = para_env%mepos
221 blacs_env%n_pid = para_env%num_pe
222 blacs_env%ref_count = 1
224 my_blacs_repeatable = .false.
225 IF (
PRESENT(blacs_repeatable)) my_blacs_repeatable = blacs_repeatable
226 blacs_env%repeatable = my_blacs_repeatable
227 IF (blacs_env%repeatable)
CALL blacs_env%set(15, 1)
231 CALL blacs_env%gridinit(para_env,
"Row-major", 1, 1)
233 blacs_env%ref_count = 1
236 mark_used(blacs_grid_layout)
237 mark_used(blacs_repeatable)
242 CALL para_env%retain()
243 blacs_env%para_env => para_env
246 ALLOCATE (blacs_env%blacs2mpi(0:blacs_env%num_pe(1) - 1, 0:blacs_env%num_pe(2) - 1))
247 blacs_env%blacs2mpi = 0
248 blacs_env%blacs2mpi(blacs_env%mepos(1), blacs_env%mepos(2)) = para_env%mepos
249 CALL para_env%sum(blacs_env%blacs2mpi)
250 ALLOCATE (blacs_env%mpi2blacs(2, 0:para_env%num_pe - 1))
251 blacs_env%mpi2blacs = -1
252 DO ipcol = 0, blacs_env%num_pe(2) - 1
253 DO iprow = 0, blacs_env%num_pe(1) - 1
254 blacs_env%mpi2blacs(1, blacs_env%blacs2mpi(iprow, ipcol)) = iprow
255 blacs_env%mpi2blacs(2, blacs_env%blacs2mpi(iprow, ipcol)) = ipcol
258 END SUBROUTINE cp_blacs_env_create_low
267 SUBROUTINE cp_blacs_env_retain(blacs_env)
268 CLASS(cp_blacs_env_type),
INTENT(INOUT) :: blacs_env
270 cpassert(blacs_env%ref_count > 0)
271 blacs_env%ref_count = blacs_env%ref_count + 1
272 END SUBROUTINE cp_blacs_env_retain
282 TYPE(cp_blacs_env_type),
POINTER :: blacs_env
284 IF (
ASSOCIATED(blacs_env))
THEN
285 cpassert(blacs_env%ref_count > 0)
286 blacs_env%ref_count = blacs_env%ref_count - 1
287 IF (blacs_env%ref_count < 1)
THEN
288 CALL blacs_env%release()
289 DEALLOCATE (blacs_env)
302 SUBROUTINE cp_blacs_env_release_low(blacs_env)
303 CLASS(cp_blacs_env_type),
INTENT(INOUT) :: blacs_env
305 CALL blacs_env%gridexit()
307 DEALLOCATE (blacs_env%mpi2blacs)
308 DEALLOCATE (blacs_env%blacs2mpi)
310 END SUBROUTINE cp_blacs_env_release_low
321 SUBROUTINE cp_blacs_env_write(blacs_env, unit_nr)
322 CLASS(cp_blacs_env_type),
INTENT(IN) :: blacs_env
323 INTEGER,
INTENT(in) :: unit_nr
325 WRITE (unit=unit_nr, fmt=
"(' group=',i10,', ref_count=',i10,',')") &
326 blacs_env%get_handle(), blacs_env%ref_count
327 WRITE (unit=unit_nr, fmt=
"(' mepos=(',i8,',',i8,'),')") &
328 blacs_env%mepos(1), blacs_env%mepos(2)
329 WRITE (unit=unit_nr, fmt=
"(' num_pe=(',i8,',',i8,'),')") &
330 blacs_env%num_pe(1), blacs_env%num_pe(2)
331 IF (
ASSOCIATED(blacs_env%blacs2mpi))
THEN
332 WRITE (unit=unit_nr, fmt=
"(' blacs2mpi=')", advance=
"no")
335 WRITE (unit=unit_nr, fmt=
"(' blacs2mpi=*null*')")
337 IF (
ASSOCIATED(blacs_env%para_env))
THEN
338 WRITE (unit=unit_nr, fmt=
"(' para_env=<cp_para_env id=',i6,'>,')") &
339 blacs_env%para_env%get_handle()
341 WRITE (unit=unit_nr, fmt=
"(' para_env=*null*')")
343 WRITE (unit=unit_nr, fmt=
"(' my_pid=',i10,', n_pid=',i10,' }')") &
344 blacs_env%my_pid, blacs_env%n_pid
346 END SUBROUTINE cp_blacs_env_write
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
subroutine, public cp_2d_i_write(array, unit_nr, el_format)
writes an array to the given unit
methods related to the blacs parallel environment
integer, parameter, public blacs_grid_row
integer, parameter, public blacs_grid_col
integer, parameter, public blacs_grid_square
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
subroutine, public cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
allocates and initializes a type that represent a blacs context
wrappers for the actual blacs calls. all functionality needed in the code should actually be provide ...
Defines the basic variable types.
integer, parameter, public dp
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Collection of simple mathematical functions and subroutines.
elemental integer function, public gcd(a, b)
computes the greatest common divisor of two number
Interface to the message passing library MPI.
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)