Branch data Line data Source code
1 : : !!****m* ABINIT/m_abi_linalg
2 : : !! NAME
3 : : !! m_abi_linalg
4 : : !!
5 : : !! FUNCTION
6 : : !! management of Linear Algebra wrappers routines
7 : : !! with support of different external library (scalapack, elpa, plasma, magma, ... )
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2012-2026 ABINIT group (LNguyen,FDahm,MT)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !!
15 : : !! SOURCE
16 : :
17 : : #if defined HAVE_CONFIG_H
18 : : #include "config.h"
19 : : #endif
20 : :
21 : : #include "abi_common.h"
22 : :
23 : : module m_abi_linalg
24 : :
25 : : use, intrinsic :: iso_c_binding
26 : : USE_MPI
27 : : use defs_basis
28 : : use m_errors
29 : : use m_abicore
30 : : use m_xmpi
31 : : use m_xomp
32 : : use m_gputk
33 : : use m_slk
34 : :
35 : : !#ifdef HAVE_LINALG_ELPA
36 : : ! use m_elpa
37 : : !#endif
38 : : #ifdef HAVE_LINALG_PLASMA
39 : : use plasma, except_dp => dp, except_sp => sp
40 : : #endif
41 : :
42 : : #if defined HAVE_GPU
43 : : use m_gpu_toolbox
44 : : #endif
45 : :
46 : : #if defined HAVE_YAKL
47 : : use gator_mod, only: gator_allocate, gator_deallocate
48 : : #endif
49 : :
50 : : #if defined HAVE_MPI1
51 : : include 'mpif.h'
52 : : #endif
53 : :
54 : : use m_time, only : timab
55 : : use m_fstrings, only : sjoin, itoa
56 : :
57 : : implicit none
58 : :
59 : : private
60 : : !!***
61 : :
62 : : !This flag is ON if abi_linalg functions are in use (if this module is in use)
63 : : logical :: abi_linalg_in_use=.true.
64 : :
65 : : !These flags enable the different versions in the BLAS/LAPACK wrappers
66 : : logical,private,save :: ABI_LINALG_SCALAPACK_ISON=.False.
67 : : logical,private,save :: ABI_LINALG_MAGMA_ISON=.False.
68 : : logical,private,save :: ABI_LINALG_PLASMA_ISON=.False.
69 : :
70 : : !Working arrays for eigen problem
71 : :
72 : : logical,save :: lapack_single_precision=.false.
73 : : logical,save :: lapack_double_precision=.false.
74 : : logical,save :: lapack_full_storage =.false.
75 : : logical,save :: lapack_packed_storage =.false.
76 : : logical,save :: lapack_divide_conquer =.false.
77 : :
78 : : integer,save :: eigen_s_maxsize=0
79 : : integer,save :: eigen_d_maxsize=0
80 : : integer,save :: eigen_c_maxsize=0
81 : : integer,save :: eigen_z_maxsize=0
82 : : integer,save :: eigen_s_lwork=0
83 : : integer,save :: eigen_d_lwork=0
84 : : integer,save :: eigen_c_lwork=0
85 : : integer,save :: eigen_z_lwork=0
86 : : integer,save :: eigen_c_lrwork=0
87 : : integer,save :: eigen_z_lrwork=0
88 : : integer,save :: eigen_liwork=0
89 : :
90 : : ! MG FIXME: I really do not understand why we should use global variables to wrap Scalapack routines.
91 : : !
92 : : ! 1) The procedures are not thread-safe.
93 : : ! 2) The procedures cannot be reused with different dimensions without dellocating these globals
94 : :
95 : : integer,save,target,allocatable :: eigen_iwork(:)
96 : : real(sp),save,target,allocatable :: eigen_c_rwork(:)
97 : : real(dp),save,target,allocatable :: eigen_z_rwork(:)
98 : : real(sp),save,target,allocatable :: eigen_s_work(:)
99 : : real(dp),save,target,allocatable :: eigen_d_work(:)
100 : : complex(sp),save,target,allocatable :: eigen_c_work(:)
101 : : complex(dp),save,target,allocatable :: eigen_z_work(:)
102 : :
103 : : integer,save,private :: slk_minsize=1
104 : : integer,save,public :: slk_communicator=xmpi_comm_null
105 : : integer,save,public :: slk_complement_communicator=xmpi_comm_null
106 : : #ifdef HAVE_LINALG_SCALAPACK
107 : : type(slk_processor_t),save,public :: slk_processor
108 : : #endif
109 : :
110 : : !Plasma can be activated via command line
111 : : !Use XPLASMA_ISON flag and modifiy it with linalg_allow_plasma
112 : : logical,private,save :: XPLASMA_ISON=.false.
113 : : public :: linalg_allow_plasma
114 : : #ifdef HAVE_LINALG_PLASMA
115 : : type(c_ptr) :: plasma_work
116 : : #endif
117 : :
118 : : integer, save, private :: abi_linalg_gpu_mode = ABI_GPU_DISABLED
119 : :
120 : : #ifdef HAVE_GPU
121 : : integer, allocatable,save,private,target :: i_work(:)
122 : : real(kind=c_double), allocatable,save,private,target :: r_work(:)
123 : : complex(kind=c_double_complex),allocatable,save,private,target :: c_work(:)
124 : : type(c_ptr),save,private :: gpu_work
125 : :
126 : : !FIXME *_managed arrays are only used with YAKL, in place of previous ones
127 : : integer(kind=c_int32_t), ABI_CONTIGUOUS pointer,save,private :: i_work_managed(:) => null()
128 : : real(kind=c_double), ABI_CONTIGUOUS pointer,save,private :: r_work_managed(:) => null()
129 : : complex(kind=c_double_complex), ABI_CONTIGUOUS pointer,save,private :: c_work_managed(:) => null()
130 : :
131 : : integer, save, private :: i_work_len = 0
132 : : integer, save, private :: r_work_len = 0
133 : : integer, save, private :: c_work_len = 0
134 : : integer(c_size_t), save, private :: gpu_work_len = 0
135 : : #endif
136 : :
137 : : !----------------------------------------------------------------------
138 : : !!***
139 : :
140 : : !Procedures ------------------------------------
141 : : public :: abi_linalg_init ! Initialization routine
142 : : public :: abi_linalg_finalize ! CleanuUp routine
143 : : public :: abi_linalg_work_allocate ! Allocate work arrays
144 : : !----------------------------------------------------------------------
145 : :
146 : : !BLAS INTERFACE
147 : : !public :: abi_zgemm
148 : : public :: abi_xgemm
149 : :
150 : : interface abi_xgemm
151 : : module procedure abi_zgemm_2d
152 : : module procedure abi_zgemm_3d
153 : : module procedure abi_zgemm_2dd
154 : : module procedure abi_d2zgemm
155 : : module procedure abi_d2zgemm_2d
156 : : module procedure abi_d2zgemm_233
157 : : module procedure abi_d2zgemm_313
158 : : module procedure abi_d2zgemm_331
159 : : module procedure abi_d2zgemm_333
160 : : module procedure abi_d2zgemm_334
161 : : end interface abi_xgemm
162 : :
163 : : interface abi_gpu_xgemm
164 : : module procedure abi_gpu_xgemm_cptr
165 : : module procedure abi_gpu_xgemm_d
166 : : module procedure abi_gpu_xgemm_z
167 : : module procedure abi_gpu_xgemm_2d
168 : : module procedure abi_gpu_xgemm_2z
169 : : end interface abi_gpu_xgemm
170 : :
171 : : public :: abi_gpu_xgemm_d
172 : :
173 : : interface abi_gpu_xgemm_strided
174 : : module procedure abi_gpu_xgemm_strided_cptr
175 : : module procedure abi_gpu_xgemm_strided_d
176 : : module procedure abi_gpu_xgemm_strided_z
177 : : module procedure abi_gpu_xgemm_strided_2d
178 : : module procedure abi_gpu_xgemm_strided_2z
179 : : end interface abi_gpu_xgemm_strided
180 : :
181 : : interface abi_gpu_xsymm
182 : : module procedure abi_gpu_xsymm_cptr
183 : : module procedure abi_gpu_xsymm_d
184 : : module procedure abi_gpu_xsymm_z
185 : : module procedure abi_gpu_xsymm_2d
186 : : module procedure abi_gpu_xsymm_2z
187 : : end interface abi_gpu_xsymm
188 : :
189 : : interface abi_gpu_zhemm
190 : : module procedure abi_gpu_zhemm_cptr
191 : : module procedure abi_gpu_zhemm_d
192 : : module procedure abi_gpu_zhemm_z
193 : : module procedure abi_gpu_zhemm_2d
194 : : module procedure abi_gpu_zhemm_2z
195 : : end interface abi_gpu_zhemm
196 : :
197 : : interface abi_gpu_xscal
198 : : module procedure abi_gpu_xscal_cptr
199 : : module procedure abi_gpu_xscal_d
200 : : module procedure abi_gpu_xscal_z
201 : : module procedure abi_gpu_xscal_2d
202 : : module procedure abi_gpu_xscal_2z
203 : : end interface abi_gpu_xscal
204 : :
205 : : interface abi_gpu_xdot
206 : : module procedure abi_gpu_xdot_cptr
207 : : module procedure abi_gpu_xdot_d
208 : : module procedure abi_gpu_xdot_z
209 : : end interface abi_gpu_xdot
210 : :
211 : : interface abi_gpu_xaxpy
212 : : module procedure abi_gpu_xaxpy_cptr
213 : : module procedure abi_gpu_xaxpy_d
214 : : module procedure abi_gpu_xaxpy_z
215 : : module procedure abi_gpu_xaxpy_2d
216 : : module procedure abi_gpu_xaxpy_2z
217 : : end interface abi_gpu_xaxpy
218 : :
219 : : interface abi_gpu_xheevd
220 : : module procedure abi_gpu_xheevd_cptr
221 : : module procedure abi_gpu_xheevd_d
222 : : module procedure abi_gpu_xheevd_z
223 : : module procedure abi_gpu_xheevd_2d
224 : : module procedure abi_gpu_xheevd_2z
225 : : end interface abi_gpu_xheevd
226 : :
227 : : interface abi_gpu_xhegvd
228 : : module procedure abi_gpu_xhegvd_cptr
229 : : module procedure abi_gpu_xhegvd_d
230 : : module procedure abi_gpu_xhegvd_z
231 : : module procedure abi_gpu_xhegvd_2d
232 : : module procedure abi_gpu_xhegvd_2z
233 : : end interface abi_gpu_xhegvd
234 : :
235 : : interface abi_gpu_xtrsm
236 : : module procedure abi_gpu_xtrsm_cptr
237 : : module procedure abi_gpu_xtrsm_d
238 : : module procedure abi_gpu_xtrsm_z
239 : : module procedure abi_gpu_xtrsm_2d
240 : : module procedure abi_gpu_xtrsm_2z
241 : : end interface abi_gpu_xtrsm
242 : :
243 : : interface abi_gpu_xpotrf
244 : : module procedure abi_gpu_xpotrf_cptr
245 : : module procedure abi_gpu_xpotrf_d
246 : : module procedure abi_gpu_xpotrf_z
247 : : module procedure abi_gpu_xpotrf_2d
248 : : module procedure abi_gpu_xpotrf_2z
249 : : end interface abi_gpu_xpotrf
250 : :
251 : : interface abi_gpu_xcopy
252 : : module procedure abi_gpu_xcopy_cptr
253 : : module procedure abi_gpu_xcopy_d
254 : : module procedure abi_gpu_xcopy_z
255 : : module procedure abi_gpu_xcopy_2d
256 : : module procedure abi_gpu_xcopy_2z
257 : : end interface abi_gpu_xcopy
258 : :
259 : : interface abi_gpu_work_resize
260 : : module procedure abi_gpu_work_resizeI
261 : : module procedure abi_gpu_work_resizeR
262 : : module procedure abi_gpu_work_resizeC
263 : : end interface abi_gpu_work_resize
264 : :
265 : : public :: abi_zgemm
266 : : public :: abi_zgemm_2d
267 : : public :: abi_zgemm_2dd
268 : : public :: abi_zgemm_2r
269 : : interface abi_zgemm ! No x_cplx stuff here!
270 : : module procedure abi_zgemm_2d
271 : : module procedure abi_zgemm_3d
272 : : module procedure abi_zgemm_2r
273 : : end interface abi_zgemm
274 : :
275 : : !----------------------------------------------------------------------
276 : : public :: abi_xscal
277 : : interface abi_xscal
278 : : module procedure abi_d2zscal
279 : : module procedure abi_d2zscal_3d
280 : : module procedure abi_d2zscal_4d
281 : : module procedure abi_d2zscal_5d
282 : : module procedure abi_d2zscal_7d
283 : : module procedure abi_dscal
284 : : module procedure abi_dscal_2d
285 : : module procedure abi_zscal
286 : : module procedure abi_zscal_2d
287 : : module procedure abi_zscal_3d
288 : : end interface abi_xscal
289 : : !----------------------------------------------------------------------
290 : : public :: abi_xaxpy
291 : : interface abi_xaxpy
292 : : module procedure abi_daxpy
293 : : module procedure abi_daxpy_2d
294 : : module procedure abi_d2zaxpy
295 : : module procedure abi_d2zaxpy_2d
296 : : module procedure abi_d2zaxpy_5d
297 : : module procedure abi_zaxpy
298 : : module procedure abi_zaxpy_2d
299 : : module procedure abi_zaxpy_3d
300 : : end interface abi_xaxpy
301 : : !----------------------------------------------------------------------
302 : : public :: abi_xcopy
303 : : interface abi_xcopy
304 : : module procedure abi_zcopy
305 : : module procedure abi_zcopy_1d
306 : : module procedure abi_zcopy_2d
307 : : module procedure abi_dcopy
308 : : module procedure abi_dcopy_1d
309 : : module procedure abi_dcopy_2d ! FIXME To be removed. One can pass the base adress of the array!
310 : : module procedure abi_dcopy_0d_1d
311 : : module procedure abi_dcopy_1d_0d
312 : : module procedure abi_d2zcopy_2d ! FIXME To be removed. One can pass the base adress of the array!
313 : : module procedure abi_z2dcopy_2d ! FIXME To be removed. One can pass the base adress of the array!
314 : : end interface abi_xcopy
315 : :
316 : : !----------------------------------------------------------------------
317 : : public :: abi_xtrsm
318 : : interface abi_xtrsm
319 : : module procedure abi_ztrsm
320 : : module procedure abi_dtrsm
321 : : module procedure abi_d2ztrsm
322 : : !module procedure abi_d2ztrsm_3d
323 : : end interface abi_xtrsm
324 : :
325 : : public :: abi_d2ztrsm_3d ! Used in bestwfk TODO to be Removed
326 : : !----------------------------------------------------------------------
327 : :
328 : : !LAPACK INTERFACE
329 : : public :: abi_xheev
330 : : interface abi_xheev
331 : : module procedure abi_dheev
332 : : module procedure abi_cheev
333 : : module procedure abi_zheev
334 : : end interface
335 : : !----------------------------------------------------------------------
336 : : public :: abi_xheevd
337 : : interface abi_xheevd
338 : : module procedure abi_d2zheevd
339 : : module procedure abi_zheevd_2d
340 : : end interface
341 : : !----------------------------------------------------------------------
342 : : public :: abi_xhegv
343 : : interface abi_xhegv
344 : : module procedure abi_dhegv
345 : : module procedure abi_chegv
346 : : module procedure abi_zhegv
347 : : end interface
348 : : !----------------------------------------------------------------------
349 : : public :: abi_xhegvd
350 : : interface abi_xhegvd
351 : : module procedure abi_d2zhegvd
352 : : module procedure abi_zhegvd_2d
353 : : end interface
354 : : !----------------------------------------------------------------------
355 : : public :: abi_xhpev
356 : : interface abi_xhpev
357 : : module procedure abi_dhpev
358 : : module procedure abi_chpev
359 : : module procedure abi_zhpev
360 : : end interface
361 : : !----------------------------------------------------------------------
362 : : public :: abi_xhpgv
363 : : interface abi_xhpgv
364 : : module procedure abi_dhpgv
365 : : module procedure abi_chpgv
366 : : module procedure abi_zhpgv
367 : : end interface
368 : : !----------------------------------------------------------------------
369 : : public :: abi_xpotrf
370 : : interface abi_xpotrf
371 : : module procedure abi_dpotrf
372 : : module procedure abi_d2zpotrf
373 : : module procedure abi_d2zpotrf_3d
374 : : module procedure abi_zpotrf_2d
375 : : module procedure abi_zpotrf
376 : : end interface
377 : : !----------------------------------------------------------------------
378 : : public :: abi_xorthonormalize
379 : : interface abi_xorthonormalize
380 : : module procedure xorthonormalize
381 : : module procedure zorthonormalize
382 : : end interface
383 : :
384 : : ! This version operates on arrays in which the real and the imaginary part
385 : : ! are packed together (real parts first, them imaginary parts), used when gamma-point and istwfk=2
386 : : public :: ortho_reim
387 : : !----------------------------------------------------------------------
388 : :
389 : : #ifndef HAVE_GPU
390 : : !dummy routines replace gpu helper routines
391 : : public :: gpu_linalg_init
392 : : public :: gpu_linalg_shutdown
393 : : public :: gpu_xgemm
394 : : public :: gpu_xtrsm
395 : : public :: gpu_xaxpy
396 : : public :: gpu_xcopy
397 : : public :: gpu_xscal
398 : : public :: gpu_xdot
399 : : public :: gpu_xsygvd
400 : : public :: gpu_xsygvd_bufferSize
401 : : #endif
402 : :
403 : : public :: gpu_xorthonormalize
404 : :
405 : : public :: abi_gpu_xgemm
406 : : public :: abi_gpu_xgemm_strided
407 : : public :: abi_gpu_xsymm
408 : : public :: abi_gpu_zhemm
409 : : public :: abi_gpu_xscal
410 : : public :: abi_gpu_xdot
411 : : public :: abi_gpu_xaxpy
412 : : public :: abi_gpu_xcopy
413 : : public :: abi_gpu_xtrsm
414 : : public :: abi_gpu_xhegvd
415 : : public :: abi_gpu_xheevd
416 : : public :: abi_gpu_xpotrf
417 : :
418 : : logical,external :: LSAME
419 : :
420 : : ! Timab slots, used if we want to profile BLAS calls
421 : : ! Fine-grained profiling, must be enabled with the CPP option DEV_LINALG_TIMING
422 : : ! For the time being, I use the same slots employed in lobpcgwf although
423 : : ! one should define specialized entries.If the index of the slot 0, no profiling is done.
424 : :
425 : : integer,parameter,private :: TIMAB_XCOPY=584
426 : : integer,parameter,private :: TIMAB_XGEMM=532
427 : : integer,parameter,private :: TIMAB_XORTHO=535
428 : : integer,parameter,private :: TIMAB_XEIGEN=587
429 : : integer,parameter,private :: TIMAB_XPRECO=536
430 : : integer,parameter,private :: TIMAB_WFCOPY=584
431 : : integer,parameter,private :: TIMAB_XTRSM=535
432 : :
433 : : ! Define this variable to activate timing routines
434 : : !#define DEV_LINALG_TIMING 1
435 : :
436 : : ! Support for [Z,C]GEMM3M routines
437 : : logical,save,private :: XGEMM3M_ISON = .False.
438 : : !logical,save,private :: XGEMM3M_ISON = .True.
439 : : ! True if [Z,C]GEMM3M can be used (can be set with linalg_allow_gemm3m)
440 : :
441 : : public :: linalg_allow_gemm3m
442 : :
443 : : ! Thresholds for the activation of [Z,C]GEMM3M
444 : : integer,parameter,private :: ZGEMM3M_LIMIT = 325000
445 : : integer,parameter,private :: CGEMM3M_LIMIT = 200000
446 : :
447 : : ! Handy macros
448 : : #ifdef HAVE_LINALG_GEMM3M
449 : : #define _ZGEMM3M ZGEMM3M
450 : : #define _CGEMM3M CGEMM3M
451 : : #else
452 : : #define _ZGEMM3M ZGEMM
453 : : #define _CGEMM3M CGEMM
454 : : #endif
455 : :
456 : :
457 : : CONTAINS !===========================================================
458 : : !!***
459 : :
460 : : !!****f* m_abi_linalg/abi_linalg_init
461 : : !! NAME
462 : : !! abi_linalg_init
463 : : !!
464 : : !! FUNCTION
465 : : !! Initalization of linear algebra environnement
466 : : !!
467 : : !! INPUTS
468 : : !! max_eigen_pb_size= max. size of eigenproblem during calculation
469 : : !! optdriver= type of calculation (ground-state, response function, GW, ...)
470 : : !! wfoptalg= wave functions optimization algorithm (CG, LOBPCG, CHEBFI, ...)
471 : : !! paral_kgb= 1 if (k,g,b) parallelism is on
472 : : !! gpu_option = GPU implementation to use, i.e. cuda, openMP, ... (0=not using GPU)
473 : : !! use_slk= 1 if use of Scalapack is on
474 : : !! np_slk= max. number of processes to be used in Scalapack calls
475 : : !! comm_scalapack= global communicator to be used in case of Scalapack
476 : : !!
477 : : !! SOURCE
478 : : !!
479 : :
480 : 5420 : subroutine abi_linalg_init(max_eigen_pb_size,optdriver,wfoptalg,paral_kgb,&
481 : : & gpu_option,use_slk,np_slk,comm_scalapack)
482 : :
483 : : !Arguments ------------------------------------
484 : : integer,intent(in) :: max_eigen_pb_size
485 : : integer,intent(in) :: optdriver,wfoptalg,paral_kgb
486 : : integer,intent(in) :: comm_scalapack,np_slk
487 : : integer,intent(in) :: gpu_option,use_slk
488 : :
489 : : !Local variables ------------------------------
490 : : integer :: max_eigen_pb_size_eff=0
491 : : logical :: need_work_space=.true.
492 : : #ifdef HAVE_LINALG_SCALAPACK
493 : : integer :: abi_info1,rank,commsize,commcart,sizecart(2)
494 : : logical :: reorder,periodic(2),keepdim(2)
495 : : #endif
496 : : #ifdef HAVE_LINALG_PLASMA
497 : : integer :: abi_info2,core_id,rank
498 : : integer :: num_cores=0,num_cores_node=0
499 : : integer,allocatable :: affinity(:)
500 : : #endif
501 : : !******************************************************************
502 : :
503 : : !Use only abi_linalg in case of GS calculations
504 : : !abi_linalg_in_use=(optdriver==RUNL_GSTATE.or.optdriver==RUNL_GWLS.or.optdriver==RUNL_RESPFN)
505 : : !abi_linalg_in_use= any(optdriver == [RUNL_GSTATE, RUNL_GWLS, RUNL_RESPFN, RUNL_GWR, RUNL_EPH])
506 [ + + + + ]: 9135 : abi_linalg_in_use= any(optdriver == [RUNL_GSTATE, RUNL_GWLS, RUNL_RESPFN, RUNL_EPH])
507 : :
508 : 5420 : max_eigen_pb_size_eff=0
509 : 5420 : lapack_single_precision=.false.
510 : 5420 : lapack_double_precision=.false.
511 : 5420 : lapack_full_storage =.false.
512 : 5420 : lapack_packed_storage =.false.
513 : 5420 : lapack_divide_conquer =.false.
514 : 5420 : eigen_s_maxsize=0 ; eigen_d_maxsize=0
515 : 5420 : eigen_c_maxsize=0 ; eigen_z_maxsize=0
516 : 5420 : eigen_s_lwork=0 ; eigen_d_lwork=0
517 : 5420 : eigen_c_lwork=0 ; eigen_z_lwork=0
518 : 5420 : eigen_c_lrwork=0 ; eigen_z_lrwork=0
519 : 5420 : eigen_liwork=0
520 : 5420 : ABI_LINALG_SCALAPACK_ISON=.False.
521 : 5420 : ABI_LINALG_MAGMA_ISON=.False.
522 : 5420 : ABI_LINALG_PLASMA_ISON=.False.
523 : 5420 : slk_communicator=xmpi_comm_null
524 : 5420 : slk_complement_communicator=xmpi_comm_null
525 : 5420 : slk_minsize=1
526 : :
527 : : !Exit here if we don't use this abi_linalg module
528 [ + + ]: 5420 : if (.not.abi_linalg_in_use) return
529 : :
530 : : !Set Lapack parameters
531 : 4935 : max_eigen_pb_size_eff=max_eigen_pb_size
532 [ + + - + ]: 4935 : if (wfoptalg==4.or.wfoptalg==14.or.gpu_option/=ABI_GPU_DISABLED) max_eigen_pb_size_eff=3*max_eigen_pb_size_eff
533 [ + + - + ]: 4935 : lapack_full_storage=(wfoptalg==4.or.wfoptalg==14.or.gpu_option/=ABI_GPU_DISABLED)
534 : 4935 : lapack_packed_storage=.true.
535 : 4935 : lapack_single_precision=.false.
536 : 4935 : lapack_double_precision=.true.
537 : 4935 : lapack_divide_conquer=.false.
538 : :
539 : : !Set maximum sizes
540 : 4935 : eigen_s_maxsize = max_eigen_pb_size_eff
541 : 4935 : eigen_d_maxsize = max_eigen_pb_size_eff
542 : 4935 : eigen_c_maxsize = max_eigen_pb_size_eff
543 : 4935 : eigen_z_maxsize = max_eigen_pb_size_eff
544 : 4935 : need_work_space=.true.
545 : :
546 : : #if defined HAVE_LINALG_SCALAPACK && defined HAVE_MPI
547 : : if ((paral_kgb==1.or.use_slk==1).and.np_slk>0) then
548 : : rank=xmpi_comm_rank(comm_scalapack)
549 : : ! We create slk_communicator using a cartesian grid, and store its complement
550 : : commsize = MIN(np_slk, xmpi_comm_size(comm_scalapack))
551 : : sizecart = (/commsize, xmpi_comm_size(comm_scalapack)/commsize/)
552 : : periodic = (/.true.,.true./) ; reorder = .false.
553 : : call MPI_CART_CREATE(comm_scalapack,2,sizecart,periodic,reorder,commcart,abi_info1)
554 : : keepdim = (/.true., .false./)
555 : : call MPI_CART_SUB(commcart, keepdim, slk_communicator,abi_info1)
556 : : keepdim = (/.false., .true./)
557 : : call MPI_CART_SUB(commcart, keepdim, slk_complement_communicator,abi_info1)
558 : : call slk_processor%init(slk_communicator)
559 : : slk_minsize=maxval(slk_processor%grid%dims(1:2))
560 : : need_work_space=(use_slk/=1) ! In this case we never use the work arrays
561 : : ABI_LINALG_SCALAPACK_ISON = .true.
562 : : end if
563 : : #else
564 : : ABI_UNUSED(comm_scalapack)
565 : : ABI_UNUSED(paral_kgb)
566 : : ABI_UNUSED(use_slk)
567 : : ABI_UNUSED(np_slk)
568 : : #endif
569 : :
570 : : !#ifdef HAVE_LINALG_ELPA
571 : : ! call elpa_func_init()
572 : : !#endif
573 : :
574 : : #ifdef HAVE_LINALG_PLASMA
575 : : !Plasma Initialization
576 : : !Because use of hybrid use of mpi+openmp+plasma,
577 : : !we need to set manually the thread bindings policy
578 : : !to avoid conflicts between mpi process due to plasma
579 : : if (XPLASMA_ISON) then
580 : : num_cores=xomp_get_max_threads()
581 : : num_cores_node=xomp_get_num_cores_node()
582 : : rank=xmpi_comm_rank(xmpi_world)
583 : : if (num_cores_node == 0) then ! This means that OMP is not enabled.
584 : : num_cores_node = 1
585 : : ABI_WARNING("You are using PLASMA but OpenMP is not enabled in Abinit!")
586 : : end if
587 : : ABI_MALLOC(affinity,(num_cores))
588 : : do core_id =1,num_cores
589 : : affinity(core_id) = MOD(rank*num_cores + (core_id-1), num_cores_node)
590 : : end do
591 : : call PLASMA_Init_Affinity(num_cores,affinity(1),abi_info2)
592 : : ABI_FREE(affinity)
593 : : ABI_LINALG_PLASMA_ISON = .True.
594 : : lapack_divide_conquer=.true.
595 : : end if
596 : : #endif
597 : :
598 : : #ifdef HAVE_LINALG_MAGMA
599 : : #ifdef HAVE_LINALG_MAGMA_15
600 : : call magmaf_init()
601 : : ABI_LINALG_MAGMA_ISON = .true.
602 : : lapack_divide_conquer=.true.
603 : : #endif
604 : : #endif
605 : :
606 : : #ifdef HAVE_GPU
607 : : !Cublas initialization
608 : : if (gpu_option/=ABI_GPU_DISABLED) call gpu_linalg_init()
609 : : abi_linalg_gpu_mode = gpu_option !FIXME Add a check for this
610 : : #endif
611 : :
612 : 4935 : if (need_work_space) call abi_linalg_work_allocate()
613 : :
614 : : end subroutine abi_linalg_init
615 : : !!***
616 : :
617 : : !!****f* m_abi_linalg/abi_linalg_work_allocate
618 : : !! NAME
619 : : !! abi_linalg_work_allocate
620 : : !!
621 : : !! FUNCTION
622 : : !!
623 : : !! INPUTS
624 : : !!
625 : : !! SOURCE
626 : : !!
627 : 4935 : subroutine abi_linalg_work_allocate()
628 : :
629 : : !Arguments ------------------------------------
630 : :
631 : : !Local variables ------------------------------
632 : : #ifdef HAVE_LINALG_MAGMA
633 : : integer :: nb, magmaf_get_ssytrd_nb, magmaf_get_dsytrd_nb, magmaf_get_chetrd_nb, magmaf_get_zhetrd_nb
634 : : #endif
635 : : !******************************************************************
636 : :
637 : : !Single precision WORK
638 : 4935 : eigen_s_lwork = 0
639 [ + - ]: 4935 : if (eigen_s_maxsize>0) then
640 [ - + ]: 4935 : if (lapack_single_precision) then
641 [ # # ]: 0 : if (lapack_full_storage) then
642 : 0 : eigen_s_lwork = max(eigen_s_lwork,3*eigen_s_maxsize-1) ! SSYEV, SSYGV
643 : : end if
644 [ # # ]: 0 : if (lapack_packed_storage) then
645 : 0 : eigen_s_lwork = max(eigen_s_lwork,3*eigen_s_maxsize) ! SSPEV[D], SSPGV[D]
646 : : end if
647 [ # # ]: 0 : if (lapack_divide_conquer) then
648 : 0 : eigen_s_lwork = max(eigen_s_lwork,1+6*eigen_s_maxsize+2*eigen_s_maxsize**2) ! SSYEVD, SSYGVD
649 : : end if
650 : : if (ABI_LINALG_MAGMA_ISON) then
651 : : if (lapack_full_storage.and.lapack_divide_conquer) then
652 : : #if defined HAVE_LINALG_MAGMA
653 : : nb=magmaf_get_ssytrd_nb(eigen_s_maxsize)
654 : : eigen_s_lwork = max(eigen_s_lwork,eigen_s_maxsize*(nb+2)) ! MAGMAF_SSYEVD, MAGMAF_SSYGVD
655 : : #endif
656 : : end if
657 : : end if
658 [ # # ]: 0 : if (ABI_LINALG_PLASMA_ISON) then
659 [ # # # # ]: 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
660 : 0 : eigen_s_lwork = max(eigen_s_lwork,eigen_s_maxsize**2) ! PLASMA_SSYEV
661 : : end if
662 : : end if
663 : : end if
664 : : end if
665 [ + + ]: 4935 : ABI_SFREE(eigen_s_work)
666 [ + - - - : 14805 : ABI_MALLOC(eigen_s_work,(eigen_s_lwork))
+ - - + -
+ - + -
+ ]
667 : :
668 : : !Double precision WORK
669 : 4935 : eigen_d_lwork = 0
670 [ + - ]: 4935 : if (eigen_d_maxsize>0) then
671 [ + - ]: 4935 : if (lapack_double_precision) then
672 [ + + ]: 4935 : if (lapack_full_storage) then
673 : 25 : eigen_d_lwork = max(eigen_d_lwork,3*eigen_d_maxsize-1) ! DSYEV, DSYGV
674 : : end if
675 [ + - ]: 4935 : if (lapack_packed_storage) then
676 : 4935 : eigen_d_lwork = max(eigen_d_lwork,3*eigen_d_maxsize) ! DSPEV[D], DSPGV[D]
677 : : end if
678 [ - + ]: 4935 : if (lapack_divide_conquer) then
679 : 0 : eigen_d_lwork = max(eigen_d_lwork,1+6*eigen_d_maxsize+2*eigen_d_maxsize**2) ! DSYEVD, DSYGVD
680 : : end if
681 : : if (ABI_LINALG_MAGMA_ISON) then
682 : : if (lapack_full_storage.and.lapack_divide_conquer) then
683 : : #if defined HAVE_LINALG_MAGMA
684 : : nb=magmaf_get_dsytrd_nb(eigen_d_maxsize)
685 : : eigen_d_lwork = max(eigen_d_lwork,eigen_d_maxsize*(nb+2)) ! MAGMAF_DSYEVD, MAGMAF_DSYGVD
686 : : #endif
687 : : end if
688 : : end if
689 [ - + ]: 4935 : if (ABI_LINALG_PLASMA_ISON) then
690 [ # # # # ]: 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
691 : 0 : eigen_d_lwork = max(eigen_d_lwork,eigen_d_maxsize**2) ! PLASMA_DSYEV
692 : : end if
693 : : end if
694 : : end if
695 : : end if
696 [ + + ]: 4935 : ABI_SFREE(eigen_d_work)
697 [ - + + - : 14805 : ABI_MALLOC(eigen_d_work,(eigen_d_lwork))
+ - + - -
+ - + -
+ ]
698 : :
699 : : !Single complex WORK
700 : 4935 : eigen_c_lwork = 0
701 [ + - ]: 4935 : if (eigen_c_maxsize>0) then
702 [ - + ]: 4935 : if (lapack_single_precision) then
703 [ # # ]: 0 : if (lapack_full_storage) then
704 : 0 : eigen_c_lwork = max(eigen_c_lwork,2*eigen_c_maxsize-1) ! CHEEV, CHEGV
705 : : end if
706 [ # # ]: 0 : if (lapack_packed_storage) then
707 : 0 : eigen_c_lwork = max(eigen_c_lwork,2*eigen_c_maxsize) ! CHPEV[D], CHPGV[D]
708 : : end if
709 [ # # ]: 0 : if (lapack_divide_conquer) then
710 : 0 : eigen_c_lwork = max(eigen_c_lwork,2*eigen_c_maxsize+eigen_c_maxsize**2) ! CHEEVD, CHEGVD
711 : : end if
712 : : if (ABI_LINALG_MAGMA_ISON) then
713 : : if (lapack_full_storage.and.lapack_divide_conquer) then
714 : : #if defined HAVE_LINALG_MAGMA
715 : : nb=magmaf_get_chetrd_nb(eigen_c_maxsize)
716 : : eigen_c_lwork = max(eigen_c_lwork,eigen_c_maxsize*(nb+1)) ! MAGMAF_CHEEVD, MAGMAF_CHEGVD
717 : : #endif
718 : : end if
719 : : end if
720 [ # # ]: 0 : if (ABI_LINALG_PLASMA_ISON) then
721 [ # # # # ]: 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
722 : 0 : eigen_c_lwork = max(eigen_c_lwork,eigen_c_maxsize**2) ! PLASMA_CHEEV
723 : : end if
724 : : end if
725 : : end if
726 : : end if
727 [ + + ]: 4935 : ABI_SFREE(eigen_c_work)
728 [ + - - - : 14805 : ABI_MALLOC(eigen_c_work,(eigen_c_lwork))
+ - - + -
+ - + -
+ ]
729 : :
730 : : !Double complex WORK
731 : 4935 : eigen_z_lwork = 0
732 [ + - ]: 4935 : if (eigen_z_maxsize>0) then
733 [ + - ]: 4935 : if (lapack_double_precision) then
734 [ + + ]: 4935 : if (lapack_full_storage) then
735 : 25 : eigen_z_lwork = max(eigen_z_lwork,2*eigen_z_maxsize-1) ! ZHEEV, ZHEGV
736 : : end if
737 [ + - ]: 4935 : if (lapack_packed_storage) then
738 : 4935 : eigen_z_lwork = max(eigen_z_lwork,2*eigen_z_maxsize) ! ZHPEV[D], ZHPGV[D]
739 : : end if
740 [ - + ]: 4935 : if (lapack_divide_conquer) then
741 : 0 : eigen_z_lwork = max(eigen_z_lwork,2*eigen_z_maxsize+eigen_z_maxsize**2) ! ZHEEVD, ZHEGVD
742 : : end if
743 : : if (ABI_LINALG_MAGMA_ISON) then
744 : : if (lapack_full_storage.and.lapack_divide_conquer) then
745 : : #if defined HAVE_LINALG_MAGMA
746 : : nb=magmaf_get_zhetrd_nb(eigen_z_maxsize)
747 : : eigen_z_lwork = max(eigen_z_lwork,eigen_z_maxsize*(nb+1)) ! MAGMAF_ZHEEVD, MAGMAF_ZHEGVD
748 : : #endif
749 : : end if
750 : : end if
751 [ - + ]: 4935 : if (ABI_LINALG_PLASMA_ISON) then
752 [ # # # # ]: 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
753 : 0 : eigen_z_lwork = max(eigen_z_lwork,eigen_z_maxsize**2) ! PLASMA_ZHEEV
754 : : end if
755 : : end if
756 : : end if
757 : : end if
758 [ + + ]: 4935 : ABI_SFREE(eigen_z_work)
759 [ - + + - : 14805 : ABI_MALLOC(eigen_z_work,(eigen_z_lwork))
+ - + - -
+ - + -
+ ]
760 : :
761 : : !Single precision RWORK
762 : 4935 : eigen_c_lrwork = 0
763 [ + - ]: 4935 : if (eigen_c_maxsize>0) then
764 [ - + ]: 4935 : if (lapack_single_precision) then
765 [ # # # # ]: 0 : if (lapack_full_storage.or.lapack_packed_storage) then
766 : 0 : eigen_c_lrwork = max(eigen_c_lrwork,3*eigen_c_maxsize-2) ! CHEEV, CHEGV, CHPEV, CHPGV
767 : : end if
768 [ # # ]: 0 : if (lapack_divide_conquer) then
769 : 0 : eigen_c_lrwork = max(eigen_c_lrwork,1+5*eigen_c_maxsize+2*eigen_c_maxsize**2) ! CHEEVD, CHEGVD, CHPEVD, CHPGVD
770 : : end if
771 : : end if
772 : : end if
773 [ + + ]: 4935 : ABI_SFREE(eigen_c_rwork)
774 [ + - - - : 14805 : ABI_MALLOC(eigen_c_rwork,(eigen_c_lrwork))
+ - - + -
+ - + -
+ ]
775 : :
776 : : !Double precision RWORK
777 : 4935 : eigen_z_lrwork = 0
778 [ + - ]: 4935 : if (eigen_z_maxsize>0) then
779 [ + - ]: 4935 : if (lapack_double_precision) then
780 [ + + + - ]: 4935 : if (lapack_full_storage.or.lapack_packed_storage) then
781 : 4935 : eigen_z_lrwork = max(eigen_z_lrwork,3*eigen_z_maxsize-2) ! ZHEEV, ZHEGV, ZHPEV, ZHPGV
782 : : end if
783 [ - + ]: 4935 : if (lapack_divide_conquer) then
784 : 0 : eigen_z_lrwork = max(eigen_z_lrwork,1+5*eigen_z_maxsize+2*eigen_z_maxsize**2) ! ZHEEVD, ZHEGVD, ZHPEVD, ZHPGVD
785 : : end if
786 : : end if
787 : : end if
788 [ + + ]: 4935 : ABI_SFREE(eigen_z_rwork)
789 [ - + + - : 14805 : ABI_MALLOC(eigen_z_rwork,(eigen_z_lrwork))
+ - + - -
+ - + -
+ ]
790 : :
791 : : !Integer IWORK
792 : 4935 : eigen_liwork = 0
793 [ - + ]: 4935 : if (lapack_divide_conquer) then
794 [ # # ]: 0 : if (lapack_single_precision) then
795 [ # # ]: 0 : if (eigen_s_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_s_maxsize)
796 [ # # ]: 0 : if (eigen_c_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_c_maxsize)
797 : : end if
798 [ # # ]: 0 : if (lapack_double_precision) then
799 [ # # ]: 0 : if (eigen_d_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_d_maxsize)
800 [ # # ]: 0 : if (eigen_z_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_z_maxsize)
801 : : end if
802 : : end if
803 [ + + ]: 4935 : ABI_SFREE(eigen_iwork)
804 [ + - - - : 14805 : ABI_MALLOC(eigen_iwork,(eigen_liwork))
+ - - + -
+ - + -
+ ]
805 : :
806 : 4935 : end subroutine abi_linalg_work_allocate
807 : : !!***
808 : :
809 : : !!****f* m_abi_linalg/abi_linalg_finalize
810 : : !! NAME
811 : : !! abi_linalg_finalize
812 : : !!
813 : : !! FUNCTION
814 : : !!
815 : : !! INPUTS
816 : : !!
817 : : !! SOURCE
818 : : !!
819 : 5419 : subroutine abi_linalg_finalize(gpu_option)
820 : :
821 : : !Arguments ------------------------------------
822 : : integer, intent(in) :: gpu_option
823 : : !Local variables ------------------------------
824 : : #ifdef HAVE_LINALG_PLASMA
825 : : integer :: info
826 : : #endif
827 : : !******************************************************************
828 : :
829 [ + + ]: 5419 : if (.not.abi_linalg_in_use) return
830 : :
831 : 4935 : eigen_s_maxsize = 0
832 : 4935 : eigen_d_maxsize = 0
833 : 4935 : eigen_c_maxsize = 0
834 : 4935 : eigen_z_maxsize = 0
835 : 4935 : eigen_s_lwork = 0
836 : 4935 : eigen_d_lwork = 0
837 : 4935 : eigen_c_lwork = 0
838 : 4935 : eigen_z_lwork = 0
839 : 4935 : eigen_c_lrwork = 0
840 : 4935 : eigen_z_lrwork = 0
841 : 4935 : eigen_liwork = 0
842 : :
843 : 4935 : lapack_full_storage=.False.
844 : 4935 : lapack_packed_storage=.False.
845 : 4935 : lapack_single_precision=.False.
846 : 4935 : lapack_double_precision=.False.
847 : 4935 : lapack_divide_conquer=.false.
848 : :
849 : : #ifdef HAVE_LINALG_SCALAPACK
850 : : if (ABI_LINALG_SCALAPACK_ISON) then
851 : : call slk_processor%free()
852 : : call xmpi_comm_free(slk_communicator)
853 : : call xmpi_comm_free(slk_complement_communicator)
854 : : slk_communicator=xmpi_comm_null
855 : : slk_complement_communicator=xmpi_comm_null
856 : : slk_minsize=1
857 : : end if
858 : : #endif
859 : :
860 : : !#ifdef HAVE_LINALG_ELPA
861 : : ! call elpa_func_uninit()
862 : : !#endif
863 : :
864 : : #ifdef HAVE_LINALG_PLASMA
865 : : call PLASMA_Finalize(info)
866 : : ABI_LINALG_PLASMA_ISON=.False.
867 : : end if
868 : : #endif
869 : :
870 : : #ifdef HAVE_LINALG_MAGMA
871 : : #ifdef HAVE_LINALG_MAGMA_15
872 : : if (ABI_LINALG_MAGMA_ISON) then
873 : : call magmaf_finalize()
874 : : end if
875 : : #endif
876 : : #endif
877 : :
878 : : #ifdef HAVE_GPU
879 : : if (gpu_option/=ABI_GPU_DISABLED) then
880 : : call abi_gpu_work_finalize()
881 : : call gpu_linalg_shutdown()
882 : : end if
883 : : abi_linalg_gpu_mode = ABI_GPU_DISABLED
884 : : #else
885 : : ABI_UNUSED(gpu_option)
886 : : #endif
887 : :
888 : : !Memory freeing
889 [ + + ]: 4935 : ABI_SFREE(eigen_s_work)
890 [ + + ]: 4935 : ABI_SFREE(eigen_d_work)
891 [ + + ]: 4935 : ABI_SFREE(eigen_c_work)
892 [ + + ]: 4935 : ABI_SFREE(eigen_z_work)
893 [ + + ]: 4935 : ABI_SFREE(eigen_c_rwork)
894 [ + + ]: 4935 : ABI_SFREE(eigen_z_rwork)
895 [ + + ]: 4935 : ABI_SFREE(eigen_iwork)
896 : :
897 : : end subroutine abi_linalg_finalize
898 : : !!***
899 : :
900 : : !----------------------------------------------------------------------
901 : :
902 : : !!****f* m_abi_linalg/linalg_allow_gemm3m
903 : : !! NAME
904 : : !!
905 : : !! FUNCTION
906 : : !! Programmatic interface to enable the use of [Z,C]GEMM3M calls
907 : : !!
908 : : !! SOURCE
909 : :
910 : 0 : subroutine linalg_allow_gemm3m(bool, write_msg)
911 : :
912 : : !Arguments ------------------------------------
913 : : logical,intent(in) :: bool, write_msg
914 : : ! *************************************************************************
915 : :
916 : 0 : XGEMM3M_ISON = bool
917 [ # # ]: 0 : if (write_msg) then
918 : : #ifdef HAVE_LINALG_GEMM3M
919 [ # # ]: 0 : if (bool) then
920 : 0 : ABI_COMMENT("Activating ZGEMM3M version instead of ZGEMM")
921 : : else
922 : 0 : ABI_COMMENT("Using ZGEMM instead of ZGEMM3M")
923 : : end if
924 : : #else
925 : : if (bool) then
926 : : ABI_WARNING("Cannot activate ZGEMM3M as HAVE_LINALG_GEMM3M is not defined!")
927 : : end if
928 : : #endif
929 : : endif
930 : :
931 : 0 : end subroutine linalg_allow_gemm3m
932 : : !!***
933 : :
934 : : !----------------------------------------------------------------------
935 : :
936 : : !!****f* m_abi_linalg/use_zgemm3m
937 : : !! NAME
938 : : !! use_zgemm3m
939 : : !!
940 : : !! FUNCTION
941 : : !! Enable the use of ZGEMM3M
942 : : !!
943 : : !! NOTES
944 : : !! The CGEMM3M and ZGEMM3M routines use an algorithm requiring 3 real matrix
945 : : !! multiplications and 5 real matrix additions to compute the complex matrix
946 : : !! product; CGEMM(3S) and ZGEMM(3S) use 4 real matrix multiplications and 2
947 : : !! real matrix additions. Because the matrix multiplication time is usually
948 : : !! the limiting performance factor in these routines, CGEMM3M and ZGEMM3M
949 : : !! may run up to 33 percent faster than CGEMM and ZGEMM. Because of other
950 : : !! overhead associated with the 3M routines, however, these performance
951 : : !! improvements may not always be realized. For example, on one processor
952 : : !! the 3M routines will generally run more slowly than the standard complex
953 : : !! matrix multiplication routines when m * n * k < FACTOR, where m, n, and k
954 : : !! are the input matrix dimensions and FACTOR is approximately 200000 for
955 : : !! CGEMM3M and 325000 for ZGEMM3M.
956 : : !! from: http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0650&db=man&raw=1&fname=/usr/share/catman/p_man/cat3/SCSL/ZGEMM3M.z
957 : : !!
958 : : !! SOURCE
959 : :
960 : 177365149 : pure logical function use_zgemm3m(m, n, k)
961 : :
962 : : !Arguments ------------------------------------
963 : : integer,intent(in) :: m,n,k
964 : : ! *************************************************************************
965 : :
966 : 177365149 : use_zgemm3m = .False.
967 [ - + - - : 177365149 : if (XGEMM3M_ISON) use_zgemm3m = ((m * n * k) > ZGEMM3M_LIMIT)
- + - - ]
968 : : !if (XGEMM3M_ISON) use_zgemm3m = .True.
969 : :
970 : : #ifndef HAVE_LINALG_GEMM3M
971 : : use_zgemm3m = .False.
972 : : #endif
973 : :
974 : : end function use_zgemm3m
975 : : !!***
976 : :
977 : : !----------------------------------------------------------------------
978 : :
979 : : !!****f* m_abi_linalg/use_cgemm3m
980 : : !! NAME
981 : : !! use_cgemm3m
982 : : !!
983 : : !! FUNCTION
984 : : !! Enable the use of CGEMM3M
985 : : !!
986 : : !! NOTES
987 : : !! See use_zgemm3m
988 : : !!
989 : : !! SOURCE
990 : :
991 : : pure logical function use_cgemm3m(m, n, k)
992 : :
993 : : !Arguments ------------------------------------
994 : : integer,intent(in) :: m,n,k
995 : : ! *************************************************************************
996 : :
997 : : use_cgemm3m = .False.
998 : : if (XGEMM3M_ISON) use_cgemm3m = ((m * n * k) > CGEMM3M_LIMIT)
999 : : #ifndef HAVE_LINALG_GEMM3M
1000 : : use_cgemm3m = .False.
1001 : : #endif
1002 : :
1003 : : end function use_cgemm3m
1004 : : !!***
1005 : :
1006 : : !----------------------------------------------------------------------
1007 : :
1008 : : !!****f* m_abi_linalg/linalg_allow_plasma
1009 : : !! NAME
1010 : : !!
1011 : : !! FUNCTION
1012 : : !! Programmatic interface to enable the use of PLASMA
1013 : : !! False to disable PLASMA version.
1014 : : !!
1015 : : !! SOURCE
1016 : :
1017 : 0 : subroutine linalg_allow_plasma(bool)
1018 : :
1019 : : !Arguments ------------------------------------
1020 : : logical,intent(in) :: bool
1021 : : ! *************************************************************************
1022 : :
1023 : : XPLASMA_ISON = bool
1024 : : #ifndef HAVE_LINALG_PLASMA
1025 : : ! Just to be on the safe-side.
1026 : : ! I have to use a weird set of branches to make abirules happy in the BLAS/LAPACK
1027 : : ! wrappers, and one cannot set XPLASMA_MODE to .True. if PLASMA is not available.
1028 : 0 : XPLASMA_ISON = .False.
1029 : : #endif
1030 : :
1031 : 0 : end subroutine linalg_allow_plasma
1032 : : !!***
1033 : :
1034 : : #ifdef HAVE_LINALG_PLASMA
1035 : :
1036 : : !!****f* m_abi_linalg/uplo_plasma
1037 : : !! NAME
1038 : : !!
1039 : : !! FUNCTION
1040 : : !! Convert uplo character to PLASMA integer
1041 : : !!
1042 : : !! SOURCE
1043 : :
1044 : : integer function uplo_plasma(uplo)
1045 : :
1046 : : !Arguments ------------------------------------
1047 : : character(len=1),intent(in) :: uplo
1048 : : ! *************************************************************************
1049 : :
1050 : : if (LSAME(uplo,'U')) then
1051 : : uplo_plasma = PlasmaUpper
1052 : : else
1053 : : uplo_plasma = PlasmaLower
1054 : : end if
1055 : :
1056 : : end function uplo_plasma
1057 : : !!***
1058 : :
1059 : : !----------------------------------------------------------------------
1060 : :
1061 : : !!****f* m_abi_linalg/trans_plasma
1062 : : !! NAME
1063 : : !!
1064 : : !! FUNCTION
1065 : : !! Convert trans character to PLASMA integer
1066 : : !!
1067 : : !! SOURCE
1068 : :
1069 : : integer function trans_plasma(trans)
1070 : :
1071 : : !Arguments ------------------------------------
1072 : : character(len=1),intent(in) :: trans
1073 : : ! *************************************************************************
1074 : :
1075 : : if (LSAME(trans,'C')) then
1076 : : trans_plasma = PlasmaConjTrans
1077 : : else if (LSAME(trans,'T')) then
1078 : : trans_plasma = PlasmaTrans
1079 : : else
1080 : : trans_plasma = PlasmaNoTrans
1081 : : end if
1082 : :
1083 : : end function trans_plasma
1084 : : !!***
1085 : :
1086 : : !----------------------------------------------------------------------
1087 : :
1088 : : !!****f* m_abi_linalg/side_plasma
1089 : : !! NAME
1090 : : !!
1091 : : !! FUNCTION
1092 : : !! Convert side character to PLASMA integer
1093 : : !!
1094 : : !! SOURCE
1095 : :
1096 : : integer function side_plasma(side)
1097 : :
1098 : : !Arguments ------------------------------------
1099 : : character(len=1),intent(in) :: side
1100 : : ! *************************************************************************
1101 : :
1102 : : if(LSAME(side,'L')) then
1103 : : side_plasma = PlasmaLeft
1104 : : else
1105 : : side_plasma = PlasmaRight
1106 : : end if
1107 : :
1108 : : end function side_plasma
1109 : : !!***
1110 : :
1111 : : !----------------------------------------------------------------------
1112 : :
1113 : : !!****f* m_abi_linalg/diag_plasma
1114 : : !! NAME
1115 : : !!
1116 : : !! FUNCTION
1117 : : !! Convert diag character to PLASMA integer
1118 : : !!
1119 : : !! SOURCE
1120 : :
1121 : : integer function diag_plasma(diag)
1122 : :
1123 : : !Arguments ------------------------------------
1124 : : character(len=1),intent(in) :: diag
1125 : : ! *************************************************************************
1126 : :
1127 : : if (LSAME(diag,'U')) then
1128 : : diag_plasma = PlasmaUnit
1129 : : else
1130 : : diag_plasma = PlasmaNonUnit
1131 : : end if
1132 : :
1133 : : end function diag_plasma
1134 : : !!***
1135 : :
1136 : : !----------------------------------------------------------------------
1137 : :
1138 : : !!****f* m_abi_linalg/jobz_plasma
1139 : : !! NAME
1140 : : !!
1141 : : !! FUNCTION
1142 : : !! Convert jobz character to PLASMA integer
1143 : : !!
1144 : : !! SOURCE
1145 : :
1146 : : integer function jobz_plasma(jobz)
1147 : :
1148 : : !Arguments ------------------------------------
1149 : : character(len=1),intent(in) :: jobz
1150 : : ! *************************************************************************
1151 : :
1152 : : if (LSAME(jobz,'N')) then
1153 : : jobz_plasma = PlasmaNoVec
1154 : : else
1155 : : jobz_plasma = PlasmaVec
1156 : : end if
1157 : :
1158 : : end function jobz_plasma
1159 : : !!***
1160 : :
1161 : : #endif
1162 : :
1163 : : ! Include files providing wrappers for some of the most commonly used BLAS & LAPACK routines
1164 : :
1165 : : ! *********************************************************************!
1166 : : ! ******************* BLAS_XGEMM interface ****************************!
1167 : : ! *********************************************************************!
1168 : : #include "abi_xgemm.f90"
1169 : :
1170 : : ! *********************************************************************!
1171 : : ! ******************** BLAS_XSCAL interface ***************************!
1172 : : ! *********************************************************************!
1173 : : #include "abi_xscal.f90"
1174 : :
1175 : : ! *********************************************************************!
1176 : : ! ******************** BLAS_XAXPY interface ***************************!
1177 : : ! *********************************************************************!
1178 : : #include "abi_xaxpy.f90"
1179 : :
1180 : : ! *********************************************************************!
1181 : : ! ******************** BLAS_XCOPY interface ***************************!
1182 : : ! *********************************************************************!
1183 : : #include "abi_xcopy.f90"
1184 : :
1185 : : ! *********************************************************************!
1186 : : ! ******************** BLAS_XTRSM interface ***************************!
1187 : : ! *********************************************************************!
1188 : : #include "abi_xtrsm.f90"
1189 : :
1190 : : ! *********************************************************************!
1191 : : ! ********************* LAPACK XHEEV interface ***********************!
1192 : : ! *********************************************************************!
1193 : : #include "abi_xheev.f90"
1194 : :
1195 : : ! *********************************************************************!
1196 : : ! ********************* LAPACK XHEGV interface ***********************!
1197 : : ! *********************************************************************!
1198 : : #include "abi_xhegv.f90"
1199 : :
1200 : : ! *********************************************************************!
1201 : : ! ********************* LAPACK XHPEV interface ***********************!
1202 : : ! *********************************************************************!
1203 : : #include "abi_xhpev.f90"
1204 : :
1205 : : ! *********************************************************************!
1206 : : ! ********************* LAPACK XHPGV interface ***********************!
1207 : : ! *********************************************************************!
1208 : : #include "abi_xhpgv.f90"
1209 : :
1210 : : ! *********************************************************************!
1211 : : ! ****************** LAPACK XPOTRF interface *************************!
1212 : : ! *********************************************************************!
1213 : : #include "abi_xpotrf.f90"
1214 : :
1215 : : ! *********************************************************************!
1216 : : ! ************ ABINIT Orthonormalization interface *******************!
1217 : : ! *********************************************************************!
1218 : : #include "abi_xorthonormalize.f90"
1219 : :
1220 : : ! *********************************************************************!
1221 : : ! ****************** GPU LINALG interface *************************!
1222 : : ! *********************************************************************!
1223 : : #include "abi_gpu_linalg.f90"
1224 : :
1225 : : !----------------------------------------------------------------------
1226 : :
1227 : : end module m_abi_linalg
1228 : : !!***
|
