elpa_impl.F90 35 KB
Newer Older
1
2
3
!
!    Copyright 2017, L. Hüdepohl and A. Marek, MPCDF
!
Andreas Marek's avatar
Andreas Marek committed
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
!    This file is part of ELPA.
!
!    The ELPA library was originally created by the ELPA consortium,
!    consisting of the following organizations:
!
!    - Max Planck Computing and Data Facility (MPCDF), formerly known as
!      Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
!    - Bergische Universität Wuppertal, Lehrstuhl für angewandte
!      Informatik,
!    - Technische Universität München, Lehrstuhl für Informatik mit
!      Schwerpunkt Wissenschaftliches Rechnen ,
!    - Fritz-Haber-Institut, Berlin, Abt. Theorie,
!    - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
!      Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
!      and
!    - IBM Deutschland GmbH
!
!    This particular source code file contains additions, changes and
!    enhancements authored by Intel Corporation which is not part of
!    the ELPA consortium.
!
!    More information can be found here:
!    http://elpa.mpcdf.mpg.de/
!
!    ELPA is free software: you can redistribute it and/or modify
!    it under the terms of the version 3 of the license of the
!    GNU Lesser General Public License as published by the Free
!    Software Foundation.
!
!    ELPA is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU Lesser General Public License for more details.
!
!    You should have received a copy of the GNU Lesser General Public License
!    along with ELPA.  If not, see <http://www.gnu.org/licenses/>
!
!    ELPA reflects a substantial effort on the part of the original
!    ELPA consortium, and we ask you to respect the spirit of the
!    license that we chose: i.e., please contribute any changes you
!    may have back to the original ELPA library distribution, and keep
!    any derivatives of ELPA under the same license that we chose for
!    the original distribution, the GNU Lesser General Public License.
!
48
#include "config-f90.h"
49

50
!> \brief Fortran module which provides the implementation of the API
51
52
module elpa_impl
  use elpa_api
53
  use, intrinsic :: iso_c_binding
54
  implicit none
55

56
57
  private
  public :: elpa_impl_allocate
58

59
!> \brief Definition of the extended elpa_impl_t type
60
  type, extends(elpa_t) :: elpa_impl_t
Andreas Marek's avatar
Andreas Marek committed
61
   private
62
   type(c_ptr)         :: index = C_NULL_PTR
63

64
   !> \brief methods available with the elpa_impl_t type
65
   contains
66
     !> \brief the puplic methods
67
     ! con-/destructor
68
69
     procedure, public :: setup => elpa_setup                   !< a setup method: implemented in elpa_setup
     procedure, public :: destroy => elpa_destroy               !< a destroy method: implemented in elpa_destroy
70

71
     ! KV store
72
73
74
75
76
77
     procedure, public :: get => elpa_get_integer               !< a get method for integer key/values: implemented in elpa_get_integer
     procedure, public :: get_double => elpa_get_double         !< a get method for double key/values: implemented in elpa_get_double
     procedure, public :: is_set => elpa_is_set                 !< a method to check whether a key/value pair has been set : implemented
                                                                !< in elpa_is_set
     procedure, public :: can_set => elpa_can_set               !< a method to check whether a key/value pair can be set : implemented
                                                                !< in elpa_can_set
78

79
     !> \brief the private methods
80

81
     procedure, private :: elpa_set_integer                     !< private methods to implement the setting of an integer/double key/value pair
82
     procedure, private :: elpa_set_double
83

84
85
     procedure, private :: elpa_solve_real_double               !< private methods to implement the solve step for real/complex
                                                                !< double/single matrices
86
     procedure, private :: elpa_solve_real_single
87
     procedure, private :: elpa_solve_complex_double
88
     procedure, private :: elpa_solve_complex_single
89

90
91
92
     procedure, private :: elpa_multiply_at_b_double            !< private methods to implement a "hermitian" multiplication of matrices a and b
     procedure, private :: elpa_multiply_at_b_single            !< for real valued matrices:   a**T * b
     procedure, private :: elpa_multiply_ah_b_double            !< for complex valued matrices:   a**H * b
