Line data Source code
1 : MODULE m_eig66_mpi
2 : use m_juDFT
3 : USE m_eig66_data
4 : USE m_types_mat
5 : USE m_judft
6 : #ifdef CPP_MPI
7 : USE mpi
8 : #endif
9 : IMPLICIT NONE
10 : PRIVATE
11 : PUBLIC open_eig, read_eig, write_eig, close_eig, reset_eig, priv_find_data
12 : CONTAINS
13 :
14 20462 : SUBROUTINE priv_find_data(id, d)
15 : INTEGER, INTENT(IN)::id
16 : TYPE(t_data_mpi), POINTER, ASYNCHRONOUS:: d
17 :
18 : CLASS(t_data), POINTER ::dp
19 20462 : CALL eig66_find_data(dp, id)
20 : SELECT TYPE (dp)
21 : TYPE is (t_data_mpi)
22 20462 : d => dp
23 : CLASS default
24 0 : CALL judft_error("BUG: wrong datatype in eig66_mpi")
25 : END SELECT
26 20462 : END SUBROUTINE priv_find_data
27 :
28 616 : SUBROUTINE open_eig(id, mpi_comm, nmat, neig, nkpts, jspins, create, l_real, l_soc, l_noco, l_olap, n_size_opt, filename)
29 : USE, INTRINSIC::iso_c_binding
30 : IMPLICIT NONE
31 : INTEGER, INTENT(IN) :: id, mpi_comm, nmat, neig, nkpts, jspins
32 : LOGICAL, INTENT(IN) :: l_noco, create, l_real, l_soc, l_olap
33 : INTEGER, INTENT(IN), OPTIONAL:: n_size_opt
34 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
35 : #ifdef CPP_MPI
36 : CHARACTER(len=20):: arg
37 : INTEGER:: isize, e, slot_size, local_slots
38 : INTEGER, PARAMETER::mcored = 27 !there should not be more that 27 core states
39 : TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
40 :
41 154 : CALL priv_find_data(id, d)
42 242 : CALL eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real .AND. .NOT. l_soc, l_soc)
43 :
44 154 : IF (PRESENT(n_size_opt)) d%n_size = n_size_opt
45 154 : IF (ALLOCATED(d%pe_ev)) THEN
46 0 : IF (create) CALL reset_eig(id, l_soc)
47 0 : IF (PRESENT(filename)) CALL judft_error("Storing of data not implemented for MPI case", calledby="eig66_mpi.F")
48 0 : RETURN !everything already done!
49 : ENDIF
50 :
51 154 : CALL timestart("create data spaces in ei66_mpi")
52 154 : CALL MPI_COMM_RANK(MPI_COMM, d%irank, e)
53 154 : CALL MPI_COMM_SIZE(MPI_COMM, isize, e)
54 :
55 154 : CALL create_maps(d, isize, nkpts, jspins, neig, d%n_size, nmat)
56 2628 : local_slots = COUNT(d%pe_basis == d%irank)
57 : !Now create the windows
58 :
59 : !Window for neig
60 : slot_size = 1
61 154 : CALL priv_create_memory(1, local_slots, d%neig_handle, d%neig_data)
62 1306 : d%neig_data = 0
63 :
64 : !The eigenvalues
65 154 : d%size_eig = neig
66 154 : CALL priv_create_memory(d%size_eig, local_slots, d%eig_handle, real_data_ptr=d%eig_data)
67 56666 : d%eig_data = 1E99
68 :
69 : !The eigenvectors
70 139334 : local_slots = COUNT(d%pe_ev == d%irank)
71 154 : slot_size = nmat
72 154 : IF (l_real .AND. .NOT. l_soc) THEN
73 66 : CALL priv_create_memory(slot_size, local_slots, d%zr_handle, real_data_ptr=d%zr_data)
74 : ELSE
75 88 : CALL priv_create_memory(slot_size, local_slots, d%zc_handle, cmplx_data_ptr=d%zc_data)
76 : ENDIF
77 :
78 : !The eigenvectors
79 154 : IF (l_olap) THEN
80 6320 : local_slots = COUNT(d%pe_olap == d%irank)
81 : slot_size = nmat
82 6 : IF (l_real .AND. .NOT. l_soc) THEN
83 4 : CALL priv_create_memory(slot_size, local_slots, d%olap_r_handle, real_data_ptr=d%olap_r_data)
84 : ELSE
85 2 : CALL priv_create_memory(slot_size, local_slots, d%olap_c_handle, cmplx_data_ptr=d%olap_c_data)
86 : ENDIF
87 : ENDIF
88 :
89 154 : IF (PRESENT(filename) .AND. .NOT. create) CALL judft_error("Storing of data not implemented for MPI case", calledby="eig66_mpi.F")
90 154 : CALL MPI_BARRIER(MPI_COMM, e)
91 154 : CALL timestop("create data spaces in ei66_mpi")
92 :
93 154 : IF (d%irank==0) THEN
94 77 : arg=TRIM(juDFT_string_for_argument("-eig"))
95 77 : IF (index(arg,"init")>0) CALL priv_readfromfileDA()
96 : ENDIF
97 :
98 : CONTAINS
99 468 : SUBROUTINE priv_create_memory(slot_size, local_slots, handle, int_data_ptr, real_data_ptr, cmplx_data_ptr)
100 : use m_types_mpi, only: judft_win_create
101 : IMPLICIT NONE
102 : INTEGER, INTENT(IN) :: slot_size, local_slots
103 : INTEGER, POINTER, OPTIONAL, ASYNCHRONOUS :: int_data_ptr(:)
104 : REAL, POINTER, OPTIONAL, ASYNCHRONOUS :: real_data_ptr(:)
105 : COMPLEX, POINTER, OPTIONAL, ASYNCHRONOUS :: cmplx_data_ptr(:)
106 : INTEGER, INTENT(OUT) :: handle
107 : #ifdef CPP_MPI
108 : TYPE(c_ptr)::ptr
109 : INTEGER:: e, iError
110 : INTEGER(MPI_ADDRESS_KIND) :: length
111 : INTEGER :: type_size
112 : CHARACTER(LEN=150) :: errorString
113 :
114 468 : length = 0
115 468 : IF (PRESENT(real_data_ptr)) THEN
116 224 : length = length + 1
117 224 : CALL MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION, type_size, e)
118 : ENDIF
119 468 : IF (PRESENT(cmplx_data_ptr)) THEN
120 90 : length = length + 1
121 90 : CALL MPI_TYPE_SIZE(MPI_DOUBLE_COMPLEX, type_size, e)
122 : ENDIF
123 468 : IF (PRESENT(int_data_ptr)) THEN
124 154 : length = length + 1
125 154 : CALL MPI_TYPE_SIZE(MPI_INTEGER, type_size, e)
126 : ENDIF
127 468 : IF (length .NE. 1) CALL judft_error("Bug in eig66_mpi:create_memory")
128 :
129 : ! Note: In the following lines there are two assignments to length. The reason why
130 : ! this is split up into two lines is that the product in the 2nd line otherwise
131 : ! would contain only two "normal" integers. length is an integer of a different
132 : ! kind and has a larger value range. If it would not be part of the product there
133 : ! would be integer overflows under certain workloads.
134 468 : length = local_slots
135 468 : length = MAX(1, length*slot_size)
136 :
137 468 : iError = 0
138 : #ifdef CPP_MPI_ALLOC
139 : length = length*type_size
140 : CALL MPI_ALLOC_MEM(length, MPI_INFO_NULL, ptr, e)
141 : IF (e .NE. 0) CPP_error("Could not allocated MPI-Data in eig66_mpi")
142 : #endif
143 468 : IF (PRESENT(real_data_ptr)) THEN
144 : #ifdef CPP_MPI_ALLOC
145 : CALL C_F_POINTER(ptr, real_data_ptr, (/length/type_size/))
146 : call judft_error("hmm damn")
147 : #else
148 : ! In the following allocate a too large length may lead to a segmentation fault in the allocate statement
149 : ! with before being able to return of an error code.
150 3183849 : ALLOCATE (real_data_ptr(length), source=0.0, STAT=iError)
151 : #endif
152 224 : IF (iError.EQ.0) call judft_win_create(real_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
153 244 : ELSEIF (PRESENT(int_data_ptr)) THEN
154 : #ifdef CPP_MPI_ALLOC
155 : CALL C_F_POINTER(ptr, int_data_ptr, (/length/type_size/))
156 : #else
157 : ! In the following allocate a too large length may lead to a segmentation fault in the allocate statement
158 : ! with before being able to return of an error code.
159 1614 : ALLOCATE (int_data_ptr(length), source=0, STAT=iError)
160 : #endif
161 154 : IF (iError.EQ.0) call judft_win_create(int_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
162 : ELSE
163 : #ifdef CPP_MPI_ALLOC
164 : CALL C_F_POINTER(ptr, cmplx_data_ptr, (/length/type_size/))
165 : #else
166 : ! In the following allocate a too large length may lead to a segmentation fault in the allocate statement
167 : ! with before being able to return of an error code.
168 10338562 : ALLOCATE (cmplx_data_ptr(length), source=CMPLX(0.0,0.0), STAT=iError)
169 : #endif
170 90 : IF (iError.EQ.0) call judft_win_create(cmplx_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
171 : ENDIF
172 : #endif
173 : IF(iError.NE.0) THEN
174 : ! See comment above the related allocate statements. This error handler is not always reached.
175 0 : WRITE(errorString,'(a,i13,a,i13,a)') 'Allocation of array for communication failed. Needed number of elements: slot_size ',&
176 0 : slot_size, ' x ', local_slots, ' local slots.'
177 0 : CALL juDFT_error(TRIM(ADJUSTL(errorString)), calledby='eig66_mpi')
178 : END IF
179 :
180 468 : END SUBROUTINE priv_create_memory
181 :
182 0 : SUBROUTINE priv_readfromfileDA()
183 : USE m_eig66_DA, ONLY: open_eig_DA => open_eig, read_eig_DA => read_eig, close_eig_DA => close_eig
184 : IMPLICIT NONE
185 :
186 : INTEGER:: nk, jspin, neig, tmp_id
187 0 : REAL :: eig(d%size_eig)
188 0 : TYPE(t_mat)::zmat
189 :
190 0 : CALL zmat%alloc(d%l_real,d%nmat,d%size_eig)
191 :
192 0 : tmp_id = eig66_data_newid(DA_mode)
193 0 : CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, .false., filename)
194 0 : DO jspin = 1, d%jspins
195 0 : DO nk = 1, d%nkpts
196 0 : CALL read_eig_DA(id,nk,jspin,neig,eig,zmat=zmat)
197 0 : CALL write_eig(tmp_id,nk,jspin,neig,eig=eig,zmat=zmat)
198 : ENDDO
199 : ENDDO
200 0 : CALL close_eig_DA(tmp_id)
201 0 : END SUBROUTINE priv_readfromfileDA
202 : #endif
203 :
204 : END SUBROUTINE open_eig
205 132 : SUBROUTINE close_eig(id, delete, filename)
206 : INTEGER, INTENT(IN) :: id
207 : LOGICAL, INTENT(IN), OPTIONAL:: delete
208 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL::filename
209 : TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
210 :
211 : character(len=20):: arg
212 132 : CALL priv_find_data(id, d)
213 :
214 132 : IF (PRESENT(delete)) THEN
215 0 : IF (delete) WRITE (*, *) "No deallocation of memory implemented in eig66_mpi"
216 : ENDIF
217 :
218 132 : IF (d%irank==0) THEN
219 66 : arg=TRIM(juDFT_string_for_argument("-eig"))
220 66 : IF (index(arg,"save")>0) CALL priv_writetofileDA()
221 : ENDIF
222 : CONTAINS
223 0 : SUBROUTINE priv_writetofileDA()
224 : USE m_eig66_DA, ONLY: open_eig_DA => open_eig, write_eig_DA => write_eig, close_eig_DA => close_eig
225 : IMPLICIT NONE
226 :
227 : INTEGER:: nk, jspin, neig, tmp_id
228 0 : REAL :: eig(d%size_eig)
229 0 : TYPE(t_mat)::zmat
230 :
231 0 : CALL zmat%alloc(d%l_real,d%nmat,d%size_eig)
232 :
233 0 : tmp_id = eig66_data_newid(DA_mode)
234 0 : CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, .false.)
235 0 : DO jspin = 1, d%jspins
236 0 : DO nk = 1, d%nkpts
237 0 : CALL read_eig(id,nk,jspin,neig,eig,zmat=zmat)
238 0 : CALL write_eig_DA(tmp_id,nk,jspin,neig,eig=eig,zmat=zmat)
239 : ENDDO
240 : ENDDO
241 0 : CALL close_eig_DA(tmp_id)
242 0 : END SUBROUTINE priv_writetofileDA
243 : END SUBROUTINE close_eig
244 :
245 11532 : SUBROUTINE read_eig(id, nk, jspin, neig, eig, list, zmat, smat)
246 : IMPLICIT NONE
247 : INTEGER, INTENT(IN) :: id, nk, jspin
248 : INTEGER, INTENT(OUT), OPTIONAL :: neig
249 : REAL, INTENT(OUT), OPTIONAL :: eig(:)
250 : INTEGER, INTENT(IN), OPTIONAL :: list(:)
251 : TYPE(t_mat), OPTIONAL :: zmat, smat
252 :
253 : #ifdef CPP_MPI
254 : INTEGER :: pe, tmp_size, e, req
255 : INTEGER(MPI_ADDRESS_KIND) :: slot
256 : INTEGER :: n1, n2, n3, n
257 : INTEGER, ALLOCATABLE, ASYNCHRONOUS :: tmp_int(:)
258 11532 : REAL, ALLOCATABLE, ASYNCHRONOUS :: tmp_real(:)
259 11532 : COMPLEX, ALLOCATABLE, ASYNCHRONOUS :: tmp_cmplx(:)
260 : TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
261 11532 : CALL priv_find_data(id, d)
262 11532 : pe = d%pe_basis(nk, jspin)
263 11532 : slot = d%slot_basis(nk, jspin)
264 11532 : IF (PRESENT(neig)) THEN
265 8758 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%neig_handle, e)
266 : ! Get current values
267 8758 : CALL MPI_GET(neig, 1, MPI_INTEGER, pe, slot, 1, MPI_INTEGER, d%neig_handle, e)
268 8758 : CALL MPI_WIN_UNLOCK(pe, d%neig_handle, e)
269 : ENDIF
270 11532 : IF (PRESENT(eig)) THEN
271 4710 : ALLOCATE (tmp_real(MIN(SIZE(eig), d%size_eig)))
272 1570 : IF (PRESENT(eig)) THEN
273 1570 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%eig_handle, e)
274 1570 : CALL MPI_GET(tmp_real, SIZE(tmp_real), MPI_DOUBLE_PRECISION, pe, slot, SIZE(tmp_real), MPI_DOUBLE_PRECISION, d%eig_handle, e)
275 1570 : CALL MPI_WIN_UNLOCK(pe, d%eig_handle, e)
276 86358 : eig(:SIZE(tmp_real)) = tmp_real
277 : END IF
278 1570 : DEALLOCATE (tmp_real)
279 : ENDIF
280 :
281 11532 : IF (PRESENT(zmat)) THEN
282 10444 : tmp_size = zmat%matsize1
283 31332 : ALLOCATE (tmp_real(tmp_size))
284 31332 : ALLOCATE (tmp_cmplx(tmp_size))
285 176323 : DO n = 1, zmat%matsize2
286 165879 : n1 = n
287 165879 : IF (PRESENT(list)) THEN
288 165879 : IF (n > SIZE(list)) CYCLE
289 165879 : n1 = list(n)
290 : END IF
291 165879 : slot = d%slot_ev(nk, jspin, n1)
292 165879 : pe = d%pe_ev(nk, jspin, n1)
293 :
294 176323 : IF (zmat%l_real) THEN
295 48424 : IF (.NOT. d%l_real) THEN
296 212 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%zc_handle, e)
297 212 : CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
298 212 : CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
299 : !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
300 46832 : zmat%data_r(:, n) = REAL(tmp_cmplx)
301 : ELSE
302 48212 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%zr_handle, e)
303 48212 : CALL MPI_GET(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%zr_handle, e)
304 48212 : CALL MPI_WIN_UNLOCK(pe, d%zr_handle, e)
305 : !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_real(1)
306 6146299 : zmat%data_r(:, n) = tmp_real
307 : ENDIF
308 : ELSE
309 117455 : IF (d%l_real) CALL judft_error("Could not read complex data, only real data is stored", calledby="eig66_mpi%read_eig")
310 117455 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%zc_handle, e)
311 117455 : CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
312 117455 : CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
313 : !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
314 18910603 : zmat%data_c(:, n) = tmp_cmplx
315 : ENDIF
316 : ENDDO
317 : ENDIF
318 :
319 11532 : IF(allocated(tmp_real)) deallocate(tmp_real)
320 11532 : IF(allocated(tmp_cmplx)) deallocate(tmp_cmplx)
321 :
322 11532 : IF (PRESENT(smat)) THEN
323 24 : tmp_size = smat%matsize1
324 72 : ALLOCATE (tmp_real(tmp_size))
325 72 : ALLOCATE (tmp_cmplx(tmp_size))
326 3628 : DO n = 1, smat%matsize2
327 3604 : n1 = n
328 3604 : IF (PRESENT(list)) THEN
329 0 : IF (n > SIZE(list)) CYCLE
330 0 : n1 = list(n)
331 : END IF
332 3604 : slot = d%slot_olap(nk, jspin, n1)
333 3604 : pe = d%pe_olap(nk, jspin, n1)
334 :
335 3628 : IF (smat%l_real) THEN
336 2522 : IF (.NOT. d%l_real) THEN
337 0 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_c_handle, e)
338 0 : CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
339 0 : CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
340 : !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
341 0 : smat%data_r(:, n) = REAL(tmp_cmplx)
342 : ELSE
343 2522 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_r_handle, e)
344 2522 : CALL MPI_GET(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%olap_r_handle, e)
345 2522 : CALL MPI_WIN_UNLOCK(pe, d%olap_r_handle, e)
346 : !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_real(1)
347 461424 : smat%data_r(:, n) = tmp_real
348 : ENDIF
349 : ELSE
350 1082 : IF (d%l_real) CALL judft_error("Could not read complex data, only real data is stored", calledby="eig66_mpi%read_eig")
351 1082 : CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_c_handle, e)
352 1082 : CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
353 1082 : CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
354 : !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
355 196244 : smat%data_c(:, n) = tmp_cmplx
356 : ENDIF
357 : ENDDO
358 : ENDIF
359 :
360 : #endif
361 11532 : END SUBROUTINE read_eig
362 :
363 8596 : SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, n_size, n_rank, zmat, smat)
364 : INTEGER, INTENT(IN) :: id, nk, jspin
365 : INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
366 : INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
367 : REAL, INTENT(IN), OPTIONAL :: eig(:)
368 : TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
369 :
370 : #ifdef CPP_MPI
371 : INTEGER :: pe, tmp_size, e
372 : INTEGER(MPI_ADDRESS_KIND) :: slot
373 : INTEGER :: n1, n2, n3, n, nn
374 8596 : INTEGER, ALLOCATABLE, ASYNCHRONOUS :: tmp_int(:)
375 8596 : REAL, ALLOCATABLE, ASYNCHRONOUS :: tmp_real(:)
376 8596 : COMPLEX, ALLOCATABLE, ASYNCHRONOUS :: tmp_cmplx(:)
377 : LOGICAL :: acc
378 : TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
379 :
380 : INTEGER:: irank, ierr
381 :
382 8596 : CALL priv_find_data(id, d)
383 :
384 8596 : CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
385 :
386 8596 : pe = d%pe_basis(nk, jspin)
387 8596 : slot = d%slot_basis(nk, jspin)
388 : !write the number of eigenvalues
389 : !only one process needs to do it
390 8596 : IF (PRESENT(neig_total)) THEN
391 5440 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%neig_handle, e)
392 5440 : ALLOCATE (tmp_int(1))
393 5440 : tmp_int(1) = neig_total
394 5440 : CALL MPI_PUT(tmp_int, 1, MPI_INTEGER, pe, slot, 1, MPI_INTEGER, d%neig_handle, e)
395 5440 : CALL MPI_WIN_UNLOCK(pe, d%neig_handle, e)
396 5440 : DEALLOCATE (tmp_int)
397 : ENDIF
398 :
399 : !write the eigenvalues
400 : !only one process needs to do it
401 8596 : IF (PRESENT(eig)) THEN
402 16320 : ALLOCATE (tmp_real(d%size_eig))
403 247574 : tmp_real = 1E99
404 5440 : IF (PRESENT(EIG)) THEN
405 213400 : tmp_real(:SIZE(eig)) = eig(:SIZE(eig))
406 5440 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%eig_handle, e)
407 5440 : CALL MPI_PUT(tmp_real, d%size_eig, MPI_DOUBLE_PRECISION, pe, slot, d%size_eig, MPI_DOUBLE_PRECISION, d%eig_handle, e)
408 5440 : CALL MPI_WIN_UNLOCK(pe, d%eig_handle, e)
409 : END IF
410 5440 : DEALLOCATE (tmp_real)
411 : ENDIF
412 :
413 : !write the eigenvectors
414 : !all procceses participate
415 8596 : IF (PRESENT(zmat)) THEN
416 7876 : tmp_size = zmat%matsize1
417 23628 : ALLOCATE (tmp_real(tmp_size))
418 23628 : ALLOCATE (tmp_cmplx(tmp_size))
419 246310 : DO n = 1, zmat%matsize2
420 242956 : n1 = n - 1
421 242956 : IF (PRESENT(n_size)) n1 = n_size*n1
422 242956 : IF (PRESENT(n_rank)) n1 = n1 + n_rank
423 242956 : IF (n1 + 1 > SIZE(d%slot_ev, 3)) EXIT
424 238434 : slot = d%slot_ev(nk, jspin, n1 + 1)
425 238434 : pe = d%pe_ev(nk, jspin, n1 + 1)
426 246310 : IF (zmat%l_real) THEN
427 69029 : IF (.NOT. d%l_real) THEN
428 48630 : tmp_cmplx = zmat%data_r(:, n)
429 238 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%zc_handle, e)
430 238 : CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
431 238 : CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
432 : ELSE
433 8939879 : tmp_real = zmat%data_r(:, n)
434 68791 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%zr_handle, e)
435 68791 : CALL MPI_PUT(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%zr_handle, e)
436 68791 : CALL MPI_WIN_UNLOCK(pe, d%zr_handle, e)
437 : ENDIF
438 : ELSE
439 169405 : IF (d%l_real) CALL juDFT_error("Could not write complex data to file prepared for real data", calledby="eig66_mpi%write_eig")
440 27713170 : tmp_cmplx = zmat%data_c(:, n)
441 169405 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%zc_handle, e)
442 169405 : CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
443 169405 : CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
444 : ENDIF
445 : ENDDO
446 : ENDIF
447 :
448 8596 : IF(allocated(tmp_real)) deallocate(tmp_real)
449 8596 : IF(allocated(tmp_cmplx)) deallocate(tmp_cmplx)
450 : !write the overlap
451 : !all procceses participate
452 8596 : IF (PRESENT(smat)) THEN
453 720 : tmp_size = smat%matsize1
454 2160 : ALLOCATE (tmp_real(tmp_size))
455 2160 : ALLOCATE (tmp_cmplx(tmp_size))
456 56068 : DO n = 1, smat%matsize2
457 55348 : n1 = n - 1
458 55348 : if((.not. present(n_size)) .and. (.not. present(n_rank)) ) then
459 0 : call juDFT_error("smat needs n_size & n_rank")
460 : endif
461 55348 : IF (PRESENT(n_size)) n1 = n_size*n1
462 55348 : IF (PRESENT(n_rank)) n1 = n1 + n_rank
463 55348 : IF (n1 + 1 > SIZE(d%slot_olap, 3)) EXIT
464 55348 : slot = d%slot_olap(nk, jspin, n1 + 1)
465 55348 : pe = d%pe_olap(nk, jspin, n1 + 1)
466 56068 : IF (smat%l_real) THEN
467 34790 : IF (.NOT. d%l_real) THEN
468 0 : tmp_cmplx = smat%data_r(:, n)
469 0 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%olap_c_handle, e)
470 0 : CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
471 0 : CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
472 : ELSE
473 6449198 : tmp_real = smat%data_r(:, n)
474 34790 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%olap_r_handle, e)
475 34790 : CALL MPI_PUT(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%olap_r_handle, e)
476 34790 : CALL MPI_WIN_UNLOCK(pe, d%olap_r_handle, e)
477 : ENDIF
478 : ELSE
479 20558 : IF (d%l_real) CALL juDFT_error("Could not write complex data to file prepared for real data", calledby="eig66_mpi%write_eig")
480 3749194 : tmp_cmplx = smat%data_c(:, n)
481 20558 : CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%olap_c_handle, e)
482 20558 : CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
483 20558 : CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
484 : ENDIF
485 : ENDDO
486 : ENDIF
487 :
488 : #endif
489 8596 : END SUBROUTINE write_eig
490 :
491 0 : SUBROUTINE reset_eig(id, l_soc)
492 : INTEGER, INTENT(IN) :: id
493 : LOGICAL, INTENT(IN) :: l_soc
494 : #ifdef CPP_MPI
495 : TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
496 0 : CALL priv_find_data(id, d)
497 :
498 0 : d%neig_data = 0
499 0 : d%eig_data = 1E99
500 0 : IF (d%l_real .AND. .NOT. l_soc) THEN
501 0 : d%zr_data = 0.0
502 : ELSE
503 0 : d%zc_data = 0.0
504 : ENDIF
505 : #endif
506 0 : END SUBROUTINE reset_eig
507 :
508 : #ifdef CPP_MPI
509 154 : SUBROUTINE create_maps(d, isize, nkpts, jspins, neig, n_size, nmat)
510 : IMPLICIT NONE
511 : TYPE(t_data_MPI), INTENT(INOUT), ASYNCHRONOUS:: d
512 : INTEGER, INTENT(IN):: isize, nkpts, jspins, neig, n_size, nmat
513 :
514 : INTEGER:: nk, j, n1, n2, n, pe, n_members
515 154 : INTEGER::used(0:isize)
516 :
517 3090 : allocate (d%pe_basis(nkpts, jspins), source=-1)
518 2936 : allocate (d%slot_basis(nkpts, jspins), source=-1)
519 :
520 139950 : allocate (d%pe_ev(nkpts, jspins, neig), source=-1)
521 139796 : allocate (d%slot_ev(nkpts, jspins, neig), source=-1)
522 :
523 662708 : allocate (d%pe_olap(nkpts, jspins, nmat), source=-1)
524 662554 : allocate (d%slot_olap(nkpts, jspins, nmat), source=-1)
525 :
526 : !basis contains a total of nkpts*jspins entries
527 2628 : d%pe_basis = -1
528 139334 : d%pe_ev = -1
529 662092 : d%pe_olap = -1
530 616 : used = 0
531 154 : n_members = isize/n_size !no of k-points in parallel
532 410 : DO j = 1, jspins
533 2628 : DO nk = 1, nkpts
534 2218 : n1 = nk + (j - 1)*nkpts - 1
535 2218 : pe = MOD(n1, n_members)*n_size
536 2218 : d%pe_basis(nk, j) = pe
537 2218 : d%slot_basis(nk, j) = used(pe)
538 2474 : used(pe) = used(pe) + 1
539 : ENDDO
540 : ENDDO
541 :
542 616 : used = 0
543 9498 : DO n = 1, neig
544 26396 : DO j = 1, jspins
545 139180 : DO nk = 1, nkpts
546 112938 : n1 = nk + (j - 1)*nkpts - 1
547 : !eigenvectors have more entries
548 : !pe=MOD(n1,n_members)*n_size+MOD(n,n_size)
549 112938 : pe = MOD(n1, n_members)*n_size + MOD(n - 1, n_size)
550 112938 : d%pe_ev(nk, j, n) = pe
551 112938 : d%slot_ev(nk, j, n) = used(pe)
552 129836 : used(pe) = used(pe) + 1
553 : ENDDO
554 : ENDDO
555 : ENDDO
556 :
557 616 : used = 0
558 56150 : DO n = 1, nmat
559 148304 : DO j = 1, jspins
560 661938 : DO nk = 1, nkpts
561 513788 : n1 = nk + (j - 1)*nkpts - 1
562 513788 : pe = MOD(n1, n_members)*n_size + MOD(n - 1, n_size)
563 513788 : d%pe_olap(nk, j, n) = pe
564 513788 : d%slot_olap(nk, j, n) = used(pe)
565 605942 : used(pe) = used(pe) + 1
566 : ENDDO
567 : ENDDO
568 : ENDDO
569 154 : END SUBROUTINE create_maps
570 : #endif
571 :
572 20462 : END MODULE m_eig66_mpi
|