elpa_impl.F90 31.6 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 51
module elpa_impl
  use elpa_api
52
  use, intrinsic :: iso_c_binding
53
  implicit none
54

55 56
  private
  public :: elpa_impl_allocate
57

58
  type, extends(elpa_t) :: elpa_impl_t
Andreas Marek's avatar
Andreas Marek committed
59
   private
60
   type(c_ptr)         :: index = C_NULL_PTR
61

62
   contains
63
     ! con-/destructor
64
     procedure, public :: setup => elpa_setup
65
     procedure, public :: destroy => elpa_destroy
66

67
     ! KV store
68
     procedure, public :: get => elpa_get_integer
69 70
     procedure, public :: get_double => elpa_get_double
     procedure, public :: is_set => elpa_is_set
71
     procedure, public :: can_set => elpa_can_set
72 73

     ! privates:
74

75
     procedure, private :: elpa_set_integer
76
     procedure, private :: elpa_set_double
77

78
     procedure, private :: elpa_solve_real_double
79
     procedure, private :: elpa_solve_real_single
80
     procedure, private :: elpa_solve_complex_double
81
     procedure, private :: elpa_solve_complex_single
82

83 84 85 86
     procedure, private :: elpa_multiply_at_b_double
     procedure, private :: elpa_multiply_at_b_single
     procedure, private :: elpa_multiply_ah_b_double
     procedure, private :: elpa_multiply_ah_b_single
87

88 89 90 91
     procedure, private :: elpa_cholesky_double_real
     procedure, private :: elpa_cholesky_single_real
     procedure, private :: elpa_cholesky_double_complex
     procedure, private :: elpa_cholesky_single_complex
92 93 94 95 96

     procedure, private :: elpa_invert_trm_double_real
     procedure, private :: elpa_invert_trm_single_real
     procedure, private :: elpa_invert_trm_double_complex
     procedure, private :: elpa_invert_trm_single_complex
97 98 99

     procedure, private :: elpa_solve_tridi_double_real
     procedure, private :: elpa_solve_tridi_single_real
100 101 102

     procedure, private :: associate_int => elpa_associate_int

103
  end type elpa_impl_t
104 105 106

  contains

107
    function elpa_impl_allocate(error) result(obj)
Andreas Marek's avatar
Andreas Marek committed
108 109
      use precision
      use elpa_utilities, only : error_unit
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
110
      use elpa_generated_fortran_interfaces
Andreas Marek's avatar
Andreas Marek committed
111

112 113 114 115
      type(elpa_impl_t), pointer   :: obj
      integer, optional            :: error

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

Andreas Marek's avatar
Andreas Marek committed
117 118
      ! check whether init has ever been called
      if (.not.(elpa_initialized())) then
119
        write(error_unit, *) "elpa_allocate(): you must call elpa_init() once before creating instances of ELPA"
120 121
        if(present(error)) then
          error = ELPA_ERROR
122
        endif
Andreas Marek's avatar
Andreas Marek committed
123 124
        return
      endif
Andreas Marek's avatar
Andreas Marek committed
125

126
      obj%index = elpa_index_instance_c()
127 128

      ! Associate some important integer pointers for convenience
129 130 131 132 133 134 135 136
      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
137 138
      endif
    end function
Andreas Marek's avatar
Andreas Marek committed
139

140

141
    function elpa_setup(self) result(error)
142
      use elpa1_impl, only : elpa_get_communicators_impl
143
      class(elpa_impl_t), intent(inout) :: self
144
      integer :: error, error2
145
      integer :: mpi_comm_rows, mpi_comm_cols, mpierr
146

147
      error = ELPA_ERROR
148

149 150 151
      if (self%is_set("mpi_comm_parent") == 1 .and. &
          self%is_set("process_row") == 1 .and. &
          self%is_set("process_col") == 1) then
152

