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_dcopy
307 : module procedure abi_dcopy_1d
308 : module procedure abi_dcopy_2d ! FIXME To be removed. One can pass the base adress of the array!
309 : module procedure abi_dcopy_0d_1d
310 : module procedure abi_dcopy_1d_0d
311 : module procedure abi_d2zcopy_2d ! FIXME To be removed. One can pass the base adress of the array!
312 : module procedure abi_z2dcopy_2d ! FIXME To be removed. One can pass the base adress of the array!
313 : end interface abi_xcopy
314 :
315 : !----------------------------------------------------------------------
316 : public :: abi_xtrsm
317 : interface abi_xtrsm
318 : module procedure abi_ztrsm
319 : module procedure abi_dtrsm
320 : module procedure abi_d2ztrsm
321 : !module procedure abi_d2ztrsm_3d
322 : end interface abi_xtrsm
323 :
324 : public :: abi_d2ztrsm_3d ! Used in bestwfk TODO to be Removed
325 : !----------------------------------------------------------------------
326 :
327 : !LAPACK INTERFACE
328 : public :: abi_xheev
329 : interface abi_xheev
330 : module procedure abi_dheev
331 : module procedure abi_cheev
332 : module procedure abi_zheev
333 : end interface
334 : !----------------------------------------------------------------------
335 : public :: abi_xheevd
336 : interface abi_xheevd
337 : module procedure abi_d2zheevd
338 : module procedure abi_zheevd_2d
339 : end interface
340 : !----------------------------------------------------------------------
341 : public :: abi_xhegv
342 : interface abi_xhegv
343 : module procedure abi_dhegv
344 : module procedure abi_chegv
345 : module procedure abi_zhegv
346 : end interface
347 : !----------------------------------------------------------------------
348 : public :: abi_xhegvd
349 : interface abi_xhegvd
350 : module procedure abi_d2zhegvd
351 : module procedure abi_zhegvd_2d
352 : end interface
353 : !----------------------------------------------------------------------
354 : public :: abi_xhpev
355 : interface abi_xhpev
356 : module procedure abi_dhpev
357 : module procedure abi_chpev
358 : module procedure abi_zhpev
359 : end interface
360 : !----------------------------------------------------------------------
361 : public :: abi_xhpgv
362 : interface abi_xhpgv
363 : module procedure abi_dhpgv
364 : module procedure abi_chpgv
365 : module procedure abi_zhpgv
366 : end interface
367 : !----------------------------------------------------------------------
368 : public :: abi_xpotrf
369 : interface abi_xpotrf
370 : module procedure abi_dpotrf
371 : module procedure abi_d2zpotrf
372 : module procedure abi_d2zpotrf_3d
373 : module procedure abi_zpotrf_2d
374 : module procedure abi_zpotrf
375 : end interface
376 : !----------------------------------------------------------------------
377 : public :: abi_xorthonormalize
378 : interface abi_xorthonormalize
379 : module procedure xorthonormalize
380 : module procedure zorthonormalize
381 : end interface
382 :
383 : ! This version operates on arrays in which the real and the imaginary part
384 : ! are packed together (real parts first, them imaginary parts), used when gamma-point and istwfk=2
385 : public :: ortho_reim
386 : !----------------------------------------------------------------------
387 :
388 : #ifndef HAVE_GPU
389 : !dummy routines replace gpu helper routines
390 : public :: gpu_linalg_init
391 : public :: gpu_linalg_shutdown
392 : public :: gpu_xgemm
393 : public :: gpu_xtrsm
394 : public :: gpu_xaxpy
395 : public :: gpu_xcopy
396 : public :: gpu_xscal
397 : public :: gpu_xdot
398 : public :: gpu_xsygvd
399 : public :: gpu_xsygvd_bufferSize
400 : #endif
401 :
402 : public :: gpu_xorthonormalize
403 :
404 : public :: abi_gpu_xgemm
405 : public :: abi_gpu_xgemm_strided
406 : public :: abi_gpu_xsymm
407 : public :: abi_gpu_zhemm
408 : public :: abi_gpu_xscal
409 : public :: abi_gpu_xdot
410 : public :: abi_gpu_xaxpy
411 : public :: abi_gpu_xcopy
412 : public :: abi_gpu_xtrsm
413 : public :: abi_gpu_xhegvd
414 : public :: abi_gpu_xheevd
415 : public :: abi_gpu_xpotrf
416 :
417 : logical,external :: LSAME
418 :
419 : ! Timab slots, used if we want to profile BLAS calls
420 : ! Fine-grained profiling, must be enabled with the CPP option DEV_LINALG_TIMING
421 : ! For the time being, I use the same slots employed in lobpcgwf although
422 : ! one should define specialized entries.If the index of the slot 0, no profiling is done.
423 :
424 : integer,parameter,private :: TIMAB_XCOPY=584
425 : integer,parameter,private :: TIMAB_XGEMM=532
426 : integer,parameter,private :: TIMAB_XORTHO=535
427 : integer,parameter,private :: TIMAB_XEIGEN=587
428 : integer,parameter,private :: TIMAB_XPRECO=536
429 : integer,parameter,private :: TIMAB_WFCOPY=584
430 : integer,parameter,private :: TIMAB_XTRSM=535
431 :
432 : ! Define this variable to activate timing routines
433 : !#define DEV_LINALG_TIMING 1
434 :
435 : ! Support for [Z,C]GEMM3M routines
436 : logical,save,private :: XGEMM3M_ISON = .False.
437 : !logical,save,private :: XGEMM3M_ISON = .True.
438 : ! True if [Z,C]GEMM3M can be used (can be set with linalg_allow_gemm3m)
439 :
440 : public :: linalg_allow_gemm3m
441 :
442 : ! Thresholds for the activation of [Z,C]GEMM3M
443 : integer,parameter,private :: ZGEMM3M_LIMIT = 325000
444 : integer,parameter,private :: CGEMM3M_LIMIT = 200000
445 :
446 : ! Handy macros
447 : #ifdef HAVE_LINALG_GEMM3M
448 : #define _ZGEMM3M ZGEMM3M
449 : #define _CGEMM3M CGEMM3M
450 : #else
451 : #define _ZGEMM3M ZGEMM
452 : #define _CGEMM3M CGEMM
453 : #endif
454 :
455 :
456 : CONTAINS !===========================================================
457 : !!***
458 :
459 : !!****f* m_abi_linalg/abi_linalg_init
460 : !! NAME
461 : !! abi_linalg_init
462 : !!
463 : !! FUNCTION
464 : !! Initalization of linear algebra environnement
465 : !!
466 : !! INPUTS
467 : !! max_eigen_pb_size= max. size of eigenproblem during calculation
468 : !! optdriver= type of calculation (ground-state, response function, GW, ...)
469 : !! wfoptalg= wave functions optimization algorithm (CG, LOBPCG, CHEBFI, ...)
470 : !! paral_kgb= 1 if (k,g,b) parallelism is on
471 : !! gpu_option = GPU implementation to use, i.e. cuda, openMP, ... (0=not using GPU)
472 : !! use_slk= 1 if use of Scalapack is on
473 : !! np_slk= max. number of processes to be used in Scalapack calls
474 : !! comm_scalapack= global communicator to be used in case of Scalapack
475 : !!
476 : !! SOURCE
477 : !!
478 :
479 5412 : subroutine abi_linalg_init(max_eigen_pb_size,optdriver,wfoptalg,paral_kgb,&
480 : & gpu_option,use_slk,np_slk,comm_scalapack)
481 :
482 : !Arguments ------------------------------------
483 : integer,intent(in) :: max_eigen_pb_size
484 : integer,intent(in) :: optdriver,wfoptalg,paral_kgb
485 : integer,intent(in) :: comm_scalapack,np_slk
486 : integer,intent(in) :: gpu_option,use_slk
487 :
488 : !Local variables ------------------------------
489 : integer :: max_eigen_pb_size_eff=0
490 : logical :: need_work_space=.true.
491 : #ifdef HAVE_LINALG_SCALAPACK
492 : integer :: abi_info1,rank,commsize,commcart,sizecart(2)
493 : logical :: reorder,periodic(2),keepdim(2)
494 : #endif
495 : #ifdef HAVE_LINALG_PLASMA
496 : integer :: abi_info2,core_id,rank
497 : integer :: num_cores=0,num_cores_node=0
498 : integer,allocatable :: affinity(:)
499 : #endif
500 : !******************************************************************
501 :
502 : !Use only abi_linalg in case of GS calculations
503 : !abi_linalg_in_use=(optdriver==RUNL_GSTATE.or.optdriver==RUNL_GWLS.or.optdriver==RUNL_RESPFN)
504 : !abi_linalg_in_use= any(optdriver == [RUNL_GSTATE, RUNL_GWLS, RUNL_RESPFN, RUNL_GWR, RUNL_EPH])
505 9119 : abi_linalg_in_use= any(optdriver == [RUNL_GSTATE, RUNL_GWLS, RUNL_RESPFN, RUNL_EPH])
506 :
507 5412 : max_eigen_pb_size_eff=0
508 5412 : lapack_single_precision=.false.
509 5412 : lapack_double_precision=.false.
510 5412 : lapack_full_storage =.false.
511 5412 : lapack_packed_storage =.false.
512 5412 : lapack_divide_conquer =.false.
513 5412 : eigen_s_maxsize=0 ; eigen_d_maxsize=0
514 5412 : eigen_c_maxsize=0 ; eigen_z_maxsize=0
515 5412 : eigen_s_lwork=0 ; eigen_d_lwork=0
516 5412 : eigen_c_lwork=0 ; eigen_z_lwork=0
517 5412 : eigen_c_lrwork=0 ; eigen_z_lrwork=0
518 5412 : eigen_liwork=0
519 5412 : ABI_LINALG_SCALAPACK_ISON=.False.
520 5412 : ABI_LINALG_MAGMA_ISON=.False.
521 5412 : ABI_LINALG_PLASMA_ISON=.False.
522 5412 : slk_communicator=xmpi_comm_null
523 5412 : slk_complement_communicator=xmpi_comm_null
524 5412 : slk_minsize=1
525 :
526 : !Exit here if we don't use this abi_linalg module
527 5412 : if (.not.abi_linalg_in_use) return
528 :
529 : !Set Lapack parameters
530 4927 : max_eigen_pb_size_eff=max_eigen_pb_size
531 4927 : if (wfoptalg==4.or.wfoptalg==14.or.gpu_option/=ABI_GPU_DISABLED) max_eigen_pb_size_eff=3*max_eigen_pb_size_eff
532 4927 : lapack_full_storage=(wfoptalg==4.or.wfoptalg==14.or.gpu_option/=ABI_GPU_DISABLED)
533 4927 : lapack_packed_storage=.true.
534 4927 : lapack_single_precision=.false.
535 4927 : lapack_double_precision=.true.
536 4927 : lapack_divide_conquer=.false.
537 :
538 : !Set maximum sizes
539 4927 : eigen_s_maxsize = max_eigen_pb_size_eff
540 4927 : eigen_d_maxsize = max_eigen_pb_size_eff
541 4927 : eigen_c_maxsize = max_eigen_pb_size_eff
542 4927 : eigen_z_maxsize = max_eigen_pb_size_eff
543 4927 : need_work_space=.true.
544 :
545 : #if defined HAVE_LINALG_SCALAPACK && defined HAVE_MPI
546 : if ((paral_kgb==1.or.use_slk==1).and.np_slk>0) then
547 : rank=xmpi_comm_rank(comm_scalapack)
548 : ! We create slk_communicator using a cartesian grid, and store its complement
549 : commsize = MIN(np_slk, xmpi_comm_size(comm_scalapack))
550 : sizecart = (/commsize, xmpi_comm_size(comm_scalapack)/commsize/)
551 : periodic = (/.true.,.true./) ; reorder = .false.
552 : call MPI_CART_CREATE(comm_scalapack,2,sizecart,periodic,reorder,commcart,abi_info1)
553 : keepdim = (/.true., .false./)
554 : call MPI_CART_SUB(commcart, keepdim, slk_communicator,abi_info1)
555 : keepdim = (/.false., .true./)
556 : call MPI_CART_SUB(commcart, keepdim, slk_complement_communicator,abi_info1)
557 : call slk_processor%init(slk_communicator)
558 : slk_minsize=maxval(slk_processor%grid%dims(1:2))
559 : need_work_space=(use_slk/=1) ! In this case we never use the work arrays
560 : ABI_LINALG_SCALAPACK_ISON = .true.
561 : end if
562 : #else
563 : ABI_UNUSED(comm_scalapack)
564 : ABI_UNUSED(paral_kgb)
565 : ABI_UNUSED(use_slk)
566 : ABI_UNUSED(np_slk)
567 : #endif
568 :
569 : !#ifdef HAVE_LINALG_ELPA
570 : ! call elpa_func_init()
571 : !#endif
572 :
573 : #ifdef HAVE_LINALG_PLASMA
574 : !Plasma Initialization
575 : !Because use of hybrid use of mpi+openmp+plasma,
576 : !we need to set manually the thread bindings policy
577 : !to avoid conflicts between mpi process due to plasma
578 : if (XPLASMA_ISON) then
579 : num_cores=xomp_get_max_threads()
580 : num_cores_node=xomp_get_num_cores_node()
581 : rank=xmpi_comm_rank(xmpi_world)
582 : if (num_cores_node == 0) then ! This means that OMP is not enabled.
583 : num_cores_node = 1
584 : ABI_WARNING("You are using PLASMA but OpenMP is not enabled in Abinit!")
585 : end if
586 : ABI_MALLOC(affinity,(num_cores))
587 : do core_id =1,num_cores
588 : affinity(core_id) = MOD(rank*num_cores + (core_id-1), num_cores_node)
589 : end do
590 : call PLASMA_Init_Affinity(num_cores,affinity(1),abi_info2)
591 : ABI_FREE(affinity)
592 : ABI_LINALG_PLASMA_ISON = .True.
593 : lapack_divide_conquer=.true.
594 : end if
595 : #endif
596 :
597 : #ifdef HAVE_LINALG_MAGMA
598 : #ifdef HAVE_LINALG_MAGMA_15
599 : call magmaf_init()
600 : ABI_LINALG_MAGMA_ISON = .true.
601 : lapack_divide_conquer=.true.
602 : #endif
603 : #endif
604 :
605 : #ifdef HAVE_GPU
606 : !Cublas initialization
607 : if (gpu_option/=ABI_GPU_DISABLED) call gpu_linalg_init()
608 : abi_linalg_gpu_mode = gpu_option !FIXME Add a check for this
609 : #endif
610 :
611 4927 : if (need_work_space) call abi_linalg_work_allocate()
612 :
613 : end subroutine abi_linalg_init
614 : !!***
615 :
616 : !!****f* m_abi_linalg/abi_linalg_work_allocate
617 : !! NAME
618 : !! abi_linalg_work_allocate
619 : !!
620 : !! FUNCTION
621 : !!
622 : !! INPUTS
623 : !!
624 : !! SOURCE
625 : !!
626 4927 : subroutine abi_linalg_work_allocate()
627 :
628 : !Arguments ------------------------------------
629 :
630 : !Local variables ------------------------------
631 : #ifdef HAVE_LINALG_MAGMA
632 : integer :: nb, magmaf_get_ssytrd_nb, magmaf_get_dsytrd_nb, magmaf_get_chetrd_nb, magmaf_get_zhetrd_nb
633 : #endif
634 : !******************************************************************
635 :
636 : !Single precision WORK
637 4927 : eigen_s_lwork = 0
638 4927 : if (eigen_s_maxsize>0) then
639 4927 : if (lapack_single_precision) then
640 0 : if (lapack_full_storage) then
641 0 : eigen_s_lwork = max(eigen_s_lwork,3*eigen_s_maxsize-1) ! SSYEV, SSYGV
642 : end if
643 0 : if (lapack_packed_storage) then
644 0 : eigen_s_lwork = max(eigen_s_lwork,3*eigen_s_maxsize) ! SSPEV[D], SSPGV[D]
645 : end if
646 0 : if (lapack_divide_conquer) then
647 0 : eigen_s_lwork = max(eigen_s_lwork,1+6*eigen_s_maxsize+2*eigen_s_maxsize**2) ! SSYEVD, SSYGVD
648 : end if
649 : if (ABI_LINALG_MAGMA_ISON) then
650 : if (lapack_full_storage.and.lapack_divide_conquer) then
651 : #if defined HAVE_LINALG_MAGMA
652 : nb=magmaf_get_ssytrd_nb(eigen_s_maxsize)
653 : eigen_s_lwork = max(eigen_s_lwork,eigen_s_maxsize*(nb+2)) ! MAGMAF_SSYEVD, MAGMAF_SSYGVD
654 : #endif
655 : end if
656 : end if
657 0 : if (ABI_LINALG_PLASMA_ISON) then
658 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
659 0 : eigen_s_lwork = max(eigen_s_lwork,eigen_s_maxsize**2) ! PLASMA_SSYEV
660 : end if
661 : end if
662 : end if
663 : end if
664 4927 : ABI_SFREE(eigen_s_work)
665 14781 : ABI_MALLOC(eigen_s_work,(eigen_s_lwork))
666 :
667 : !Double precision WORK
668 4927 : eigen_d_lwork = 0
669 4927 : if (eigen_d_maxsize>0) then
670 4927 : if (lapack_double_precision) then
671 4927 : if (lapack_full_storage) then
672 25 : eigen_d_lwork = max(eigen_d_lwork,3*eigen_d_maxsize-1) ! DSYEV, DSYGV
673 : end if
674 4927 : if (lapack_packed_storage) then
675 4927 : eigen_d_lwork = max(eigen_d_lwork,3*eigen_d_maxsize) ! DSPEV[D], DSPGV[D]
676 : end if
677 4927 : if (lapack_divide_conquer) then
678 0 : eigen_d_lwork = max(eigen_d_lwork,1+6*eigen_d_maxsize+2*eigen_d_maxsize**2) ! DSYEVD, DSYGVD
679 : end if
680 : if (ABI_LINALG_MAGMA_ISON) then
681 : if (lapack_full_storage.and.lapack_divide_conquer) then
682 : #if defined HAVE_LINALG_MAGMA
683 : nb=magmaf_get_dsytrd_nb(eigen_d_maxsize)
684 : eigen_d_lwork = max(eigen_d_lwork,eigen_d_maxsize*(nb+2)) ! MAGMAF_DSYEVD, MAGMAF_DSYGVD
685 : #endif
686 : end if
687 : end if
688 4927 : if (ABI_LINALG_PLASMA_ISON) then
689 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
690 0 : eigen_d_lwork = max(eigen_d_lwork,eigen_d_maxsize**2) ! PLASMA_DSYEV
691 : end if
692 : end if
693 : end if
694 : end if
695 4927 : ABI_SFREE(eigen_d_work)
696 14781 : ABI_MALLOC(eigen_d_work,(eigen_d_lwork))
697 :
698 : !Single complex WORK
699 4927 : eigen_c_lwork = 0
700 4927 : if (eigen_c_maxsize>0) then
701 4927 : if (lapack_single_precision) then
702 0 : if (lapack_full_storage) then
703 0 : eigen_c_lwork = max(eigen_c_lwork,2*eigen_c_maxsize-1) ! CHEEV, CHEGV
704 : end if
705 0 : if (lapack_packed_storage) then
706 0 : eigen_c_lwork = max(eigen_c_lwork,2*eigen_c_maxsize) ! CHPEV[D], CHPGV[D]
707 : end if
708 0 : if (lapack_divide_conquer) then
709 0 : eigen_c_lwork = max(eigen_c_lwork,2*eigen_c_maxsize+eigen_c_maxsize**2) ! CHEEVD, CHEGVD
710 : end if
711 : if (ABI_LINALG_MAGMA_ISON) then
712 : if (lapack_full_storage.and.lapack_divide_conquer) then
713 : #if defined HAVE_LINALG_MAGMA
714 : nb=magmaf_get_chetrd_nb(eigen_c_maxsize)
715 : eigen_c_lwork = max(eigen_c_lwork,eigen_c_maxsize*(nb+1)) ! MAGMAF_CHEEVD, MAGMAF_CHEGVD
716 : #endif
717 : end if
718 : end if
719 0 : if (ABI_LINALG_PLASMA_ISON) then
720 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
721 0 : eigen_c_lwork = max(eigen_c_lwork,eigen_c_maxsize**2) ! PLASMA_CHEEV
722 : end if
723 : end if
724 : end if
725 : end if
726 4927 : ABI_SFREE(eigen_c_work)
727 14781 : ABI_MALLOC(eigen_c_work,(eigen_c_lwork))
728 :
729 : !Double complex WORK
730 4927 : eigen_z_lwork = 0
731 4927 : if (eigen_z_maxsize>0) then
732 4927 : if (lapack_double_precision) then
733 4927 : if (lapack_full_storage) then
734 25 : eigen_z_lwork = max(eigen_z_lwork,2*eigen_z_maxsize-1) ! ZHEEV, ZHEGV
735 : end if
736 4927 : if (lapack_packed_storage) then
737 4927 : eigen_z_lwork = max(eigen_z_lwork,2*eigen_z_maxsize) ! ZHPEV[D], ZHPGV[D]
738 : end if
739 4927 : if (lapack_divide_conquer) then
740 0 : eigen_z_lwork = max(eigen_z_lwork,2*eigen_z_maxsize+eigen_z_maxsize**2) ! ZHEEVD, ZHEGVD
741 : end if
742 : if (ABI_LINALG_MAGMA_ISON) then
743 : if (lapack_full_storage.and.lapack_divide_conquer) then
744 : #if defined HAVE_LINALG_MAGMA
745 : nb=magmaf_get_zhetrd_nb(eigen_z_maxsize)
746 : eigen_z_lwork = max(eigen_z_lwork,eigen_z_maxsize*(nb+1)) ! MAGMAF_ZHEEVD, MAGMAF_ZHEGVD
747 : #endif
748 : end if
749 : end if
750 4927 : if (ABI_LINALG_PLASMA_ISON) then
751 0 : if (lapack_full_storage.and.lapack_divide_conquer) then
752 0 : eigen_z_lwork = max(eigen_z_lwork,eigen_z_maxsize**2) ! PLASMA_ZHEEV
753 : end if
754 : end if
755 : end if
756 : end if
757 4927 : ABI_SFREE(eigen_z_work)
758 14781 : ABI_MALLOC(eigen_z_work,(eigen_z_lwork))
759 :
760 : !Single precision RWORK
761 4927 : eigen_c_lrwork = 0
762 4927 : if (eigen_c_maxsize>0) then
763 4927 : if (lapack_single_precision) then
764 0 : if (lapack_full_storage.or.lapack_packed_storage) then
765 0 : eigen_c_lrwork = max(eigen_c_lrwork,3*eigen_c_maxsize-2) ! CHEEV, CHEGV, CHPEV, CHPGV
766 : end if
767 0 : if (lapack_divide_conquer) then
768 0 : eigen_c_lrwork = max(eigen_c_lrwork,1+5*eigen_c_maxsize+2*eigen_c_maxsize**2) ! CHEEVD, CHEGVD, CHPEVD, CHPGVD
769 : end if
770 : end if
771 : end if
772 4927 : ABI_SFREE(eigen_c_rwork)
773 14781 : ABI_MALLOC(eigen_c_rwork,(eigen_c_lrwork))
774 :
775 : !Double precision RWORK
776 4927 : eigen_z_lrwork = 0
777 4927 : if (eigen_z_maxsize>0) then
778 4927 : if (lapack_double_precision) then
779 4927 : if (lapack_full_storage.or.lapack_packed_storage) then
780 4927 : eigen_z_lrwork = max(eigen_z_lrwork,3*eigen_z_maxsize-2) ! ZHEEV, ZHEGV, ZHPEV, ZHPGV
781 : end if
782 4927 : if (lapack_divide_conquer) then
783 0 : eigen_z_lrwork = max(eigen_z_lrwork,1+5*eigen_z_maxsize+2*eigen_z_maxsize**2) ! ZHEEVD, ZHEGVD, ZHPEVD, ZHPGVD
784 : end if
785 : end if
786 : end if
787 4927 : ABI_SFREE(eigen_z_rwork)
788 14781 : ABI_MALLOC(eigen_z_rwork,(eigen_z_lrwork))
789 :
790 : !Integer IWORK
791 4927 : eigen_liwork = 0
792 4927 : if (lapack_divide_conquer) then
793 0 : if (lapack_single_precision) then
794 0 : if (eigen_s_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_s_maxsize)
795 0 : if (eigen_c_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_c_maxsize)
796 : end if
797 0 : if (lapack_double_precision) then
798 0 : if (eigen_d_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_d_maxsize)
799 0 : if (eigen_z_maxsize>0) eigen_liwork = max(eigen_liwork,3+5*eigen_z_maxsize)
800 : end if
801 : end if
802 4927 : ABI_SFREE(eigen_iwork)
803 14781 : ABI_MALLOC(eigen_iwork,(eigen_liwork))
804 :
805 4927 : end subroutine abi_linalg_work_allocate
806 : !!***
807 :
808 : !!****f* m_abi_linalg/abi_linalg_finalize
809 : !! NAME
810 : !! abi_linalg_finalize
811 : !!
812 : !! FUNCTION
813 : !!
814 : !! INPUTS
815 : !!
816 : !! SOURCE
817 : !!
818 5411 : subroutine abi_linalg_finalize(gpu_option)
819 :
820 : !Arguments ------------------------------------
821 : integer, intent(in) :: gpu_option
822 : !Local variables ------------------------------
823 : #ifdef HAVE_LINALG_PLASMA
824 : integer :: info
825 : #endif
826 : !******************************************************************
827 :
828 5411 : if (.not.abi_linalg_in_use) return
829 :
830 4927 : eigen_s_maxsize = 0
831 4927 : eigen_d_maxsize = 0
832 4927 : eigen_c_maxsize = 0
833 4927 : eigen_z_maxsize = 0
834 4927 : eigen_s_lwork = 0
835 4927 : eigen_d_lwork = 0
836 4927 : eigen_c_lwork = 0
837 4927 : eigen_z_lwork = 0
838 4927 : eigen_c_lrwork = 0
839 4927 : eigen_z_lrwork = 0
840 4927 : eigen_liwork = 0
841 :
842 4927 : lapack_full_storage=.False.
843 4927 : lapack_packed_storage=.False.
844 4927 : lapack_single_precision=.False.
845 4927 : lapack_double_precision=.False.
846 4927 : lapack_divide_conquer=.false.
847 :
848 : #ifdef HAVE_LINALG_SCALAPACK
849 : if (ABI_LINALG_SCALAPACK_ISON) then
850 : call slk_processor%free()
851 : call xmpi_comm_free(slk_communicator)
852 : call xmpi_comm_free(slk_complement_communicator)
853 : slk_communicator=xmpi_comm_null
854 : slk_complement_communicator=xmpi_comm_null
855 : slk_minsize=1
856 : end if
857 : #endif
858 :
859 : !#ifdef HAVE_LINALG_ELPA
860 : ! call elpa_func_uninit()
861 : !#endif
862 :
863 : #ifdef HAVE_LINALG_PLASMA
864 : call PLASMA_Finalize(info)
865 : ABI_LINALG_PLASMA_ISON=.False.
866 : end if
867 : #endif
868 :
869 : #ifdef HAVE_LINALG_MAGMA
870 : #ifdef HAVE_LINALG_MAGMA_15
871 : if (ABI_LINALG_MAGMA_ISON) then
872 : call magmaf_finalize()
873 : end if
874 : #endif
875 : #endif
876 :
877 : #ifdef HAVE_GPU
878 : if (gpu_option/=ABI_GPU_DISABLED) then
879 : call abi_gpu_work_finalize()
880 : call gpu_linalg_shutdown()
881 : end if
882 : abi_linalg_gpu_mode = ABI_GPU_DISABLED
883 : #else
884 : ABI_UNUSED(gpu_option)
885 : #endif
886 :
887 : !Memory freeing
888 4927 : ABI_SFREE(eigen_s_work)
889 4927 : ABI_SFREE(eigen_d_work)
890 4927 : ABI_SFREE(eigen_c_work)
891 4927 : ABI_SFREE(eigen_z_work)
892 4927 : ABI_SFREE(eigen_c_rwork)
893 4927 : ABI_SFREE(eigen_z_rwork)
894 4927 : ABI_SFREE(eigen_iwork)
895 :
896 : end subroutine abi_linalg_finalize
897 : !!***
898 :
899 : !----------------------------------------------------------------------
900 :
901 : !!****f* m_abi_linalg/linalg_allow_gemm3m
902 : !! NAME
903 : !!
904 : !! FUNCTION
905 : !! Programmatic interface to enable the use of [Z,C]GEMM3M calls
906 : !!
907 : !! SOURCE
908 :
909 0 : subroutine linalg_allow_gemm3m(bool, write_msg)
910 :
911 : !Arguments ------------------------------------
912 : logical,intent(in) :: bool, write_msg
913 : ! *************************************************************************
914 :
915 0 : XGEMM3M_ISON = bool
916 0 : if (write_msg) then
917 : #ifdef HAVE_LINALG_GEMM3M
918 0 : if (bool) then
919 0 : ABI_COMMENT("Activating ZGEMM3M version instead of ZGEMM")
920 : else
921 0 : ABI_COMMENT("Using ZGEMM instead of ZGEMM3M")
922 : end if
923 : #else
924 : if (bool) then
925 : ABI_WARNING("Cannot activate ZGEMM3M as HAVE_LINALG_GEMM3M is not defined!")
926 : end if
927 : #endif
928 : endif
929 :
930 0 : end subroutine linalg_allow_gemm3m
931 : !!***
932 :
933 : !----------------------------------------------------------------------
934 :
935 : !!****f* m_abi_linalg/use_zgemm3m
936 : !! NAME
937 : !! use_zgemm3m
938 : !!
939 : !! FUNCTION
940 : !! Enable the use of ZGEMM3M
941 : !!
942 : !! NOTES
943 : !! The CGEMM3M and ZGEMM3M routines use an algorithm requiring 3 real matrix
944 : !! multiplications and 5 real matrix additions to compute the complex matrix
945 : !! product; CGEMM(3S) and ZGEMM(3S) use 4 real matrix multiplications and 2
946 : !! real matrix additions. Because the matrix multiplication time is usually
947 : !! the limiting performance factor in these routines, CGEMM3M and ZGEMM3M
948 : !! may run up to 33 percent faster than CGEMM and ZGEMM. Because of other
949 : !! overhead associated with the 3M routines, however, these performance
950 : !! improvements may not always be realized. For example, on one processor
951 : !! the 3M routines will generally run more slowly than the standard complex
952 : !! matrix multiplication routines when m * n * k < FACTOR, where m, n, and k
953 : !! are the input matrix dimensions and FACTOR is approximately 200000 for
954 : !! CGEMM3M and 325000 for ZGEMM3M.
955 : !! 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
956 : !!
957 : !! SOURCE
958 :
959 177353029 : pure logical function use_zgemm3m(m, n, k)
960 :
961 : !Arguments ------------------------------------
962 : integer,intent(in) :: m,n,k
963 : ! *************************************************************************
964 :
965 177353029 : use_zgemm3m = .False.
966 177353029 : if (XGEMM3M_ISON) use_zgemm3m = ((m * n * k) > ZGEMM3M_LIMIT)
967 : !if (XGEMM3M_ISON) use_zgemm3m = .True.
968 :
969 : #ifndef HAVE_LINALG_GEMM3M
970 : use_zgemm3m = .False.
971 : #endif
972 :
973 : end function use_zgemm3m
974 : !!***
975 :
976 : !----------------------------------------------------------------------
977 :
978 : !!****f* m_abi_linalg/use_cgemm3m
979 : !! NAME
980 : !! use_cgemm3m
981 : !!
982 : !! FUNCTION
983 : !! Enable the use of CGEMM3M
984 : !!
985 : !! NOTES
986 : !! See use_zgemm3m
987 : !!
988 : !! SOURCE
989 :
990 : pure logical function use_cgemm3m(m, n, k)
991 :
992 : !Arguments ------------------------------------
993 : integer,intent(in) :: m,n,k
994 : ! *************************************************************************
995 :
996 : use_cgemm3m = .False.
997 : if (XGEMM3M_ISON) use_cgemm3m = ((m * n * k) > CGEMM3M_LIMIT)
998 : #ifndef HAVE_LINALG_GEMM3M
999 : use_cgemm3m = .False.
1000 : #endif
1001 :
1002 : end function use_cgemm3m
1003 : !!***
1004 :
1005 : !----------------------------------------------------------------------
1006 :
1007 : !!****f* m_abi_linalg/linalg_allow_plasma
1008 : !! NAME
1009 : !!
1010 : !! FUNCTION
1011 : !! Programmatic interface to enable the use of PLASMA
1012 : !! False to disable PLASMA version.
1013 : !!
1014 : !! SOURCE
1015 :
1016 0 : subroutine linalg_allow_plasma(bool)
1017 :
1018 : !Arguments ------------------------------------
1019 : logical,intent(in) :: bool
1020 : ! *************************************************************************
1021 :
1022 : XPLASMA_ISON = bool
1023 : #ifndef HAVE_LINALG_PLASMA
1024 : ! Just to be on the safe-side.
1025 : ! I have to use a weird set of branches to make abirules happy in the BLAS/LAPACK
1026 : ! wrappers, and one cannot set XPLASMA_MODE to .True. if PLASMA is not available.
1027 0 : XPLASMA_ISON = .False.
1028 : #endif
1029 :
1030 0 : end subroutine linalg_allow_plasma
1031 : !!***
1032 :
1033 : #ifdef HAVE_LINALG_PLASMA
1034 :
1035 : !!****f* m_abi_linalg/uplo_plasma
1036 : !! NAME
1037 : !!
1038 : !! FUNCTION
1039 : !! Convert uplo character to PLASMA integer
1040 : !!
1041 : !! SOURCE
1042 :
1043 : integer function uplo_plasma(uplo)
1044 :
1045 : !Arguments ------------------------------------
1046 : character(len=1),intent(in) :: uplo
1047 : ! *************************************************************************
1048 :
1049 : if (LSAME(uplo,'U')) then
1050 : uplo_plasma = PlasmaUpper
1051 : else
1052 : uplo_plasma = PlasmaLower
1053 : end if
1054 :
1055 : end function uplo_plasma
1056 : !!***
1057 :
1058 : !----------------------------------------------------------------------
1059 :
1060 : !!****f* m_abi_linalg/trans_plasma
1061 : !! NAME
1062 : !!
1063 : !! FUNCTION
1064 : !! Convert trans character to PLASMA integer
1065 : !!
1066 : !! SOURCE
1067 :
1068 : integer function trans_plasma(trans)
1069 :
1070 : !Arguments ------------------------------------
1071 : character(len=1),intent(in) :: trans
1072 : ! *************************************************************************
1073 :
1074 : if (LSAME(trans,'C')) then
1075 : trans_plasma = PlasmaConjTrans
1076 : else if (LSAME(trans,'T')) then
1077 : trans_plasma = PlasmaTrans
1078 : else
1079 : trans_plasma = PlasmaNoTrans
1080 : end if
1081 :
1082 : end function trans_plasma
1083 : !!***
1084 :
1085 : !----------------------------------------------------------------------
1086 :
1087 : !!****f* m_abi_linalg/side_plasma
1088 : !! NAME
1089 : !!
1090 : !! FUNCTION
1091 : !! Convert side character to PLASMA integer
1092 : !!
1093 : !! SOURCE
1094 :
1095 : integer function side_plasma(side)
1096 :
1097 : !Arguments ------------------------------------
1098 : character(len=1),intent(in) :: side
1099 : ! *************************************************************************
1100 :
1101 : if(LSAME(side,'L')) then
1102 : side_plasma = PlasmaLeft
1103 : else
1104 : side_plasma = PlasmaRight
1105 : end if
1106 :
1107 : end function side_plasma
1108 : !!***
1109 :
1110 : !----------------------------------------------------------------------
1111 :
1112 : !!****f* m_abi_linalg/diag_plasma
1113 : !! NAME
1114 : !!
1115 : !! FUNCTION
1116 : !! Convert diag character to PLASMA integer
1117 : !!
1118 : !! SOURCE
1119 :
1120 : integer function diag_plasma(diag)
1121 :
1122 : !Arguments ------------------------------------
1123 : character(len=1),intent(in) :: diag
1124 : ! *************************************************************************
1125 :
1126 : if (LSAME(diag,'U')) then
1127 : diag_plasma = PlasmaUnit
1128 : else
1129 : diag_plasma = PlasmaNonUnit
1130 : end if
1131 :
1132 : end function diag_plasma
1133 : !!***
1134 :
1135 : !----------------------------------------------------------------------
1136 :
1137 : !!****f* m_abi_linalg/jobz_plasma
1138 : !! NAME
1139 : !!
1140 : !! FUNCTION
1141 : !! Convert jobz character to PLASMA integer
1142 : !!
1143 : !! SOURCE
1144 :
1145 : integer function jobz_plasma(jobz)
1146 :
1147 : !Arguments ------------------------------------
1148 : character(len=1),intent(in) :: jobz
1149 : ! *************************************************************************
1150 :
1151 : if (LSAME(jobz,'N')) then
1152 : jobz_plasma = PlasmaNoVec
1153 : else
1154 : jobz_plasma = PlasmaVec
1155 : end if
1156 :
1157 : end function jobz_plasma
1158 : !!***
1159 :
1160 : #endif
1161 :
1162 : ! Include files providing wrappers for some of the most commonly used BLAS & LAPACK routines
1163 :
1164 : ! *********************************************************************!
1165 : ! ******************* BLAS_XGEMM interface ****************************!
1166 : ! *********************************************************************!
1167 : #include "abi_xgemm.f90"
1168 :
1169 : ! *********************************************************************!
1170 : ! ******************** BLAS_XSCAL interface ***************************!
1171 : ! *********************************************************************!
1172 : #include "abi_xscal.f90"
1173 :
1174 : ! *********************************************************************!
1175 : ! ******************** BLAS_XAXPY interface ***************************!
1176 : ! *********************************************************************!
1177 : #include "abi_xaxpy.f90"
1178 :
1179 : ! *********************************************************************!
1180 : ! ******************** BLAS_XCOPY interface ***************************!
1181 : ! *********************************************************************!
1182 : #include "abi_xcopy.f90"
1183 :
1184 : ! *********************************************************************!
1185 : ! ******************** BLAS_XTRSM interface ***************************!
1186 : ! *********************************************************************!
1187 : #include "abi_xtrsm.f90"
1188 :
1189 : ! *********************************************************************!
1190 : ! ********************* LAPACK XHEEV interface ***********************!
1191 : ! *********************************************************************!
1192 : #include "abi_xheev.f90"
1193 :
1194 : ! *********************************************************************!
1195 : ! ********************* LAPACK XHEGV interface ***********************!
1196 : ! *********************************************************************!
1197 : #include "abi_xhegv.f90"
1198 :
1199 : ! *********************************************************************!
1200 : ! ********************* LAPACK XHPEV interface ***********************!
1201 : ! *********************************************************************!
1202 : #include "abi_xhpev.f90"
1203 :
1204 : ! *********************************************************************!
1205 : ! ********************* LAPACK XHPGV interface ***********************!
1206 : ! *********************************************************************!
1207 : #include "abi_xhpgv.f90"
1208 :
1209 : ! *********************************************************************!
1210 : ! ****************** LAPACK XPOTRF interface *************************!
1211 : ! *********************************************************************!
1212 : #include "abi_xpotrf.f90"
1213 :
1214 : ! *********************************************************************!
1215 : ! ************ ABINIT Orthonormalization interface *******************!
1216 : ! *********************************************************************!
1217 : #include "abi_xorthonormalize.f90"
1218 :
1219 : ! *********************************************************************!
1220 : ! ****************** GPU LINALG interface *************************!
1221 : ! *********************************************************************!
1222 : #include "abi_gpu_linalg.f90"
1223 :
1224 : !----------------------------------------------------------------------
1225 :
1226 : end module m_abi_linalg
1227 : !!***
|
