Branch data 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 : : !!***
|