153 154 155 156 157 158
        mpierr = elpa_get_communicators_impl(&
                        self%get("mpi_comm_parent"), &
                        self%get("process_row"), &
                        self%get("process_col"), &
                        mpi_comm_rows, &
                        mpi_comm_cols)
159

160 161 162
        call self%set("mpi_comm_rows", mpi_comm_rows)
        call self%set("mpi_comm_cols", mpi_comm_cols)

163
        error = ELPA_OK
164
      endif
165

166 167
      if (self%is_set("mpi_comm_rows") == 1 .and. self%is_set("mpi_comm_cols") == 1) then
        error = ELPA_OK
168
      endif
169 170

    end function
171

172
    subroutine elpa_set_integer(self, name, value, error)
173
      use iso_c_binding
174 175
      use elpa_generated_fortran_interfaces
      use elpa_utilities, only : error_unit
176
      class(elpa_impl_t)              :: self
177 178
      character(*), intent(in)        :: name
      integer(kind=c_int), intent(in) :: value
179 180
      integer, optional               :: error
      integer                         :: actual_error
181

182
      actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value, 0)
183

184 185
      if (present(error)) then
        error = actual_error
186

187
      else if (actual_error /= ELPA_OK) then
188 189
        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!"
190
      end if
191 192
    end subroutine

193

194
    function elpa_get_integer(self, name, error) result(value)
195
      use iso_c_binding
196
      use elpa_generated_fortran_interfaces
197
      use elpa_utilities, only : error_unit
198
      class(elpa_impl_t)             :: self
199 200
      character(*), intent(in)       :: name
      integer(kind=c_int)            :: value
201
      integer, intent(out), optional :: error
202
      integer                        :: actual_error
203

204 205 206 207 208 209 210
      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
211
    end function
Andreas Marek's avatar
Andreas Marek committed
212

213 214

    function elpa_is_set(self, name) result(state)
215 216
      use iso_c_binding
      use elpa_generated_fortran_interfaces
217
      class(elpa_impl_t)       :: self
218
      character(*), intent(in) :: name
219
      integer                  :: state
220

221
      state = elpa_index_value_is_set_c(self%index, name // c_null_char)
222 223
    end function

224

225 226 227 228 229 230 231 232 233 234 235 236 237
    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)
238 239 240
      use elpa_generated_fortran_interfaces
      class(elpa_impl_t), intent(in) :: self
      character(kind=c_char, len=*), intent(in) :: option_name
241 242 243 244
      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
245

246 247 248 249 250 251 252 253
      nullify(string)

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

256 257 258 259
      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
260

261 262 263 264
      if (present(error)) then
        error = actual_error
      endif
    end function
265

266 267

    subroutine elpa_set_double(self, name, value, error)
Andreas Marek's avatar
Andreas Marek committed
268
      use iso_c_binding
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
269
      use elpa_generated_fortran_interfaces
270
      use elpa_utilities, only : error_unit
271
      class(elpa_impl_t)              :: self
272
      character(*), intent(in)        :: name
273
      real(kind=c_double), intent(in) :: value
274 275
      integer, optional               :: error
      integer                         :: actual_error
Andreas Marek's avatar
Andreas Marek committed
276

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

279 280 281
      if (present(error)) then
        error = actual_error
      else if (actual_error /= ELPA_OK) then
282 283
        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!"
284 285
      end if
    end subroutine
Andreas Marek's avatar
Andreas Marek committed
286 287


288
    function elpa_get_double(self, name, error) result(value)
Andreas Marek's avatar
Andreas Marek committed
289
      use iso_c_binding
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
290
      use elpa_generated_fortran_interfaces
291
      use elpa_utilities, only : error_unit
292
      class(elpa_impl_t)             :: self
293
      character(*), intent(in)       :: name
294
      real(kind=c_double)            :: value
295
      integer, intent(out), optional :: error
296
      integer                        :: actual_error
297

298 299 300 301 302 303 304
      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
305
    end function
