1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief methods related to the blacs parallel environment
8!> \par History
9!>      08.2002 created [fawzi]
10!>      02.2004 modified to associate a blacs_env with a given para_env
11!> \author Fawzi Mohamed
12! **************************************************************************************************
13MODULE cp_blacs_env
14   USE cp_array_utils,                  ONLY: cp_2d_i_write
15   USE cp_blacs_calls,                  ONLY: cp_blacs_gridexit,&
16                                              cp_blacs_gridinfo,&
17                                              cp_blacs_gridinit,&
18                                              cp_blacs_set
19   USE cp_para_env,                     ONLY: cp_para_env_release,&
20                                              cp_para_env_retain
21   USE cp_para_types,                   ONLY: cp_para_env_type
22   USE kinds,                           ONLY: dp
23   USE machine,                         ONLY: m_flush
24   USE mathlib,                         ONLY: gcd
25   USE message_passing,                 ONLY: mp_sum
26#include "../base/base_uses.f90"
27
28   IMPLICIT NONE
29   PRIVATE
30
31   LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
32   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_blacs_env'
33
34   ! Blacs type of distribution
35   INTEGER, PARAMETER, PUBLIC               :: BLACS_GRID_SQUARE = 1, &
36                                               BLACS_GRID_ROW = 2, &
37                                               BLACS_GRID_COL = 3
38
39   PUBLIC :: cp_blacs_env_type ! make it accessible only through cp_para_types?
40   PUBLIC :: cp_blacs_env_create, cp_blacs_env_retain, cp_blacs_env_release
41   PUBLIC :: cp_blacs_env_write, get_blacs_info
42
43! **************************************************************************************************
44!> \brief represent a blacs multidimensional parallel environment
45!>      (for the mpi corrispective see cp_paratypes/cp_para_cart_type)
46!> \param mepos the position of the actual processor (2D)
47!> \param group id of the actual group (context, communicator)
48!> \param num_pe number of processors in the group in each dimension
49!> \param ref_count the reference count, when it is zero this object gets
50!>        deallocated
51!> \param my_pid process id of the actual processor
52!> \param n_pid number of process ids
53!> \param the para_env associated (and compatible) with this blacs_env
54!> \param blacs2mpi: maps mepos(1)-mepos(2) of blacs to its mpi rank
55!> \param mpi2blacs(i,rank): maps the mpi rank to the mepos(i)
56!> \par History
57!>      08.2002 created [fawzi]
58!> \author Fawzi Mohamed
59! **************************************************************************************************
60   TYPE cp_blacs_env_type
61      INTEGER, DIMENSION(2) :: mepos, num_pe
62      INTEGER :: group, my_pid, n_pid, ref_count
63      TYPE(cp_para_env_type), POINTER :: para_env
64      INTEGER, DIMENSION(:, :), POINTER :: blacs2mpi
65      INTEGER, DIMENSION(:, :), POINTER :: mpi2blacs
66      LOGICAL :: repeatable
67   END TYPE cp_blacs_env_type
68
69!***
70CONTAINS
71
72! **************************************************************************************************
73!> \brief   Return informations about the specified BLACS context.
74!> \param blacs_env ...
75!> \param my_process_row ...
76!> \param my_process_column ...
77!> \param my_process_number ...
78!> \param number_of_process_rows ...
79!> \param number_of_process_columns ...
80!> \param number_of_processes ...
81!> \param para_env ...
82!> \param blacs2mpi ...
83!> \param mpi2blacs ...
84!> \date    19.06.2001
85!> \par     History
86!>          MM.YYYY moved here from qs_blacs (Joost VandeVondele)
87!> \author  Matthias Krack
88!> \version 1.0
89! **************************************************************************************************
90   SUBROUTINE get_blacs_info(blacs_env, my_process_row, my_process_column, &
91                             my_process_number, number_of_process_rows, &
92                             number_of_process_columns, number_of_processes, &
93                             para_env, blacs2mpi, mpi2blacs)
94      TYPE(cp_blacs_env_type), POINTER                   :: blacs_env
95      INTEGER, INTENT(OUT), OPTIONAL :: my_process_row, my_process_column, my_process_number, &
96         number_of_process_rows, number_of_process_columns, number_of_processes
97      TYPE(cp_para_env_type), OPTIONAL, POINTER          :: para_env
98      INTEGER, DIMENSION(:, :), OPTIONAL, POINTER        :: blacs2mpi, mpi2blacs
99
100      CHARACTER(len=*), PARAMETER :: routineN = 'get_blacs_info', routineP = moduleN//':'//routineN
101
102      IF (.NOT. ASSOCIATED(blacs_env)) THEN
103         CPABORT("No BLACS environment")
104      END IF
105
106      IF (PRESENT(my_process_row)) my_process_row = blacs_env%mepos(1)
107      IF (PRESENT(my_process_column)) my_process_column = blacs_env%mepos(2)
108      IF (PRESENT(my_process_number)) my_process_number = blacs_env%my_pid
109      IF (PRESENT(number_of_process_rows)) number_of_process_rows = blacs_env%num_pe(1)
110      IF (PRESENT(number_of_process_columns)) number_of_process_columns = blacs_env%num_pe(2)
111      IF (PRESENT(number_of_processes)) number_of_processes = blacs_env%n_pid
112      IF (PRESENT(para_env)) para_env => blacs_env%para_env
113      IF (PRESENT(blacs2mpi)) blacs2mpi => blacs_env%blacs2mpi
114      IF (PRESENT(mpi2blacs)) mpi2blacs => blacs_env%mpi2blacs
115
116   END SUBROUTINE get_blacs_info
117
118! **************************************************************************************************
119!> \brief allocates and initializes a type that represent a blacs context
120!> \param blacs_env the type to initialize
121!> \param para_env the para_env for which a blacs env should be created
122!> \param blacs_grid_layout ...
123!> \param blacs_repeatable ...
124!> \param row_major ...
125!> \param grid_2d ...
126!> \par History
127!>      08.2002 created [fawzi]
128!> \author Fawzi Mohamed
129! **************************************************************************************************
130   SUBROUTINE cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
131      TYPE(cp_blacs_env_type), POINTER         :: blacs_env
132      TYPE(cp_para_env_type), POINTER          :: para_env
133      INTEGER, INTENT(IN), OPTIONAL            :: blacs_grid_layout
134      LOGICAL, INTENT(IN), OPTIONAL            :: blacs_repeatable, row_major
135      INTEGER, DIMENSION(:), INTENT(IN), &
136         OPTIONAL                               :: grid_2d
137
138      CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_create', &
139                                     routineP = moduleN//':'//routineN
140
141      INTEGER                                  :: ipcol, iprow, stat
142#if defined(__parallel)
143      INTEGER                                  :: gcd_max, ipe, jpe, &
144                                                  my_blacs_grid_layout, &
145                                                  npcol, npe, nprow
146      LOGICAL                                  :: my_blacs_repeatable, &
147                                                  my_row_major
148#endif
149
150#ifdef __parallel
151#ifndef __SCALAPACK
152      CALL cp_abort(__LOCATION__, &
153                    "to USE the blacs environment "// &
154                    "you need the blacs/scalapack library : recompile with -D__SCALAPACK (and link scalapack and blacs) ")
155#endif
156#endif
157
158      CPASSERT(.NOT. ASSOCIATED(blacs_env))
159
160      ALLOCATE (blacs_env)
161      blacs_env%group = 0
162      blacs_env%ref_count = 1
163      blacs_env%mepos(:) = 0
164      blacs_env%num_pe(:) = 1
165      blacs_env%my_pid = 0
166      blacs_env%n_pid = 1
167      CALL cp_para_env_retain(para_env)
168      blacs_env%para_env => para_env
169
170#ifdef __SCALAPACK
171      ! get the number of cpus for this blacs grid
172      blacs_env%my_pid = para_env%mepos
173      blacs_env%n_pid = para_env%num_pe
174      nprow = 1
175      npcol = 1
176      npe = blacs_env%n_pid
177      ! get the layout of this grid
178
179      IF (PRESENT(grid_2d)) THEN
180         nprow = grid_2d(1)
181         npcol = grid_2d(2)
182      ENDIF
183
184      IF (nprow*npcol .NE. npe) THEN
185         ! hard code for the time being the grid layout
186         my_blacs_grid_layout = BLACS_GRID_SQUARE
187         IF (PRESENT(blacs_grid_layout)) my_blacs_grid_layout = blacs_grid_layout
188         ! XXXXXX
189         SELECT CASE (my_blacs_grid_layout)
190         CASE (BLACS_GRID_SQUARE)
191            ! make the grid as 'square' as possible, where square is defined as nprow and npcol
192            ! having the largest possible gcd
193            gcd_max = -1
194            DO ipe = 1, CEILING(SQRT(REAL(npe, dp)))
195               jpe = npe/ipe
196               IF (ipe*jpe .NE. npe) CYCLE
197               IF (gcd(ipe, jpe) >= gcd_max) THEN
198                  nprow = ipe
199                  npcol = jpe
200                  gcd_max = gcd(ipe, jpe)
201               ENDIF
202            ENDDO
203         CASE (BLACS_GRID_ROW)
204            nprow = 1
205            npcol = npe
206         CASE (BLACS_GRID_COL)
207            nprow = npe
208            npcol = 1
209         END SELECT
210      ENDIF
211
212      ! blacs_env%group will be set to the blacs context for this blacs env, this is not the same as the MPI context
213      blacs_env%group = para_env%group
214      my_row_major = .TRUE.
215      IF (PRESENT(row_major)) my_row_major = row_major
216      IF (my_row_major) THEN
217         CALL cp_blacs_gridinit(blacs_env%group, "Row-major", nprow, npcol)
218      ELSE
219         CALL cp_blacs_gridinit(blacs_env%group, "Col-major", nprow, npcol)
220      ENDIF
221
222      my_blacs_repeatable = .FALSE.
223      IF (PRESENT(blacs_repeatable)) my_blacs_repeatable = blacs_repeatable
224      blacs_env%repeatable = my_blacs_repeatable
225      IF (blacs_env%repeatable) CALL cp_blacs_set(blacs_env%group, 15, 1)
226
227      ! fill in the info one needs
228      CALL cp_blacs_gridinfo(blacs_env%group, blacs_env%num_pe(1), &
229                             blacs_env%num_pe(2), blacs_env%mepos(1), blacs_env%mepos(2))
230
231#else
232      MARK_USED(blacs_grid_layout)
233      MARK_USED(blacs_repeatable)
234      MARK_USED(grid_2d)
235      MARK_USED(row_major)
236#endif
237
238      ! generate the mappings blacs2mpi and mpi2blacs
239      ALLOCATE (blacs_env%blacs2mpi(0:blacs_env%num_pe(1) - 1, 0:blacs_env%num_pe(2) - 1), &
240                stat=stat)
241      CPASSERT(stat == 0)
242      blacs_env%blacs2mpi = 0
243      blacs_env%blacs2mpi(blacs_env%mepos(1), blacs_env%mepos(2)) = para_env%mepos
244      CALL mp_sum(blacs_env%blacs2mpi, para_env%group)
245      ALLOCATE (blacs_env%mpi2blacs(2, 0:para_env%num_pe - 1))
246      blacs_env%mpi2blacs = -1
247      DO ipcol = 0, blacs_env%num_pe(2) - 1
248         DO iprow = 0, blacs_env%num_pe(1) - 1
249            blacs_env%mpi2blacs(1, blacs_env%blacs2mpi(iprow, ipcol)) = iprow
250            blacs_env%mpi2blacs(2, blacs_env%blacs2mpi(iprow, ipcol)) = ipcol
251         END DO
252      END DO
253   END SUBROUTINE cp_blacs_env_create
254
255! **************************************************************************************************
256!> \brief retains the given blacs env
257!> \param blacs_env the blacs env to retain
258!> \par History
259!>      08.2002 created [fawzi]
260!> \author Fawzi Mohamed
261! **************************************************************************************************
262   SUBROUTINE cp_blacs_env_retain(blacs_env)
263      TYPE(cp_blacs_env_type), POINTER                   :: blacs_env
264
265      CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_retain', &
266         routineP = moduleN//':'//routineN
267
268      CPASSERT(ASSOCIATED(blacs_env))
269      CPASSERT(blacs_env%ref_count > 0)
270      blacs_env%ref_count = blacs_env%ref_count + 1
271   END SUBROUTINE cp_blacs_env_retain
272
273! **************************************************************************************************
274!> \brief releases the given blacs_env
275!> \param blacs_env the blacs env to release
276!> \par History
277!>      08.2002 created [fawzi]
278!> \author Fawzi Mohamed
279! **************************************************************************************************
280   SUBROUTINE cp_blacs_env_release(blacs_env)
281      TYPE(cp_blacs_env_type), POINTER                   :: blacs_env
282
283      CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_release', &
284         routineP = moduleN//':'//routineN
285
286      IF (ASSOCIATED(blacs_env)) THEN
287         CPASSERT(blacs_env%ref_count > 0)
288         blacs_env%ref_count = blacs_env%ref_count - 1
289         IF (blacs_env%ref_count < 1) THEN
290            CALL cp_blacs_gridexit(blacs_env%group)
291            CALL cp_para_env_release(blacs_env%para_env)
292            DEALLOCATE (blacs_env%mpi2blacs)
293            DEALLOCATE (blacs_env%blacs2mpi)
294            DEALLOCATE (blacs_env)
295         END IF
296      END IF
297      NULLIFY (blacs_env)
298   END SUBROUTINE cp_blacs_env_release
299
300! **************************************************************************************************
301!> \brief writes the description of the given blacs env
302!> \param blacs_env the blacs environment to write
303!> \param unit_nr the unit number where to write the description of the
304!>        blacs environment
305!> \par History
306!>      08.2002 created [fawzi]
307!> \author Fawzi Mohamed
308! **************************************************************************************************
309   SUBROUTINE cp_blacs_env_write(blacs_env, unit_nr)
310      TYPE(cp_blacs_env_type), POINTER                   :: blacs_env
311      INTEGER, INTENT(in)                                :: unit_nr
312
313      CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_write', &
314         routineP = moduleN//':'//routineN
315
316      INTEGER                                            :: iostat
317
318      IF (ASSOCIATED(blacs_env)) THEN
319         WRITE (unit=unit_nr, fmt="('  group=',i10,', ref_count=',i10,',')", &
320                iostat=iostat) blacs_env%group, blacs_env%ref_count
321         CPASSERT(iostat == 0)
322         WRITE (unit=unit_nr, fmt="('  mepos=(',i8,',',i8,'),')", &
323                iostat=iostat) blacs_env%mepos(1), blacs_env%mepos(2)
324         CPASSERT(iostat == 0)
325         WRITE (unit=unit_nr, fmt="('  num_pe=(',i8,',',i8,'),')", &
326                iostat=iostat) blacs_env%num_pe(1), blacs_env%num_pe(2)
327         CPASSERT(iostat == 0)
328         IF (ASSOCIATED(blacs_env%blacs2mpi)) THEN
329            WRITE (unit=unit_nr, fmt="('  blacs2mpi=')", advance="no", iostat=iostat)
330            CPASSERT(iostat == 0)
331            CALL cp_2d_i_write(blacs_env%blacs2mpi, unit_nr=unit_nr)
332         ELSE
333            WRITE (unit=unit_nr, fmt="('  blacs2mpi=*null*')", iostat=iostat)
334            CPASSERT(iostat == 0)
335         END IF
336         IF (ASSOCIATED(blacs_env%para_env)) THEN
337            WRITE (unit=unit_nr, fmt="('  para_env=<cp_para_env id=',i6,'>,')") &
338               blacs_env%para_env%group
339         ELSE
340            WRITE (unit=unit_nr, fmt="('  para_env=*null*')")
341         END IF
342         WRITE (unit=unit_nr, fmt="('  my_pid=',i10,', n_pid=',i10,' }')", &
343                iostat=iostat) blacs_env%my_pid, blacs_env%n_pid
344         CPASSERT(iostat == 0)
345      ELSE
346         WRITE (unit=unit_nr, &
347                fmt="(a)", iostat=iostat) ' <cp_blacs_env>:*null* '
348         CPASSERT(iostat == 0)
349      END IF
350      CALL m_flush(unit_nr)
351   END SUBROUTINE cp_blacs_env_write
352
353END MODULE cp_blacs_env
354