Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* m_abi_linalg/abi_xhpgv
3 : !! NAME
4 : !! abi_xhpgv
5 : !!
6 : !! FUNCTION
7 : !! abi_xhpgv is the generic function that compute
8 : !! all eigenvalues and, optionally, eigenvectors of a
9 : !! generalized symmetric-definite eigenproblem, of the form
10 : !! A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
11 : !! Here A and B are assumed to be symmetric (or hermitian),
12 : !! stored in packed format and B is also positive definite.
13 : !!
14 : !! COPYRIGHT
15 : !! Copyright (C) 2001-2026 ABINIT group (LNguyen,FDahm,MT)
16 : !! This file is distributed under the terms of the
17 : !! GNU General Public License, see ~abinit/COPYING
18 : !! or http://www.gnu.org/copyleft/gpl.txt .
19 : !!
20 : !! SOURCE
21 : !!***
22 :
23 : !!****f* m_abi_linalg/abi_dhpgv
24 : !! NAME
25 : !! abi_dhpgv
26 : !!
27 : !! FUNCTION
28 : !!
29 : !! INPUTS
30 : !!
31 : !! SOURCE
32 : !!
33 48 : subroutine abi_dhpgv(itype,jobz,uplo,n,a,b,w,z,ldz,istwf_k,use_slk,use_gpu_elpa)
34 :
35 : use m_fstrings, only : sjoin, itoa
36 :
37 : !Arguments ------------------------------------
38 : integer :: itype
39 : character(len=1), intent(in) :: jobz
40 : character(len=1), intent(in) :: uplo
41 : integer, intent(in) :: n,ldz
42 : real(dp), intent(inout) :: a(:)
43 : real(dp), intent(inout) :: b(:)
44 : real(dp), intent(out) :: z(:,:)
45 : real(dp), intent(out) :: w(:)
46 : integer, optional, intent(in) :: istwf_k
47 : integer, optional, intent(in) :: use_slk,use_gpu_elpa
48 :
49 : !Local variables-------------------------------
50 : integer :: info,use_slk_,use_gpu_elpa_,istwf_k_
51 : #ifdef HAVE_LINALG_SCALAPACK
52 : type(slkmat_dp_t) :: sca_a,sca_b,sca_ev
53 : integer :: ierr
54 : #endif
55 : ! *********************************************************************
56 :
57 48 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_dhpgv (storage)!")
58 48 : ABI_CHECK(lapack_double_precision,"BUG(2) in abi_dhpgv (precision)!")
59 48 : ABI_CHECK(n<=eigen_d_maxsize,"BUG(3) in abi_dhpgv (maxsize)!")
60 :
61 48 : info = 0 !to avoid unwanted warning when info is not set by scalapack
62 :
63 48 : use_slk_ = 0; if (present(use_slk)) use_slk_ = use_slk
64 48 : istwf_k_ = 1; if (present(istwf_k)) istwf_k_ = istwf_k
65 48 : use_gpu_elpa_=0
66 : #ifdef HAVE_LINALG_ELPA
67 : if (present(use_gpu_elpa)) use_gpu_elpa_=use_gpu_elpa
68 : #endif
69 :
70 : !===== SCALAPACK
71 48 : if (ABI_LINALG_SCALAPACK_ISON.and.use_slk_==1.and.n>slk_minsize) then
72 : #if defined HAVE_LINALG_SCALAPACK
73 : z = zero
74 : call sca_a%init(n,n,slk_processor,istwf_k_)
75 : call sca_b%init(n,n,slk_processor,istwf_k_)
76 : call sca_ev%init(n,n,slk_processor,istwf_k_)
77 : #ifdef HAVE_LINALG_ELPA
78 : call sca_a%from_global_sym(a,istwf_k_)
79 : call sca_b%from_global_sym(b,istwf_k_)
80 : #else
81 : call sca_a%from_global_pack(a,istwf_k_)
82 : call sca_b%from_global_pack(b,istwf_k_)
83 : #endif
84 : call compute_generalized_eigen_problem(slk_processor,sca_a,sca_b,&
85 : & sca_ev,w,slk_communicator,istwf_k_,use_gpu_elpa=use_gpu_elpa_)
86 : call sca_a%to_global_pack(a,istwf_k_)
87 : call sca_b%to_global_pack(b,istwf_k_)
88 : call sca_ev%to_global(z, istwf_k_)
89 : call xmpi_sum(z,slk_communicator,ierr)
90 : call sca_a%free()
91 : call sca_ev%free()
92 : #endif
93 :
94 : !===== LAPACK
95 : else
96 48 : if (istwf_k_/=2) then
97 48 : call zhpgv(itype,jobz,uplo,n,a,b,w,z,ldz,eigen_z_work,eigen_z_rwork,info)
98 : else
99 0 : call dspgv(itype,jobz,uplo,n,a,b,w,z,ldz,eigen_d_work,info)
100 : endif
101 : end if
102 :
103 48 : if (info < 0) then
104 0 : ABI_COMMENT(sjoin("argument #", itoa(-info), "had an illegal value"))
105 : end if
106 :
107 48 : if (info > 0) then
108 0 : ABI_COMMENT("DSPEV failed to converge")
109 0 : if (info <= n) then
110 0 : ABI_COMMENT(sjoin("DSPEV failed to converge;", itoa(info), " off-diagonal elements of"))
111 0 : ABI_COMMENT(" an intermediate tridiagonal form did not converge to zero.")
112 : else
113 0 : ABI_COMMENT("The factorization of B could not be completed and no eigenvalues or eigenvectors were computed.")
114 : endif
115 : end if
116 :
117 48 : ABI_CHECK(info==0,"abi_dhpgv returned info!=0!")
118 :
119 : #ifndef HAVE_LINALG_ELPA
120 : ABI_UNUSED(use_gpu_elpa)
121 : #endif
122 :
123 48 : end subroutine abi_dhpgv
124 : !!***
125 :
126 : !----------------------------------------------------------------------
127 :
128 : !!****f* m_abi_linalg/abi_chpgv
129 : !! NAME
130 : !! abi_chpgv
131 : !!
132 : !! FUNCTION
133 : !!
134 : !! INPUTS
135 : !!
136 : !! SOURCE
137 : !!
138 0 : subroutine abi_chpgv(itype,jobz,uplo,n,a,b,w,z,ldz)
139 :
140 : !Arguments ------------------------------------
141 : integer,intent(in) :: itype
142 : character(len=1), intent(in) :: jobz
143 : character(len=1), intent(in) :: uplo
144 : integer, intent(in) :: n,ldz
145 : complex(sp), intent(inout) :: a(:,:)
146 : complex(sp), intent(inout) :: b(:,:)
147 : complex(sp), intent(out) :: z(:,:)
148 : real(sp), intent(out) :: w(:)
149 :
150 : !Local variables-------------------------------
151 : integer :: info
152 : real(sp),pointer :: rwork(:)
153 : complex(sp),pointer :: work(:)
154 : ! *********************************************************************
155 :
156 0 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_chpgv (storage)!")
157 0 : ABI_CHECK(lapack_single_precision,"BUG(2) in abi_chpgv (precision)!")
158 0 : ABI_CHECK(n<=eigen_c_maxsize,"BUG(3) in abi_chpgv (maxsize)!")
159 :
160 0 : work => eigen_c_work ; rwork => eigen_c_rwork
161 :
162 : !===== LAPACK
163 0 : if (eigen_c_lwork==0) then
164 0 : ABI_MALLOC(work,(2*n-1))
165 : end if
166 0 : if (eigen_c_lrwork==0) then
167 0 : ABI_MALLOC(rwork,(3*n-2))
168 : end if
169 0 : call chpgv(itype,jobz,uplo,n,a,b,w,z,ldz,work,rwork,info)
170 0 : if (eigen_c_lwork==0) then
171 0 : ABI_FREE(work)
172 : end if
173 0 : if (eigen_c_lrwork==0) then
174 0 : ABI_FREE(rwork)
175 : end if
176 :
177 0 : ABI_CHECK(info==0,"abi_chpgv returned info!=0!")
178 :
179 0 : end subroutine abi_chpgv
180 : !!***
181 :
182 : !----------------------------------------------------------------------
183 :
184 : !!****f* m_abi_linalg/abi_zhpgv
185 : !! NAME
186 : !! abi_zhpgv
187 : !!
188 : !! FUNCTION
189 : !!
190 : !! INPUTS
191 : !!
192 : !! SOURCE
193 :
194 0 : subroutine abi_zhpgv(itype,jobz,uplo,n,a,b,w,z,ldz)
195 :
196 : !Arguments ------------------------------------
197 : integer,intent(in) :: itype
198 : integer, intent(in) :: n,ldz
199 : character(len=1), intent(in) :: jobz
200 : character(len=1), intent(in) :: uplo
201 : complex(dp), intent(inout) :: a(:,:)
202 : complex(dp), intent(inout) :: b(:,:)
203 : complex(dp), intent(out) :: z(:,:)
204 : real(dp), intent(out) :: w(:)
205 :
206 : !Local variables-------------------------------
207 : integer :: info
208 : real(dp),pointer :: rwork(:)
209 : complex(dp),pointer :: work(:)
210 : ! *********************************************************************
211 :
212 0 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_zhpgv (storage)!")
213 0 : ABI_CHECK(lapack_double_precision,"BUG(2) in abi_zhpgv (precision)!")
214 0 : ABI_CHECK(n<=eigen_z_maxsize,"BUG(3) in abi_zhpgv (maxsize)!")
215 :
216 0 : work => eigen_z_work ; rwork => eigen_z_rwork
217 :
218 : !===== LAPACK
219 0 : if (eigen_z_lwork==0) then
220 0 : ABI_MALLOC(work,(2*n-1))
221 : end if
222 0 : if (eigen_z_lrwork==0) then
223 0 : ABI_MALLOC(rwork,(3*n-2))
224 : end if
225 0 : call zhpgv(itype,jobz,uplo,n,a,b,w,z,ldz,work,rwork,info)
226 0 : if (eigen_z_lwork==0) then
227 0 : ABI_FREE(work)
228 : end if
229 0 : if (eigen_z_lrwork==0) then
230 0 : ABI_FREE(rwork)
231 : end if
232 :
233 0 : ABI_CHECK(info==0,"abi_zhpgv returned info!=0!")
234 :
235 0 : end subroutine abi_zhpgv
236 : !!***
|