Andreas Marek's avatar
Andreas Marek committed
306 307


308
    function elpa_associate_int(self, name) result(value)
Andreas Marek's avatar
Andreas Marek committed
309
      use iso_c_binding
310
      use elpa_generated_fortran_interfaces
311 312
      use elpa_utilities, only : error_unit
      class(elpa_impl_t)             :: self
313 314
      character(*), intent(in)       :: name
      integer(kind=c_int), pointer   :: value
Andreas Marek's avatar
Andreas Marek committed
315

316 317
      type(c_ptr)                    :: value_p

318
      value_p = elpa_index_get_int_loc_c(self%index, name // c_null_char)
319 320 321
      if (.not. c_associated(value_p)) then
        write(error_unit, '(a,a,a)') "ELPA: Warning, received NULL pointer for entry '", name, "'"
      endif
322 323
      call c_f_pointer(value_p, value)
    end function
Andreas Marek's avatar
Andreas Marek committed
324

325

326
    subroutine elpa_solve_real_double(self, a, ev, q, error)
327 328
      use elpa2_impl
      use elpa1_impl
329
      use elpa_utilities, only : error_unit
330
      use precision
Andreas Marek's avatar
Andreas Marek committed
331
      use iso_c_binding
332
      class(elpa_impl_t)  :: self
Andreas Marek's avatar
Andreas Marek committed
333

334 335 336
#ifdef USE_ASSUMED_SIZE
      real(kind=c_double) :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
337
      real(kind=c_double) :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
338
#endif
339
      real(kind=c_double) :: ev(self%na)
340

341 342
      integer, optional   :: error
      integer(kind=c_int) :: error_actual
343
      logical             :: success_l
344

345

346
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
347
        success_l = elpa_solve_evp_real_1stage_double_impl(self, a, ev, q)
348

349
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
350
        success_l = elpa_solve_evp_real_2stage_double_impl(self, a, ev, q)
351 352 353 354
      else
        print *,"unknown solver"
        stop
      endif
355

356
      if (present(error)) then
357
        if (success_l) then
358
          error = ELPA_OK
359
        else
360
          error = ELPA_ERROR
361 362 363 364 365 366
        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

367

368
    subroutine elpa_solve_real_single(self, a, ev, q, error)
369 370
      use elpa2_impl
      use elpa1_impl
371
      use elpa_utilities, only : error_unit
372
      use precision
373
      use iso_c_binding
374
      class(elpa_impl_t)  :: self
375 376 377
#ifdef USE_ASSUMED_SIZE
      real(kind=c_float)  :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
378
      real(kind=c_float)  :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
379
#endif
380
      real(kind=c_float)  :: ev(self%na)
381

382 383
      integer, optional   :: error
      integer(kind=c_int) :: error_actual
384
      logical             :: success_l
385

386
#ifdef WANT_SINGLE_PRECISION_REAL
387

388
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
389
        success_l = elpa_solve_evp_real_1stage_single_impl(self, a, ev, q)
390

391
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
392
        success_l = elpa_solve_evp_real_2stage_single_impl(self, a, ev, q)
393 394 395 396
      else
        print *,"unknown solver"
        stop
      endif
397

398
      if (present(error)) then
399
        if (success_l) then
400
          error = ELPA_OK
401
        else
402
          error = ELPA_ERROR
403 404 405 406 407
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in solve() and you did not check for errors!"
      endif
#else
408
      print *,"This installation of the ELPA library has not been build with single-precision support"
409
      error = ELPA_ERROR
410 411 412
#endif
    end subroutine

413

414
    subroutine elpa_solve_complex_double(self, a, ev, q, error)
415 416
      use elpa2_impl
      use elpa1_impl
417
      use elpa_utilities, only : error_unit
418
      use precision
419
      use iso_c_binding
420
      class(elpa_impl_t)             :: self
421

422 423 424
#ifdef USE_ASSUMED_SIZE
      complex(kind=c_double_complex) :: a(self%local_nrows, *), q(self%local_nrows, *)
#else
425
      complex(kind=c_double_complex) :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
426
#endif
427
      real(kind=c_double)            :: ev(self%na)
428

429 430
      integer, optional              :: error
      integer(kind=c_int)            :: error_actual
431
      logical                        :: success_l
432

433
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
434
        success_l = elpa_solve_evp_complex_1stage_double_impl(self, a, ev, q)
435

436
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
437
        success_l = elpa_solve_evp_complex_2stage_double_impl(self,  a, ev, q)
438 439 440 441
      else
        print *,"unknown solver"
        stop
      endif
442

443
      if (present(error)) then
444
        if (success_l) then
445
          error = ELPA_OK
446
        else
447
          error = ELPA_ERROR
448 449 450 451 452 453 454
        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


455
    subroutine elpa_solve_complex_single(self, a, ev, q, error)
456 457
      use elpa2_impl
      use elpa1_impl
458 459 460
      use elpa_utilities, only : error_unit

      use iso_c_binding
461
      use precision
462
      class(elpa_impl_t)            :: self
463 464 465 466 467 468
#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)
469

470 471
      integer, optional             :: error
      integer(kind=c_int)           :: error_actual
472
      logical                       :: success_l
473 474

#ifdef WANT_SINGLE_PRECISION_COMPLEX
475

476
      if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
477
        success_l = elpa_solve_evp_complex_1stage_single_impl(self, a, ev, q)
478

479
      else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
480
        success_l = elpa_solve_evp_complex_2stage_single_impl(self,  a, ev, q)
481 482 483 484
      else
        print *,"unknown solver"
        stop
      endif
485

486
      if (present(error)) then
487
        if (success_l) then
488
          error = ELPA_OK
489
        else
490
          error = ELPA_ERROR
491 492 493 494 495
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in solve() and you did not check for errors!"
      endif
#else
496
      print *,"This installation of the ELPA library has not been build with single-precision support"
497
      error = ELPA_ERROR
498 499 500
#endif
    end subroutine

501

502
    subroutine elpa_multiply_at_b_double (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
503
                                          c, ldc, ldcCols, error)
504
      use iso_c_binding
505
      use elpa1_auxiliary_impl
506
      use precision
507
      class(elpa_impl_t)              :: self
508
      character*1                     :: uplo_a, uplo_c
509
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
510 511 512
#ifdef USE_ASSUMED_SIZE
      real(kind=rk8)                  :: a(lda,*), b(ldb,*), c(ldc,*)
#else
513
      real(kind=rk8)                  :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
514
#endif
515
      integer, optional               :: error
516 517
      logical                         :: success_l

518 519
      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)