93
     procedure, private :: elpa_multiply_ah_b_single
94

95
96
     procedure, private :: elpa_cholesky_double_real            !< private methods to implement the cholesky factorisation of
                                                                !< real/complex double/single matrices
97
98
99
     procedure, private :: elpa_cholesky_single_real
     procedure, private :: elpa_cholesky_double_complex
     procedure, private :: elpa_cholesky_single_complex
100

101
102
     procedure, private :: elpa_invert_trm_double_real          !< private methods to implement the inversion of a triangular
                                                                !< real/complex double/single matrix
103
104
105
     procedure, private :: elpa_invert_trm_single_real
     procedure, private :: elpa_invert_trm_double_complex
     procedure, private :: elpa_invert_trm_single_complex
106

107
108
     procedure, private :: elpa_solve_tridi_double_real         !< private methods to implement the solve step for a real valued
     procedure, private :: elpa_solve_tridi_single_real         !< double/single tridiagonal matrix
109

110
     procedure, private :: associate_int => elpa_associate_int  !< private method to set some pointers
111

112
  end type elpa_impl_t
113

114
  !> \brief the implementation of the private methods
115
  contains
116
117
118
119
    !> \brief function to allocate an ELPA object
    !> Parameters
    !> \param   error      integer, optional to get an error code
    !> \result  obj        class(elpa_impl_t) allocated ELPA object
120
    function elpa_impl_allocate(error) result(obj)
Andreas Marek's avatar
Andreas Marek committed
121
122
      use precision
      use elpa_utilities, only : error_unit
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
123
      use elpa_generated_fortran_interfaces
Andreas Marek's avatar
Andreas Marek committed
124

125
126
127
128
      type(elpa_impl_t), pointer   :: obj
      integer, optional            :: error

      allocate(obj)
Andreas Marek's avatar
Andreas Marek committed
129

Andreas Marek's avatar
Andreas Marek committed
130
131
      ! check whether init has ever been called
      if (.not.(elpa_initialized())) then
132
        write(error_unit, *) "elpa_allocate(): you must call elpa_init() once before creating instances of ELPA"
133
134
        if(present(error)) then
          error = ELPA_ERROR
135
        endif
Andreas Marek's avatar
Andreas Marek committed
136
137
        return
      endif
Andreas Marek's avatar
Andreas Marek committed
138

139
      obj%index = elpa_index_instance_c()
140
141

      ! Associate some important integer pointers for convenience
142
143
144
145
146
147
148
149
      obj%na => obj%associate_int("na")
      obj%nev => obj%associate_int("nev")
      obj%local_nrows => obj%associate_int("local_nrows")
      obj%local_ncols => obj%associate_int("local_ncols")
      obj%nblk => obj%associate_int("nblk")

      if(present(error)) then
        error = ELPA_OK
150
151
      endif
    end function
Andreas Marek's avatar
Andreas Marek committed
152

153
154
155
156
    !> \brief function to setup an ELPA object and to store the MPI communicators internally
    !> Parameters
    !> \param   self       class(elpa_impl_t), the allocated ELPA object
    !> \result  error      integer, the error code
157
    function elpa_setup(self) result(error)
158
      use elpa1_impl, only : elpa_get_communicators_impl
159
      class(elpa_impl_t), intent(inout) :: self
160
      integer :: error, error2
161
      integer :: mpi_comm_rows, mpi_comm_cols, mpierr
162

163
      error = ELPA_ERROR
164

165
166
167
      if (self%is_set("mpi_comm_parent") == 1 .and. &
          self%is_set("process_row") == 1 .and. &
          self%is_set("process_col") == 1) then
168

169
170
171
172
173
174
        mpierr = elpa_get_communicators_impl(&
                        self%get("mpi_comm_parent"), &
                        self%get("process_row"), &
                        self%get("process_col"), &
                        mpi_comm_rows, &
                        mpi_comm_cols)
175

176
177
178
        call self%set("mpi_comm_rows", mpi_comm_rows)
        call self%set("mpi_comm_cols", mpi_comm_cols)

