Line data Source code
1 : module m_eigvec_setup
2 : use m_judft
3 : use m_types
4 : use m_work_package
5 : implicit none
6 :
7 : contains
8 128 : subroutine eigvec_setup(eigvec, fi, lapw, work_packs, fmpi, nbands, ik, jsp, eig_id)
9 : implicit none
10 : class(t_eigvec), intent(inout) :: eigvec
11 : type(t_fleurinput), intent(in) :: fi
12 : TYPE(t_lapw), INTENT(IN) :: lapw
13 : integer, intent(in) :: ik, jsp, eig_id
14 : type(t_work_package), intent(in) :: work_packs(:)
15 : type(t_mpi), intent(in) :: fmpi
16 : integer, intent(in) :: nbands! hybdat%nbands(ik,jsp) passed like this to avoid circular dependencies
17 :
18 : integer :: nbasfcn
19 :
20 128 : eigvec%nk = ik
21 128 : eigvec%jsp = jsp
22 :
23 128 : call eigvec_set_part_and_band(eigvec, fi, work_packs, fmpi, nbands, jsp)
24 : !communication only happen on reduced BZ
25 128 : if (ik <= fi%kpts%nkpt) call eigvec_create_comm(eigvec, fi, eig_id, ik, jsp, nbands)
26 :
27 128 : if (eigvec%l_recv) then
28 24 : nbasfcn = lapw%hyb_num_bas_fun(fi)
29 24 : call eigvec%mat%alloc(fi%sym%invs, nbasfcn, nbands)
30 : endif
31 128 : end subroutine eigvec_setup
32 :
33 128 : subroutine eigvec_set_part_and_band(eigvec, fi, work_packs, fmpi, nbands, jsp)
34 : implicit none
35 : class(t_eigvec), intent(inout) :: eigvec
36 : type(t_fleurinput), intent(in) :: fi
37 : type(t_mpi), intent(in) :: fmpi
38 : type(t_work_package), intent(in) :: work_packs(:)
39 : integer, intent(in) :: nbands ! hybdat%nbands(nk,jsp) passed like this to avoid circular dependencies
40 : integer, intent(in) :: jsp
41 :
42 : integer :: i
43 :
44 : !set senders
45 416 : eigvec%l_participate = any(fmpi%k_list == eigvec%nk)
46 :
47 : !set recipients for k-side
48 320 : do i = 1, work_packs(jsp)%k_packs(1)%size
49 320 : if (eigvec%nk == work_packs(jsp)%k_packs(i)%nk) then
50 24 : eigvec%l_participate = .True.
51 24 : eigvec%l_recv = .True.
52 : endif
53 : enddo
54 128 : end subroutine eigvec_set_part_and_band
55 :
56 12 : subroutine bcast_eigvecs(hybdat, fi, nococonv, fmpi)
57 : use m_eig66_data
58 : USE m_eig66_io
59 : use m_eig66_mpi, only: priv_find_data
60 : use m_judft
61 : use m_io_hybrid
62 : implicit none
63 : type(t_hybdat), intent(inout) :: hybdat
64 : type(t_fleurinput), intent(in) :: fi
65 : TYPE(t_nococonv), INTENT(IN) :: nococonv
66 : TYPE(t_mpi), INTENT(IN) :: fmpi
67 :
68 12 : type(t_lapw) :: lapw
69 12 : type(t_mat) :: tmp
70 :
71 :
72 : integer :: jsp, ik, nbasfcn, ieig, ierr, root, me
73 :
74 12 : call timestart("bcast zmat")
75 :
76 12 : select case (eig66_data_mode(hybdat%eig_id) )
77 : case( mpi_mode)
78 : #ifdef CPP_MPI
79 28 : do jsp = 1, fi%input%jspins
80 76 : do ik = 1, fi%kpts%nkpt
81 64 : if(hybdat%zmat(ik, jsp)%l_participate) then
82 :
83 48 : CALL lapw%init(fi%input, fi%noco, nococonv, fi%kpts, fi%atoms, fi%sym, ik, fi%cell)
84 : !allocate tmp array
85 48 : nbasfcn = lapw%hyb_num_bas_fun(fi)
86 48 : call tmp%alloc(fi%sym%invs, nbasfcn, 1)
87 2504 : do ieig = 1, hybdat%nbands(ik,jsp)
88 2456 : root = hybdat%zmat(ik, jsp)%root_pe(ieig)
89 2456 : call MPI_comm_rank(hybdat%zmat(ik, jsp)%comm, me, ierr)
90 : ! make sure read_eig is only run if I have it in mem
91 3684 : if (me == root) call read_eig(hybdat%eig_id, ik, jsp, zmat=tmp, list=[ieig])
92 :
93 2456 : if (fi%sym%invs) then
94 1868 : call MPI_Bcast(tmp%data_r, nbasfcn, MPI_DOUBLE_PRECISION, root, hybdat%zmat(ik, jsp)%comm, ierr)
95 : else
96 588 : call MPI_Bcast(tmp%data_c, nbasfcn, MPI_DOUBLE_COMPLEX, root, hybdat%zmat(ik, jsp)%comm, ierr)
97 : endif
98 : ! deal with k-copies
99 4960 : if(hybdat%zmat(ik, jsp)%l_recv) then
100 1228 : if(fi%sym%invs)then
101 119244 : hybdat%zmat(ik, jsp)%mat%data_r(:,ieig) = tmp%data_r(:,1)
102 : else
103 53312 : hybdat%zmat(ik, jsp)%mat%data_c(:,ieig) = tmp%data_c(:,1)
104 : endif
105 : endif
106 : enddo
107 48 : call tmp%free()
108 : endif
109 : enddo
110 : enddo
111 : #endif
112 : case(mem_mode)
113 0 : do jsp = 1, fi%input%jspins
114 0 : do ik = 1, fi%kpts%nkpt
115 0 : call read_z(fi%atoms, fi%cell, hybdat, fi%kpts, fi%sym, fi%noco, nococonv, fi%input, ik, jsp, hybdat%zmat(ik,jsp)%mat)
116 : enddo
117 : enddo
118 : CASE DEFAULT
119 12 : CALL juDFT_error("The hybrid-code only supports eigvec comm via MEM or MPI")
120 : END select
121 :
122 12 : call timestop("bcast zmat")
123 12 : end subroutine bcast_eigvecs
124 :
125 48 : subroutine eigvec_create_comm(eigvec, fi, eig_id, ik, jsp, nbands)
126 : use m_types_mpi
127 : use m_types_lapw
128 : use m_eig66_data
129 : use m_eig66_io
130 : use m_eig66_mpi, only: priv_find_data
131 : implicit none
132 : class(t_eigvec), intent(inout) :: eigvec
133 : type(t_fleurinput), intent(in) :: fi
134 : integer, intent(in) :: eig_id, ik, jsp, nbands
135 : #ifdef CPP_MPI
136 :
137 : TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
138 : integer :: color, me_glob, me_loc, ieig, ierr
139 :
140 48 : select case (eig66_data_mode(eig_id) )
141 : case( mpi_mode)
142 48 : CALL priv_find_data(eig_id, d)
143 :
144 48 : IF(eigvec%comm.NE.MPI_COMM_NULL) THEN
145 24 : CALL MPI_COMM_FREE(eigvec%comm, ierr)
146 24 : IF (ierr.NE.0) CALL juDFT_error('Freeing of MPI communicator was not successful', calledby='eigvec_create_comm')
147 : END IF
148 : ! if(eigvec%comm == MPI_COMM_NULL) then ! This IF in combination with no IF block above caused deadlocks.
149 48 : color = merge(1,2,eigvec%l_participate)
150 48 : call judft_comm_split(MPI_COMM_WORLD, color, 1, eigvec%comm)
151 : ! endif
152 :
153 :
154 48 : if(eigvec%l_participate) then
155 48 : call mpi_comm_rank(MPI_COMM_WORLD, me_glob, ierr)
156 48 : call mpi_comm_rank(eigvec%comm, me_loc, ierr)
157 :
158 48 : if(allocated(eigvec%root_pe)) deallocate(eigvec%root_pe)
159 2600 : allocate(eigvec%root_pe(nbands), source=-1)
160 :
161 2504 : do ieig = 1,nbands
162 2504 : if(me_glob == d%pe_ev(ik, jsp, ieig)) then
163 1228 : eigvec%root_pe(ieig) = me_loc
164 : endif
165 : enddo
166 48 : call MPI_Allreduce(MPI_IN_PLACE, eigvec%root_pe, nbands, MPI_INTEGER, MPI_MAX, eigvec%comm, ierr)
167 :
168 2552 : if(any(eigvec%root_pe < 0)) call judft_error("A vector can't be on a negative PE. Distrb failed.")
169 : endif
170 : case(mem_mode)
171 :
172 : CASE DEFAULT
173 48 : CALL juDFT_error("The hybrid-code only supports eigvec comm via MEM or MPI")
174 : END select
175 : #endif
176 48 : end subroutine eigvec_create_comm
177 : end module m_eigvec_setup
|