520
      if (present(error)) then
521
        if (success_l) then
522
          error = ELPA_OK
523
        else
524
          error = ELPA_ERROR
525 526 527 528 529 530
        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

531

532
    subroutine elpa_multiply_at_b_single (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
533
                                          c, ldc, ldcCols, error)
534
      use iso_c_binding
535
      use elpa1_auxiliary_impl
536
      use precision
537
      class(elpa_impl_t)              :: self
538
      character*1                     :: uplo_a, uplo_c
539
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
540 541 542
#ifdef USE_ASSUMED_SIZE
      real(kind=rk4)                  :: a(lda,*), b(ldb,*), c(ldc,*)
#else
543
      real(kind=rk4)                  :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
544
#endif
545
      integer, optional               :: error
546 547
      logical                         :: success_l
#ifdef WANT_SINGLE_PRECISION_REAL
548 549
      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)
550
      if (present(error)) then
551
        if (success_l) then
552
          error = ELPA_OK
553
        else
554
          error = ELPA_ERROR
555 556 557 558
        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
559 560
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
561
      error = ELPA_ERROR
562 563 564
#endif
    end subroutine

565

566
    subroutine elpa_multiply_ah_b_double (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
567
                                          c, ldc, ldcCols, error)
568
      use iso_c_binding