179
        error = ELPA_OK
180
      endif
181

182
183
      if (self%is_set("mpi_comm_rows") == 1 .and. self%is_set("mpi_comm_cols") == 1) then
        error = ELPA_OK
184
      endif
185
186

    end function
187

188
189
190
191
192
193
    !> \brief subroutine to set an integer key/value pair
    !> Parameters
    !> \param   self       class(elpa_impl_t) the allocated ELPA object
    !> \param   name       string, the key
    !> \param   value      integer, the value to be set
    !> \result  error      integer, the error code
194
    subroutine elpa_set_integer(self, name, value, error)
195
      use iso_c_binding
196
197
      use elpa_generated_fortran_interfaces
      use elpa_utilities, only : error_unit
198
      class(elpa_impl_t)              :: self
199
200
      character(*), intent(in)        :: name
      integer(kind=c_int), intent(in) :: value
201
202
      integer, optional               :: error
      integer                         :: actual_error
203

204
      actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value, 0)
205

206
207
      if (present(error)) then
        error = actual_error
208

209
      else if (actual_error /= ELPA_OK) then
210
211
        write(error_unit,'(a,i0,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
                " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
212
      end if
213
214
    end subroutine

215
216
217
218
219
220
    !> \brief function to get an integer key/value pair
    !> Parameters
    !> \param   self       class(elpa_impl_t) the allocated ELPA object
    !> \param   name       string, the key
    !> \param   error      integer, optional, to store an error code
    !> \result  value      integer, the value of the key/vaue pair
221
    function elpa_get_integer(self, name, error) result(value)
222
      use iso_c_binding
223
      use elpa_generated_fortran_interfaces
224
      use elpa_utilities, only : error_unit
225
      class(elpa_impl_t)             :: self
226
227
      character(*), intent(in)       :: name
      integer(kind=c_int)            :: value
228
      integer, intent(out), optional :: error
229
      integer                        :: actual_error
230

231
232
233
234
235
236
237
      value = elpa_index_get_int_value_c(self%index, name // c_null_char, actual_error)
      if (present(error)) then
        error = actual_error
      else if (actual_error /= ELPA_OK) then
        write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
                " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
      end if
238
    end function
Andreas Marek's avatar
Andreas Marek committed
239

240
241
242
243
244
    !> \brief function to check whether a key/value pair is set
    !> Parameters
    !> \param   self       class(elpa_impl_t) the allocated ELPA object
    !> \param   name       string, the key
    !> \result  state      integer, the state of the key/value pair
245
    function elpa_is_set(self, name) result(state)
246
247
      use iso_c_binding
      use elpa_generated_fortran_interfaces
248
      class(elpa_impl_t)       :: self
249
      character(*), intent(in) :: name
250
      integer                  :: state
251

252
      state = elpa_index_value_is_set_c(self%index, name // c_null_char)
253
254
    end function

255
256
257
258
259
260
    !> \brief function to check whether a key/value pair can be set
    !> Parameters
    !> \param   self       class(elpa_impl_t) the allocated ELPA object
    !> \param   name       string, the key
    !> \param   value      integer, value
    !> \result  error      integer, error code
261
262
263
264
265
266
267
268
269
270
271
272
273
    function elpa_can_set(self, name, value) result(error)
      use iso_c_binding
      use elpa_generated_fortran_interfaces
      class(elpa_impl_t)       :: self
      character(*), intent(in) :: name
      integer(kind=c_int), intent(in) :: value
      integer                  :: error

      error = elpa_index_int_is_valid_c(self%index, name // c_null_char, value)
    end function


    function elpa_value_to_string(self, option_name, error) result(string)
274
275
276
      use elpa_generated_fortran_interfaces
      class(elpa_impl_t), intent(in) :: self
      character(kind=c_char, len=*), intent(in) :: option_name
277
278
279
280
      type(c_ptr) :: ptr
      integer, intent(out), optional :: error
      integer :: val, actual_error
      character(kind=c_char, len=elpa_index_int_value_to_strlen_c(self%index, option_name // C_NULL_CHAR)), pointer :: string
281

282
283
284
285
286
287
288
289
      nullify(string)

      val = self%get(option_name, actual_error)
      if (actual_error /= ELPA_OK) then
        if (present(error)) then
          error = actual_error
        endif
        return
290
291
      endif

292
293
294
295
      actual_error = elpa_int_value_to_string_c(option_name // C_NULL_CHAR, val, ptr)
      if (c_associated(ptr)) then
        call c_f_pointer(ptr, string)
      endif
296

297
298
299
300
      if (present(error)) then
        error = actual_error
      endif
    end function
301

302
303

    subroutine elpa_set_double(self, name, value, error)
Andreas Marek's avatar
Andreas Marek committed
304
      use iso_c_binding
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
305
      use elpa_generated_fortran_interfaces
306
      use elpa_utilities, only : error_unit
307
      class(elpa_impl_t)              :: self
308
      character(*), intent(in)        :: name
309
      real(kind=c_double), intent(in) :: value
310
311
      integer, optional               :: error
      integer                         :: actual_error
Andreas Marek's avatar
Andreas Marek committed
312

313
      actual_error = elpa_index_set_double_value_c(self%index, name // c_null_char, value, 0)
Andreas Marek's avatar
Andreas Marek committed
314

315
316
317
      if (present(error)) then
        error = actual_error
      else if (actual_error /= ELPA_OK) then
318
319
        write(error_unit,'(a,es12.5,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
                " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
320
321
      end if
    end subroutine
Andreas Marek's avatar
Andreas Marek committed
322
323


324
    function elpa_get_double(self, name, error) result(value)
Andreas Marek's avatar
Andreas Marek committed
325
      use iso_c_binding
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
326
      use elpa_generated_fortran_interfaces
327
      use elpa_utilities, only : error_unit
328
      class(elpa_impl_t)             :: self
329
      character(*), intent(in)       :: name
330
      real(kind=c_double)            :: value
331
      integer, intent(out), optional :: error
332
      integer                        :: actual_error
333

334
335
336
337
338
339
340
      value = elpa_index_get_double_value_c(self%index, name // c_null_char, actual_error)
      if (present(error)) then
        error = actual_error
      else if (actual_error /= ELPA_OK) then
        write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
                " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
      end if
341
    end function
Andreas Marek's avatar
Andreas Marek committed
342
343


344
    function elpa_associate_int(self, name) result(value)
Andreas Marek's avatar
Andreas Marek committed
345
      use iso_c_binding
346
      use elpa_generated_fortran_interfaces
347
348
      use elpa_utilities, only : error_unit
      class(elpa_impl_t)             :: self
349
350
      character(*), intent(in)       :: name
      integer(kind=c_int), pointer   :: value
Andreas Marek's avatar
Andreas Marek committed
351

352
353
      type(c_ptr)                    :: value_p

354
      value_p = elpa_index_get_int_loc_c(self%index, name // c_null_char)
355
356
357
      if (.not. c_associated(value_p)) then
        write(error_unit, '(a,a,a)') "ELPA: Warning, received NULL pointer for entry '", name, "'"
      endif
358
359
      call c_f_pointer(value_p, value)
    end function
Andreas Marek's avatar
Andreas Marek committed
360

361

362
    subroutine elpa_solve_real_double(self, a, ev, q, error)
363
364
      use elpa2_impl
      use elpa1_impl
365
      use elpa_utilities, only : error_unit
366
      use precision
Andreas Marek's avatar
Andreas Marek committed
367
      use iso_c_binding
368
      class(elpa_impl_t)  :: self
Andreas Marek's avatar
Andreas Marek committed
369

370
371
372
#ifdef USE_ASSUMED_SIZE
      real(kind=c_double) :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
373
      real(kind=c_double) :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
374
#endif
375
      real(kind=c_double) :: ev(self%na)
376

377
378
      integer, optional   :: error
      integer(kind=c_int) :: error_actual
379
      logical             :: success_l
380

381

382
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
383
        success_l = elpa_solve_evp_real_1stage_double_impl(self, a, ev, q)
384

385
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
386
        success_l = elpa_solve_evp_real_2stage_double_impl(self, a, ev, q)
387
388
389
390
      else
        print *,"unknown solver"
        stop
      endif
391

392
      if (present(error)) then
393
        if (success_l) then
394
          error = ELPA_OK
395
        else
396
          error = ELPA_ERROR
397
398
399
400
401
402
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in solve() and you did not check for errors!"
      endif
    end subroutine

403

404
    subroutine elpa_solve_real_single(self, a, ev, q, error)
405
406
      use elpa2_impl
      use elpa1_impl
407
      use elpa_utilities, only : error_unit
408
      use precision
409
      use iso_c_binding
410
      class(elpa_impl_t)  :: self
411
412
413
#ifdef USE_ASSUMED_SIZE
      real(kind=c_float)  :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
414
      real(kind=c_float)  :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
415
#endif
416
      real(kind=c_float)  :: ev(self%na)
417

418
419
      integer, optional   :: error
      integer(kind=c_int) :: error_actual
420
      logical             :: success_l
421

422
#ifdef WANT_SINGLE_PRECISION_REAL
423

424
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
425
        success_l = elpa_solve_evp_real_1stage_single_impl(self, a, ev, q)
426

427
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
428
        success_l = elpa_solve_evp_real_2stage_single_impl(self, a, ev, q)
429
430
431
432
      else
        print *,"unknown solver"
        stop
      endif
433

434
      if (present(error)) then
435
        if (success_l) then
436
          error = ELPA_OK
437
        else
438
          error = ELPA_ERROR
439
440
441
442
443
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in solve() and you did not check for errors!"
      endif
#else
444
      print *,"This installation of the ELPA library has not been build with single-precision support"
445
      error = ELPA_ERROR
446
447
448
#endif
    end subroutine

449

450
    subroutine elpa_solve_complex_double(self, a, ev, q, error)
451
452
      use elpa2_impl
      use elpa1_impl
453
      use elpa_utilities, only : error_unit
454
      use precision
455
      use iso_c_binding
456
      class(elpa_impl_t)             :: self
457

458
459
460
#ifdef USE_ASSUMED_SIZE
      complex(kind=c_double_complex) :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
461
      complex(kind=c_double_complex) :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
462
#endif
463
      real(kind=c_double)            :: ev(self%na)
464

465
466
      integer, optional              :: error
      integer(kind=c_int)            :: error_actual
467
      logical                        :: success_l
468

469
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
470
        success_l = elpa_solve_evp_complex_1stage_double_impl(self, a, ev, q)
471

472
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
473
        success_l = elpa_solve_evp_complex_2stage_double_impl(self,  a, ev, q)
474
475
476
477
      else
        print *,"unknown solver"
        stop
      endif
478

479
      if (present(error)) then
480
        if (success_l) then
481
          error = ELPA_OK
482
        else
483
          error = ELPA_ERROR
484
485
486
487
488
489
490
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in solve() and you did not check for errors!"
      endif
    end subroutine


491
    subroutine elpa_solve_complex_single(self, a, ev, q, error)
492
493
      use elpa2_impl
      use elpa1_impl
494
495
496
      use elpa_utilities, only : error_unit

      use iso_c_binding
497
      use precision
498
      class(elpa_impl_t)            :: self
499
500
501
502
503
504
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck4)             :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
      complex(kind=ck4)             :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
#endif
      real(kind=rk4)                :: ev(self%na)
505

506
507
      integer, optional             :: error
      integer(kind=c_int)           :: error_actual
508
      logical                       :: success_l
509
510

#ifdef WANT_SINGLE_PRECISION_COMPLEX
511

512
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
513
        success_l = elpa_solve_evp_complex_1stage_single_impl(self, a, ev, q)
514

515
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
516
        success_l = elpa_solve_evp_complex_2stage_single_impl(self,  a, ev, q)
517
518
519
520
      else
        print *,"unknown solver"
        stop
      endif
521

522
      if (present(error)) then
523
        if (success_l) then
524
          error = ELPA_OK
525
        else
526
          error = ELPA_ERROR
527
528
529
530
531
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in solve() and you did not check for errors!"
      endif
#else
532
      print *,"This installation of the ELPA library has not been build with single-precision support"
533
      error = ELPA_ERROR
534
535
536
#endif
    end subroutine

537

538
    subroutine elpa_multiply_at_b_double (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
539
                                          c, ldc, ldcCols, error)
540
      use iso_c_binding
541
      use elpa1_auxiliary_impl
542
      use precision
543
      class(elpa_impl_t)              :: self
544
      character*1                     :: uplo_a, uplo_c
545
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
546
547
548
#ifdef USE_ASSUMED_SIZE
      real(kind=rk8)                  :: a(lda,*), b(ldb,*), c(ldc,*)
#else
549
      real(kind=rk8)                  :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
550
#endif
551
      integer, optional               :: error
552
553
      logical                         :: success_l

554
555
      success_l = elpa_mult_at_b_real_double_impl(self, uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
                                                  c, ldc, ldcCols)
556
      if (present(error)) then
557
        if (success_l) then
558
          error = ELPA_OK
559
        else
560
          error = ELPA_ERROR
561
562
563
564
565
566
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in multiply_a_b() and you did not check for errors!"
      endif
    end subroutine

567

568
    subroutine elpa_multiply_at_b_single (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
569
                                          c, ldc, ldcCols, error)
570
      use iso_c_binding
571
      use elpa1_auxiliary_impl
572
      use precision
573
      class(elpa_impl_t)              :: self
574
      character*1                     :: uplo_a, uplo_c
575
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
576
577
578
#ifdef USE_ASSUMED_SIZE
      real(kind=rk4)                  :: a(lda,*), b(ldb,*), c(ldc,*)
#else
579
      real(kind=rk4)                  :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
580
#endif
581
      integer, optional               :: error
582
583
      logical                         :: success_l
#ifdef WANT_SINGLE_PRECISION_REAL
584
585
      success_l = elpa_mult_at_b_real_single_impl(self, uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
                                                  c, ldc, ldcCols)
586
      if (present(error)) then
587
        if (success_l) then
588
          error = ELPA_OK
589
        else
590
          error = ELPA_ERROR
591
592
593
594
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in multiply_a_b() and you did not check for errors!"
      endif
595
596
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
597
      error = ELPA_ERROR
598
599
600
#endif
    end subroutine

601

602
    subroutine elpa_multiply_ah_b_double (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
603
                                          c, ldc, ldcCols, error)
604
      use iso_c_binding
605
      use elpa1_auxiliary_impl
606
      use precision
607
      class(elpa_impl_t)              :: self
608
      character*1                     :: uplo_a, uplo_c
609
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
610
611
612
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck8)               :: a(lda,*), b(ldb,*), c(ldc,*)
#else
613
      complex(kind=ck8)               :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
614
#endif
615
      integer, optional               :: error
616
617
      logical                         :: success_l

618
619
      success_l = elpa_mult_ah_b_complex_double_impl(self, uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
                                                     c, ldc, ldcCols)
620
      if (present(error)) then
621
        if (success_l) then
622
          error = ELPA_OK
623
        else
624
          error = ELPA_ERROR
625
626
627
628
629
630
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in multiply_a_b() and you did not check for errors!"
      endif
    end subroutine

631

632
    subroutine elpa_multiply_ah_b_single (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
633
                                          c, ldc, ldcCols, error)
634
      use iso_c_binding
635
      use elpa1_auxiliary_impl
636
      use precision
637
      class(elpa_impl_t)              :: self
638
      character*1                     :: uplo_a, uplo_c
639
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
640
641
642
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck4)               :: a(lda,*), b(ldb,*), c(ldc,*)
#else
643
      complex(kind=ck4)               :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
644
#endif
645
      integer, optional               :: error
646
647
648
      logical                         :: success_l

#ifdef WANT_SINGLE_PRECISION_COMPLEX
649
650
      success_l = elpa_mult_ah_b_complex_single_impl(self, uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
                                                     c, ldc, ldcCols)
651
      if (present(error)) then
652
        if (success_l) then
653
          error = ELPA_OK
654
        else
655
          error = ELPA_ERROR
656
657
658
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in multiply_a_b() and you did not check for errors!"
659
      endif 
660
661
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
662
      error = ELPA_ERROR
663
664
665
#endif
    end subroutine

666

667
    subroutine elpa_cholesky_double_real (self, a, error)
668
      use iso_c_binding
669
      use elpa1_auxiliary_impl
670
      use precision
671
      class(elpa_impl_t)              :: self
672
673
674
#ifdef USE_ASSUMED_SIZE
      real(kind=rk8)                  :: a(self%local_nrows,*)
#else
675
      real(kind=rk8)                  :: a(self%local_nrows,self%local_ncols)
676
#endif
677
      integer, optional               :: error
678
      logical                         :: success_l
679
      integer(kind=c_int)             :: error_actual
680

681
      success_l = elpa_cholesky_real_double_impl (self, a)
682
      if (present(error)) then
683
        if (success_l) then
684
          error = ELPA_OK
685
        else
686
          error = ELPA_ERROR
687
688
689
690
691
692
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
      endif
    end subroutine

693

694
    subroutine elpa_cholesky_single_real(self, a, error)
695
      use iso_c_binding
696
      use elpa1_auxiliary_impl
697
      use precision
698
      class(elpa_impl_t)              :: self
699
700
701
#ifdef USE_ASSUMED_SIZE
      real(kind=rk4)                  :: a(self%local_nrows,*)
#else
702
      real(kind=rk4)                  :: a(self%local_nrows,self%local_ncols)
703
#endif
704
      integer, optional               :: error
705
      logical                         :: success_l
706
      integer(kind=c_int)             :: error_actual
707
708

#if WANT_SINGLE_PRECISION_REAL
709
      success_l = elpa_cholesky_real_single_impl (self, a)
710
711
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
712
      error = ELPA_ERROR
713
#endif
714
      if (present(error)) then
715
        if (success_l) then
716
          error = ELPA_OK
717
        else
718
          error = ELPA_ERROR
719
720
721
722
723
724
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
      endif
    end subroutine

725

726
    subroutine elpa_cholesky_double_complex (self, a, error)
727
      use iso_c_binding
728
      use elpa1_auxiliary_impl
729
      use precision
730
      class(elpa_impl_t)              :: self
731
732
733
734
735
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck8)               :: a(self%local_nrows,*)
#else
      complex(kind=ck8)               :: a(self%local_nrows,self%local_ncols)
#endif
736
      integer, optional               :: error
737
      logical                         :: success_l
738
      integer(kind=c_int)             :: error_actual
739

740
      success_l = elpa_cholesky_complex_double_impl (self, a)
741
      if (present(error)) then
742
        if (success_l) then
743
          error = ELPA_OK
744
        else
745
          error = ELPA_ERROR
746
747
748
749
750
751
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
      endif
    end subroutine

752

753
    subroutine elpa_cholesky_single_complex (self, a, error)
754
      use iso_c_binding
755
      use elpa1_auxiliary_impl
756
      use precision
757
      class(elpa_impl_t)              :: self
758
759
760
761
762
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck4)               :: a(self%local_nrows,*)
#else
      complex(kind=ck4)               :: a(self%local_nrows,self%local_ncols)
#endif
763
      integer, optional               :: error
764
      logical                         :: success_l
765
      integer(kind=c_int)             :: error_actual
766

767
#if WANT_SINGLE_PRECISION_COMPLEX
768
      success_l = elpa_cholesky_complex_single_impl (self, a)
769
770
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
771
      error = ELPA_ERROR
772
#endif
773
      if (present(error)) then
774
        if (success_l) then
775
          error = ELPA_OK
776
        else
777
          error = ELPA_ERROR
778
779
780
781
782
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
      endif
    end subroutine
783

784