Branch data 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 [ - + - + : 447407 : 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 [ - + ]: 447407 : ABI_CHECK(lapack_packed_storage,"BUG(1) in abi_dhpev (storage)!")
54 [ - + ]: 447407 : ABI_CHECK(lapack_double_precision,"BUG(2) in abi_dhpev (precision)!")
55 [ - + ]: 447407 : ABI_CHECK(n<=eigen_d_maxsize,"BUG(3) in abi_dhpev (maxsize)!")
56 : :
57 : 447407 : info = 0 ! to avoid unwanted warnings but scalapack doesn't check return
58 : :
59 [ + - ]: 447407 : use_slk_ = 0; if (present(use_slk)) use_slk_ = use_slk
60 [ + - ]: 447407 : istwf_k_ = 1; if (present(istwf_k)) istwf_k_ = istwf_k
61 : 447407 : 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 [ - + - - : 447407 : 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 [ + + ]: 447407 : if (istwf_k_/=2) then
93 [ - + - - : 430486 : call zhpev(jobz,uplo,n,a,w,z,ldz,eigen_z_work,eigen_z_rwork,info)
- - - + -
- - - - +
- - - - -
- - + - -
- + - - -
+ - - -
- ]
94 : : else
95 [ - + - - : 16921 : call dspev(jobz,uplo,n,a,w,z,ldz,eigen_d_work,info)
- - - + -
- - - - +
- - - - -
- - + - -
- + - - -
+ - - -
- ]
96 : : end if
97 : : end if
98 : :
99 [ - + ]: 447407 : ABI_CHECK(info==0,"dhpev returned info!=0")
100 : :
101 : : #ifndef HAVE_LINALG_ELPA
102 : : ABI_UNUSED(use_gpu_elpa)
103 : : #endif
104 : :
105 : 447407 : 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 : : !!***
|
