Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* m_abi_linalg/abi_xhpev
3 : !! NAME
4 : !! abi_xhpev
5 : !!
6 : !! FUNCTION
7 : !! abi_xhpev is the generic function that compute
8 : !! all eigenvalues and, optionally, eigenvectors of a
9 : !! symmetric or hermitian matrix A in packed storage
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2001-2026 ABINIT group (LNguyen,FDahm,MT)
13 : !! This file is distributed under the terms of the
14 : !! GNU General Public License, see ~abinit/COPYING
15 : !! or http://www.gnu.org/copyleft/gpl.txt .
16 : !!
17 : !! SOURCE
18 :
19 : !!***
20 :
21 : !!****f* m_abi_linalg/abi_dhpev
22 : !! NAME
23 : !! abi_dhpev
24 : !!
25 : !! FUNCTION
26 : !!
27 : !! INPUTS
28 : !!
29 : !! SOURCE
30 :
31 445643 : subroutine abi_dhpev(jobz,uplo,n,a,w,z,ldz,istwf_k,use_slk,use_gpu_elpa)
32 :
33 : !Arguments ------------------------------------
34 : character(len=1), intent(in) :: jobz
35 : character(len=1), intent(in) :: uplo
36 : integer, intent(in) :: n,ldz
37 : real(dp), intent(inout) :: a(:)
38 : real(dp), intent(out) :: z(:,:)
39 : real(dp), intent(out) :: w(:)
40 : integer, optional, intent(in) :: istwf_k
41 : integer, optional, intent(in) :: use_slk,use_gpu_elpa
42 :
43 : !Local variables-------------------------------
44 : integer :: info,use_slk_,use_gpu_elpa_,istwf_k_
45 : #ifdef HAVE_LINALG_SCALAPACK
46 : type(slkmat_dp_t) :: sca_a,sca_ev
47 : real(dp),allocatable :: tmp_evec(:,:)
48 : integer :: dim_evec1,ierr
49 : #endif
50 :
51 : ! *********************************************************************
52 :
53 445643 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_dhpev (storage)!")
54 445643 : ABI_CHECK(lapack_double_precision,"BUG(2) in abi_dhpev (precision)!")
55 445643 : ABI_CHECK(n<=eigen_d_maxsize,"BUG(3) in abi_dhpev (maxsize)!")
56 :
57 445643 : info = 0 ! to avoid unwanted warnings but scalapack doesn't check return
58 :
59 445643 : use_slk_ = 0; if (present(use_slk)) use_slk_ = use_slk
60 445643 : istwf_k_ = 1; if (present(istwf_k)) istwf_k_ = istwf_k
61 445643 : use_gpu_elpa_=0
62 : #ifdef HAVE_LINALG_ELPA
63 : if (present(use_gpu_elpa)) use_gpu_elpa_=use_gpu_elpa
64 : #endif
65 :
66 : !===== SCALAPACK
67 445643 : if (ABI_LINALG_SCALAPACK_ISON.and.use_slk_==1.and.n>slk_minsize) then
68 : #if defined HAVE_LINALG_SCALAPACK
69 : ! if istwfk=1, then dim_evec1=2*n and if istwfk=2, dim_evec1=n
70 : dim_evec1= 2*n/istwf_k_
71 : ABI_MALLOC(tmp_evec,(dim_evec1,n))
72 : tmp_evec = zero
73 : call sca_a%init(n,n,slk_processor,istwf_k_)
74 : call sca_ev%init(n,n,slk_processor,istwf_k_)
75 : #ifdef HAVE_LINALG_ELPA
76 : call sca_a%from_global_sym(a,istwf_k_)
77 : #else
78 : call sca_a%from_global_pack(a,istwf_k_)
79 : #endif
80 : call compute_eigen_problem(slk_processor,sca_a,sca_ev,w,slk_communicator,istwf_k_,&
81 : & use_gpu_elpa=use_gpu_elpa_)
82 : call sca_a%to_global_pack(a,istwf_k_)
83 : call sca_ev%to_global(tmp_evec, istwf_k_)
84 : call xmpi_sum(tmp_evec,z,dim_evec1*n,slk_communicator,ierr)
85 : call sca_a%free()
86 : call sca_ev%free()
87 : ABI_FREE(tmp_evec)
88 : #endif
89 :
90 : !===== LAPACK
91 : else
92 445643 : if (istwf_k_/=2) then
93 428858 : call zhpev(jobz,uplo,n,a,w,z,ldz,eigen_z_work,eigen_z_rwork,info)
94 : else
95 16785 : call dspev(jobz,uplo,n,a,w,z,ldz,eigen_d_work,info)
96 : end if
97 : end if
98 :
99 445643 : ABI_CHECK(info==0,"dhpev returned info!=0")
100 :
101 : #ifndef HAVE_LINALG_ELPA
102 : ABI_UNUSED(use_gpu_elpa)
103 : #endif
104 :
105 445643 : end subroutine abi_dhpev
106 : !!***
107 :
108 : !----------------------------------------------------------------------
109 :
110 : !!****f* m_abi_linalg/abi_chpev
111 : !! NAME
112 : !! abi_chpev
113 : !!
114 : !! FUNCTION
115 : !!
116 : !! INPUTS
117 : !!
118 : !! SOURCE
119 :
120 0 : subroutine abi_chpev(jobz,uplo,n,a,w,z,ldz)
121 :
122 : !Arguments ------------------------------------
123 : character(len=1), intent(in) :: jobz
124 : character(len=1), intent(in) :: uplo
125 : integer, intent(in) :: n,ldz
126 : complex(sp), intent(inout) :: a(:,:)
127 : complex(sp), intent(out) :: z(:,:)
128 : real(sp), intent(out) :: w(:)
129 :
130 : !Local variables-------------------------------
131 : integer :: info
132 : real(sp),pointer :: rwork(:)
133 : complex(sp),pointer :: work(:)
134 : ! *********************************************************************
135 :
136 0 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_chpev (storage)!")
137 0 : ABI_CHECK(lapack_single_precision,"BUG(2) in abi_chpev (precision)!")
138 0 : ABI_CHECK(n<=eigen_c_maxsize,"BUG(3) in abi_chpev (maxsize)!")
139 :
140 0 : work => eigen_c_work ; rwork => eigen_c_rwork
141 :
142 : !===== LAPACK
143 0 : if (eigen_c_lwork==0) then
144 0 : ABI_MALLOC(work,(2*n-1))
145 : end if
146 0 : if (eigen_c_lrwork==0) then
147 0 : ABI_MALLOC(rwork,(3*n-2))
148 : end if
149 0 : call chpev(jobz,uplo,n,a,w,z,ldz,work,rwork,info)
150 0 : if (eigen_c_lwork==0) then
151 0 : ABI_FREE(work)
152 : end if
153 0 : if (eigen_c_lrwork==0) then
154 0 : ABI_FREE(rwork)
155 : end if
156 :
157 0 : ABI_CHECK(info==0,"abi_chpev returned info!=0!")
158 :
159 0 : end subroutine abi_chpev
160 : !!***
161 :
162 : !----------------------------------------------------------------------
163 :
164 : !!****f* m_abi_linalg/abi_zhpev
165 : !! NAME
166 : !! abi_zhpev
167 : !!
168 : !! FUNCTION
169 : !!
170 : !! INPUTS
171 : !!
172 : !! SOURCE
173 :
174 0 : subroutine abi_zhpev(jobz,uplo,n,a,w,z,ldz)
175 :
176 : !Arguments ------------------------------------
177 : character(len=1), intent(in) :: jobz
178 : character(len=1), intent(in) :: uplo
179 : integer, intent(in) :: n,ldz
180 : complex(dp), intent(inout) :: a(:,:)
181 : complex(dp), intent(out) :: z(:,:)
182 : real(dp), intent(out) :: w(:)
183 :
184 : !Local variables-------------------------------
185 : integer :: info
186 : real(dp),pointer :: rwork(:)
187 : complex(dp),pointer :: work(:)
188 : ! *********************************************************************
189 :
190 0 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_zhpev (storage)!")
191 0 : ABI_CHECK(lapack_double_precision,"BUG(2) in abi_zhpev (precision)!")
192 0 : ABI_CHECK(n<=eigen_z_maxsize,"BUG(3) in abi_zhpev (maxsize)!")
193 :
194 0 : work => eigen_z_work ; rwork => eigen_z_rwork
195 :
196 : !===== LAPACK
197 0 : if (eigen_z_lwork==0) then
198 0 : ABI_MALLOC(work,(2*n-1))
199 : end if
200 0 : if (eigen_z_lrwork==0) then
201 0 : ABI_MALLOC(rwork,(3*n-2))
202 : end if
203 0 : call zhpev(jobz,uplo,n,a,w,z,ldz,work,rwork,info)
204 0 : if (eigen_z_lwork==0) then
205 0 : ABI_FREE(work)
206 : end if
207 0 : if (eigen_z_lrwork==0) then
208 0 : ABI_FREE(rwork)
209 : end if
210 :
211 0 : ABI_CHECK(info==0,"abi_zhpev returned info!=0!")
212 :
213 0 : end subroutine abi_zhpev
214 : !!***
|