569
      use elpa1_auxiliary_impl
570
      use precision
571
      class(elpa_impl_t)              :: self
572
      character*1                     :: uplo_a, uplo_c
573
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
574 575 576
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck8)               :: a(lda,*), b(ldb,*), c(ldc,*)
#else
577
      complex(kind=ck8)               :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
578
#endif
579
      integer, optional               :: error
580 581
      logical                         :: success_l

582 583
      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)
584
      if (present(error)) then
585
        if (success_l) then
586
          error = ELPA_OK
587
        else
588
          error = ELPA_ERROR
589 590 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
    end subroutine

595

596
    subroutine elpa_multiply_ah_b_single (self,uplo_a, uplo_c, na, ncb, a, lda, ldaCols, b, ldb, ldbCols, &
597
                                          c, ldc, ldcCols, error)
598
      use iso_c_binding
599
      use elpa1_auxiliary_impl
600
      use precision
601
      class(elpa_impl_t)              :: self
602
      character*1                     :: uplo_a, uplo_c
603
      integer(kind=ik), intent(in)    :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, ncb
604 605 606
#ifdef USE_ASSUMED_SIZE
      complex(kind=ck4)               :: a(lda,*), b(ldb,*), c(ldc,*)
#else
607
      complex(kind=ck4)               :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
608
#endif
609
      integer, optional               :: error
610 611 612
      logical                         :: success_l

#ifdef WANT_SINGLE_PRECISION_COMPLEX
613 614
      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)
615
      if (present(error)) then
616
        if (success_l) then
617
          error = ELPA_OK
618
        else
619
          error = ELPA_ERROR
620 621 622
        endif
      else if (.not. success_l) then
        write(error_unit,'(a)') "ELPA: Error in multiply_a_b() and you did not check for errors!"
623
      endif 
624 625
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
626
      error = ELPA_ERROR
627 628 629
#endif
    end subroutine

630

631
    subroutine elpa_cholesky_double_real (self, a, error)
632
      use iso_c_binding
633
      use elpa1_auxiliary_impl
634
      use precision
635
      class(elpa_impl_t)              :: self
636 637 638
#ifdef USE_ASSUMED_SIZE
      real(kind=rk8)                  :: a(self%local_nrows,*)
#else
639
      real(kind=rk8)                  :: a(self%local_nrows,self%local_ncols)
640
#endif
641
      integer, optional               :: error
642
      logical                         :: success_l
643
      integer(kind=c_int)             :: error_actual
644

645
      success_l = elpa_cholesky_real_double_impl (self, a)
646
      if (present(error)) then
647
        if (success_l) then
648
          error = ELPA_OK
649
        else
650
          error = ELPA_ERROR
651 652 653 654 655 656
        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

657

658
    subroutine elpa_cholesky_single_real(self, a, error)
659
      use iso_c_binding
660
      use elpa1_auxiliary_impl
661
      use precision
662
      class(elpa_impl_t)              :: self
663 664 665
#ifdef USE_ASSUMED_SIZE
      real(kind=rk4)                  :: a(self%local_nrows,*)
#else
666
      real(kind=rk4)                  :: a(self%local_nrows,self%local_ncols)
667
#endif
668
      integer, optional               :: error
669
      logical                         :: success_l
670
      integer(kind=c_int)             :: error_actual
671 672

#if WANT_SINGLE_PRECISION_REAL
673
      success_l = elpa_cholesky_real_single_impl (self, a)
674 675
#else
      print *,"This installation of the ELPA library has not been build with single-precision support"
676
      error = ELPA_ERROR
677
#endif
678
      if (present(error)) then
679
        if (success_l) then
680
          error = ELPA_OK
681
        else
682
          error = ELPA_ERROR
683 684 685 686 687 688
        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

689