Eigenvalue SoLvers for Petaflop-Applications (ELPA) 2024.05.001
Loading...
Searching...
No Matches
elpa_impl_math_template.F90
Go to the documentation of this file.
1!
2! Copyright 2017, L. Hüdepohl and A. Marek, MPCDF
3!
4! This file is part of ELPA.
5!
6! The ELPA library was originally created by the ELPA consortium,
7! consisting of the following organizations:
8!
9! - Max Planck Computing and Data Facility (MPCDF), formerly known as
10! Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
11! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
12! Informatik,
13! - Technische Universität München, Lehrstuhl für Informatik mit
14! Schwerpunkt Wissenschaftliches Rechnen ,
15! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
16! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
17! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
18! and
19! - IBM Deutschland GmbH
20!
21! This particular source code file contains additions, changes and
22! enhancements authored by Intel Corporation which is not part of
23! the ELPA consortium.
24!
25! More information can be found here:
26! http://elpa.mpcdf.mpg.de/
27!
28! ELPA is free software: you can redistribute it and/or modify
29! it under the terms of the version 3 of the license of the
30! GNU Lesser General Public License as published by the Free
31! Software Foundation.
32!
33! ELPA is distributed in the hope that it will be useful,
34! but WITHOUT ANY WARRANTY; without even the implied warranty of
35! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
36! GNU Lesser General Public License for more details.
37!
38! You should have received a copy of the GNU Lesser General Public License
39! along with ELPA. If not, see <http://www.gnu.org/licenses/>
40!
41! ELPA reflects a substantial effort on the part of the original
42! ELPA consortium, and we ask you to respect the spirit of the
43! license that we chose: i.e., please contribute any changes you
44! may have back to the original ELPA library distribution, and keep
45! any derivatives of ELPA under the same license that we chose for
46! the original distribution, the GNU Lesser General Public License.
47!
48
49 !_____________________________________________________________________________________________________________________
50 ! hermitian_multiply
51
87 subroutine elpa_hermitian_multiply_a_h_a_&
88 &elpa_impl_suffix&
89 & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
90 c, nrows_c, ncols_c, error)
91 class(elpa_impl_t) :: self
92 character*1 :: uplo_a, uplo_c
93 integer(kind=c_int), intent(in) :: nrows_b, ncols_b, nrows_c, ncols_c, ncb
94#ifdef USE_ASSUMED_SIZE
95 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,*), b(nrows_b,*), c(nrows_c,*)
96#else
97 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,self%local_ncols), b(nrows_b,ncols_b), c(nrows_c,ncols_c)
98#endif
99#ifdef USE_FORTRAN2008
100 integer, optional :: error
101#else
102 integer :: error
103#endif
104 logical :: success_l
105
106 success_l = .false.
107#if defined(INCLUDE_ROUTINES)
108#ifdef REALCASE
109 success_l = elpa_mult_at_b_a_h_a_&
110#endif
111#ifdef COMPLEXCASE
112 success_l = elpa_mult_ah_b_a_h_a_&
113#endif
114 &math_datatype&
115 &_&
116 &precision&
117 &_impl(self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
118 c, nrows_c, ncols_c)
119#endif
120#ifdef USE_FORTRAN2008
121 if (present(error)) then
122 if (success_l) then
123 error = elpa_ok
124 else
125 error = elpa_error
126 endif
127 else if (.not. success_l) then
128 write(error_unit,'(a)') "ELPA: Error in hermitian_multiply() and you did not check for errors!"
129 endif
130#else
131 if (success_l) then
132 error = elpa_ok
133 else
134 error = elpa_error
135 endif
136#endif
137 end subroutine
138
139
175 subroutine elpa_hermitian_multiply_d_ptr_&
176 &elpa_impl_suffix&
177 & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
178 c, nrows_c, ncols_c, error)
179 class(elpa_impl_t) :: self
180 character*1 :: uplo_a, uplo_c
181 integer(kind=c_int), intent(in) :: nrows_b, ncols_b, nrows_c, ncols_c, ncb
182 type(c_ptr) :: a, b, c
183#ifdef USE_FORTRAN2008
184 integer, optional :: error
185#else
186 integer :: error
187#endif
188 logical :: success_l
189
190 success_l = .false.
191#if defined(INCLUDE_ROUTINES)
192#ifdef REALCASE
193 success_l = elpa_mult_at_b_d_ptr_&
194#endif
195#ifdef COMPLEXCASE
196 success_l = elpa_mult_ah_b_d_ptr_&
197#endif
198 &math_datatype&
199 &_&
200 &precision&
201 &_impl(self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
202 c, nrows_c, ncols_c)
203#endif
204#ifdef USE_FORTRAN2008
205 if (present(error)) then
206 if (success_l) then
207 error = elpa_ok
208 else
209 error = elpa_error
210 endif
211 else if (.not. success_l) then
212 write(error_unit,'(a)') "ELPA: Error in hermitian_multiply() and you did not check for errors!"
213 endif
214#else
215 if (success_l) then
216 error = elpa_ok
217 else
218 error = elpa_error
219 endif
220#endif
221 end subroutine
222
223 !c> // /src/elpa_impl_math_template.F90
224
225#ifdef REALCASE
226#ifdef DOUBLE_PRECISION_REAL
227 !c> void elpa_hermitian_multiply_a_h_a_d(elpa_t handle, char uplo_a, char uplo_c, int ncb, double *a, double *b, int nrows_b, int ncols_b, double *c, int nrows_c, int ncols_c, int *error);
228#endif
229#ifdef SINGLE_PRECISION_REAL
230 !c> void elpa_hermitian_multiply_a_h_a_f(elpa_t handle, char uplo_a, char uplo_c, int ncb, float *a, float *b, int nrows_b, int ncols_b, float *c, int nrows_c, int ncols_c, int *error);
231#endif
232#endif
233#ifdef COMPLEXCASE
234#ifdef DOUBLE_PRECISION_COMPLEX
235 !c> void elpa_hermitian_multiply_a_h_a_dc(elpa_t handle, char uplo_a, char uplo_c, int ncb, double_complex *a, double_complex *b, int nrows_b, int ncols_b, double_complex *c, int nrows_c, int ncols_c, int *error);
236#endif
237#ifdef SINGLE_PRECISION_COMPLEX
238 !c> void elpa_hermitian_multiply_a_h_a_fc(elpa_t handle, char uplo_a, char uplo_c, int ncb, float_complex *a, float_complex *b, int nrows_b, int ncols_b, float_complex *c, int nrows_c, int ncols_c, int *error);
239#endif
240#endif
241 subroutine elpa_hermitian_multiply_a_h_a_&
242 &elpa_impl_suffix&
243 &_c(handle, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
244 ncols_b, c_p, nrows_c, ncols_c, error) &
245#ifdef REALCASE
246#ifdef DOUBLE_PRECISION_REAL
247 bind(C, name="elpa_hermitian_multiply_a_h_a_d")
248#endif
249#ifdef SINGLE_PRECISION_REAL
250 bind(C, name="elpa_hermitian_multiply_a_h_a_f")
251#endif
252#endif
253#ifdef COMPLEXCASE
254#ifdef DOUBLE_PRECISION_COMPLEX
255 bind(C, name="elpa_hermitian_multiply_a_h_a_dc")
256#endif
257#ifdef SINGLE_PRECISION_COMPLEX
258 bind(C, name="elpa_hermitian_multiply_a_h_a_fc")
259#endif
260#endif
261
262 type(c_ptr), intent(in), value :: handle, a_p, b_p, c_p
263 character(1,C_CHAR), value :: uplo_a, uplo_c
264 integer(kind=c_int), value :: ncb, nrows_b, ncols_b, nrows_c, ncols_c
265#ifdef USE_FORTRAN2008
266 integer(kind=c_int), optional, intent(in) :: error
267#else
268 integer(kind=c_int), intent(in) :: error
269#endif
270 math_datatype(kind=c_datatype_kind), pointer :: a(:, :), b(:,:), c(:,:)
271!#ifdef USE_ASSUMED_SIZE
272! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: b(nrows_b,*), c(nrows_c,*)
273!#else
274! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: b(nrows_b,ncols_b), c(nrows_c,ncols_c)
275!#endif
276 type(elpa_impl_t), pointer :: self
277
278 call c_f_pointer(handle, self)
279 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
280 call c_f_pointer(b_p, b, [nrows_b, ncols_b])
281 call c_f_pointer(c_p, c, [nrows_c, ncols_c])
282
283 call elpa_hermitian_multiply_a_h_a_&
284 &elpa_impl_suffix&
285 & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, &
286 ncols_b, c, nrows_c, ncols_c, error)
287 end subroutine
288
289#ifdef REALCASE
290#ifdef DOUBLE_PRECISION_REAL
291 !c> void elpa_hermitian_multiply_d_ptr_d(elpa_t handle, char uplo_a, char uplo_c, int ncb, double *a, double *b, int nrows_b, int ncols_b, double *c, int nrows_c, int ncols_c, int *error);
292#endif
293#ifdef SINGLE_PRECISION_REAL
294 !c> void elpa_hermitian_multiply_d_ptr_f(elpa_t handle, char uplo_a, char uplo_c, int ncb, float *a, float *b, int nrows_b, int ncols_b, float *c, int nrows_c, int ncols_c, int *error);
295#endif
296#endif
297#ifdef COMPLEXCASE
298#ifdef DOUBLE_PRECISION_COMPLEX
299 !c> void elpa_hermitian_multiply_d_ptr_dc(elpa_t handle, char uplo_a, char uplo_c, int ncb, double_complex *a, double_complex *b, int nrows_b, int ncols_b, double_complex *c, int nrows_c, int ncols_c, int *error);
300#endif
301#ifdef SINGLE_PRECISION_COMPLEX
302 !c> void elpa_hermitian_multiply_d_ptr_fc(elpa_t handle, char uplo_a, char uplo_c, int ncb, float_complex *a, float_complex *b, int nrows_b, int ncols_b, float_complex *c, int nrows_c, int ncols_c, int *error);
303#endif
304#endif
305 subroutine elpa_hermitian_multiply_d_ptr_&
306 &elpa_impl_suffix&
307 &_c(handle, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
308 ncols_b, c_p, nrows_c, ncols_c, error) &
309#ifdef REALCASE
310#ifdef DOUBLE_PRECISION_REAL
311 bind(C, name="elpa_hermitian_multiply_d_ptr_d")
312#endif
313#ifdef SINGLE_PRECISION_REAL
314 bind(C, name="elpa_hermitian_multiply_d_ptr_f")
315#endif
316#endif
317#ifdef COMPLEXCASE
318#ifdef DOUBLE_PRECISION_COMPLEX
319 bind(C, name="elpa_hermitian_multiply_d_ptr_dc")
320#endif
321#ifdef SINGLE_PRECISION_COMPLEX
322 bind(C, name="elpa_hermitian_multiply_d_ptr_fc")
323#endif
324#endif
325
326 type(c_ptr), intent(in), value :: handle, a_p, b_p, c_p
327 character(1,C_CHAR), value :: uplo_a, uplo_c
328 integer(kind=c_int), value :: ncb, nrows_b, ncols_b, nrows_c, ncols_c
329#ifdef USE_FORTRAN2008
330 integer(kind=c_int), optional, intent(in) :: error
331#else
332 integer(kind=c_int), intent(in) :: error
333#endif
334 type(elpa_impl_t), pointer :: self
335
336 call c_f_pointer(handle, self)
337 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
338
339 call elpa_hermitian_multiply_d_ptr_&
340 &elpa_impl_suffix&
341 & (self, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
342 ncols_b, c_p, nrows_c, ncols_c, error)
343 end subroutine
344
345 !_____________________________________________________________________________________________________________________
346 ! multiply
347
348! !> \brief elpa_multiply_a_h_a_d: class method to perform C : = op(A) * B
349! !> where op(A) is one of: A, A**T, A**H
350! !> A is a square matrix (self%na,self%na) which is optionally upper or lower triangular ! PETERDEBUG: does the matrix have to be square?
351! !> B is a (self%na,ncb) matrix
352! !> C is a (self%na,ncb) matrix where optionally only the upper or lower
353! !> triangle may be computed
354! !>
355! !> the MPI commicators and the block-cyclic distribution block size are already known to the type.
356! !> Thus the class method "setup" must be called BEFORE this method is used
357! !>
358! !> \details
359! !>
360! !> \param self class(elpa_t), the ELPA object
361! !> \param uplo_a 'U' if A is upper triangular
362! !> 'L' if A is lower triangular
363! !> anything else if A is a full matrix
364! !> Please note: U/L label pertains to the original A (as set in the calling program)
365! !> whereas the transpose of A is might be used for calculations
366! !> If uplo_a is 'U' or 'L', the other triangle is not used at all,
367! !> i.e. it may contain arbitrary numbers
368! !> \param uplo_c 'U' if only the upper-triangle part of C is needed
369! !> 'L' if only the lower-triangle part of C is needed
370! !> anything else if the full matrix C is needed
371! !> Please note: Even when uplo_c is 'U' or 'L', the other triangle may be
372! !> written to a certain extent, i.e. one shouldn't rely on the content there!
373! !> \param trans_a
374! !> \param ncb Number of columns of global matrices B and C
375! !> \param a matrix a
376! !> \param local_nrows number of rows of local (sub) matrix a, set with class method set("local_nrows",value)
377! !> \param local_ncols number of columns of local (sub) matrix a, set with class method set("local_ncols",value)
378! !> \param b matrix b
379! !> \param nrows_b number of rows of local (sub) matrix b
380! !> \param ncols_b number of columns of local (sub) matrix b
381! !> \param c matrix c
382! !> \param nrows_c number of rows of local (sub) matrix c
383! !> \param ncols_c number of columns of local (sub) matrix c
384! !> \param error optional argument, error code which can be queried with elpa_strerr
385! subroutine elpa_multiply_a_h_a_&
386! &ELPA_IMPL_SUFFIX&
387! & (self, uplo_a, uplo_c, trans_a, ncb, a, b, nrows_b, ncols_b, &
388! c, nrows_c, ncols_c, error)
389! class(elpa_impl_t) :: self
390! character*1 :: uplo_a, uplo_c, trans_a
391! integer(kind=c_int), intent(in) :: nrows_b, ncols_b, nrows_c, ncols_c, ncb
392! #ifdef USE_ASSUMED_SIZE
393! MATH_DATATYPE(kind=C_DATATYPE_KIND) :: a(self%local_nrows,*), b(nrows_b,*), c(nrows_c,*)
394! #else
395! MATH_DATATYPE(kind=C_DATATYPE_KIND) :: a(self%local_nrows,self%local_ncols), b(nrows_b,ncols_b), c(nrows_c,ncols_c)
396! #endif
397! #ifdef USE_FORTRAN2008
398! integer, optional :: error
399! #else
400! integer :: error
401! #endif
402! logical :: success_l
403
404! success_l = .false.
405! #if defined(INCLUDE_ROUTINES)
406! #ifdef REALCASE
407! success_l = elpa_mult_at_b_a_h_a_&
408! #endif
409! #ifdef COMPLEXCASE
410! success_l = elpa_mult_ah_b_a_h_a_&
411! #endif
412! &MATH_DATATYPE&
413! &_&
414! &PRECISION&
415! &_impl(self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
416! c, nrows_c, ncols_c)
417! #endif
418! #ifdef USE_FORTRAN2008
419! if (present(error)) then
420! if (success_l) then
421! error = ELPA_OK
422! else
423! error = ELPA_ERROR
424! endif
425! else if (.not. success_l) then
426! write(error_unit,'(a)') "ELPA: Error in hermitian_multiply() and you did not check for errors!"
427! endif
428! #else
429! if (success_l) then
430! error = ELPA_OK
431! else
432! error = ELPA_ERROR
433! endif
434! #endif
435! end subroutine
436
437
438! !> \brief elpa_hermitian_multiply_d_ptr_d: class method to perform C : = A**T * B
439! !> where A is a square matrix (self%na,self%na) which is optionally upper or lower triangular
440! !> B is a (self%na,ncb) matrix
441! !> C is a (self%na,ncb) matrix where optionally only the upper or lower
442! !> triangle may be computed
443! !>
444! !> the MPI commicators and the block-cyclic distribution block size are already known to the type.
445! !> Thus the class method "setup" must be called BEFORE this method is used
446! !>
447! !> \details
448! !>
449! !> \param self class(elpa_t), the ELPA object
450! !> \param uplo_a 'U' if A is upper triangular
451! !> 'L' if A is lower triangular
452! !> anything else if A is a full matrix
453! !> Please note: This pertains to the original A (as set in the calling program)
454! !> whereas the transpose of A is used for calculations
455! !> If uplo_a is 'U' or 'L', the other triangle is not used at all,
456! !> i.e. it may contain arbitrary numbers
457! !> \param uplo_c 'U' if only the upper diagonal part of C is needed
458! !> 'L' if only the upper diagonal part of C is needed
459! !> anything else if the full matrix C is needed
460! !> Please note: Even when uplo_c is 'U' or 'L', the other triangle may be
461! !> written to a certain extent, i.e. one shouldn't rely on the content there!
462! !> \param ncb Number of columns of global matrices B and C
463! !> \param a matrix a, as device pointer of type(c_ptr)
464! !> \param local_nrows number of rows of local (sub) matrix a, set with class method set("local_nrows",value)
465! !> \param local_ncols number of columns of local (sub) matrix a, set with class method set("local_ncols",value)
466! !> \param b matrix b, as device pointer of type(c_ptr)
467! !> \param nrows_b number of rows of local (sub) matrix b
468! !> \param ncols_b number of columns of local (sub) matrix b
469! !> \param c matrix c, as device pointer of type(c_ptr)
470! !> \param nrows_c number of rows of local (sub) matrix c
471! !> \param ncols_c number of columns of local (sub) matrix c
472! !> \param error optional argument, error code which can be queried with elpa_strerr
473! subroutine elpa_hermitian_multiply_d_ptr_&
474! &ELPA_IMPL_SUFFIX&
475! & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
476! c, nrows_c, ncols_c, error)
477! class(elpa_impl_t) :: self
478! character*1 :: uplo_a, uplo_c
479! integer(kind=c_int), intent(in) :: nrows_b, ncols_b, nrows_c, ncols_c, ncb
480! type(c_ptr) :: a, b, c
481! #ifdef USE_FORTRAN2008
482! integer, optional :: error
483! #else
484! integer :: error
485! #endif
486! logical :: success_l
487
488! success_l = .false.
489! #if defined(INCLUDE_ROUTINES)
490! #ifdef REALCASE
491! success_l = elpa_mult_at_b_d_ptr_&
492! #endif
493! #ifdef COMPLEXCASE
494! success_l = elpa_mult_ah_b_d_ptr_&
495! #endif
496! &MATH_DATATYPE&
497! &_&
498! &PRECISION&
499! &_impl(self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
500! c, nrows_c, ncols_c)
501! #endif
502! #ifdef USE_FORTRAN2008
503! if (present(error)) then
504! if (success_l) then
505! error = ELPA_OK
506! else
507! error = ELPA_ERROR
508! endif
509! else if (.not. success_l) then
510! write(error_unit,'(a)') "ELPA: Error in hermitian_multiply() and you did not check for errors!"
511! endif
512! #else
513! if (success_l) then
514! error = ELPA_OK
515! else
516! error = ELPA_ERROR
517! endif
518! #endif
519! end subroutine
520
521! !c> // /src/elpa_impl_math_template.F90
522
523! #ifdef REALCASE
524! #ifdef DOUBLE_PRECISION_REAL
525! !c> void elpa_hermitian_multiply_a_h_a_d(elpa_t handle, char uplo_a, char uplo_c, int ncb, double *a, double *b, int nrows_b, int ncols_b, double *c, int nrows_c, int ncols_c, int *error);
526! #endif
527! #ifdef SINGLE_PRECISION_REAL
528! !c> void elpa_hermitian_multiply_a_h_a_f(elpa_t handle, char uplo_a, char uplo_c, int ncb, float *a, float *b, int nrows_b, int ncols_b, float *c, int nrows_c, int ncols_c, int *error);
529! #endif
530! #endif
531! #ifdef COMPLEXCASE
532! #ifdef DOUBLE_PRECISION_COMPLEX
533! !c> void elpa_hermitian_multiply_a_h_a_dc(elpa_t handle, char uplo_a, char uplo_c, int ncb, double_complex *a, double_complex *b, int nrows_b, int ncols_b, double_complex *c, int nrows_c, int ncols_c, int *error);
534! #endif
535! #ifdef SINGLE_PRECISION_COMPLEX
536! !c> void elpa_hermitian_multiply_a_h_a_fc(elpa_t handle, char uplo_a, char uplo_c, int ncb, float_complex *a, float_complex *b, int nrows_b, int ncols_b, float_complex *c, int nrows_c, int ncols_c, int *error);
537! #endif
538! #endif
539! subroutine elpa_hermitian_multiply_a_h_a_&
540! &ELPA_IMPL_SUFFIX&
541! &_c(handle, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
542! ncols_b, c_p, nrows_c, ncols_c, error) &
543! #ifdef REALCASE
544! #ifdef DOUBLE_PRECISION_REAL
545! bind(C, name="elpa_hermitian_multiply_a_h_a_d")
546! #endif
547! #ifdef SINGLE_PRECISION_REAL
548! bind(C, name="elpa_hermitian_multiply_a_h_a_f")
549! #endif
550! #endif
551! #ifdef COMPLEXCASE
552! #ifdef DOUBLE_PRECISION_COMPLEX
553! bind(C, name="elpa_hermitian_multiply_a_h_a_dc")
554! #endif
555! #ifdef SINGLE_PRECISION_COMPLEX
556! bind(C, name="elpa_hermitian_multiply_a_h_a_fc")
557! #endif
558! #endif
559
560! type(c_ptr), intent(in), value :: handle, a_p, b_p, c_p
561! character(1,C_CHAR), value :: uplo_a, uplo_c
562! integer(kind=c_int), value :: ncb, nrows_b, ncols_b, nrows_c, ncols_c
563! #ifdef USE_FORTRAN2008
564! integer(kind=c_int), optional, intent(in) :: error
565! #else
566! integer(kind=c_int), intent(in) :: error
567! #endif
568! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: a(:, :), b(:,:), c(:,:)
569! !#ifdef USE_ASSUMED_SIZE
570! ! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: b(nrows_b,*), c(nrows_c,*)
571! !#else
572! ! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: b(nrows_b,ncols_b), c(nrows_c,ncols_c)
573! !#endif
574! type(elpa_impl_t), pointer :: self
575
576! call c_f_pointer(handle, self)
577! call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
578! call c_f_pointer(b_p, b, [nrows_b, ncols_b])
579! call c_f_pointer(c_p, c, [nrows_c, ncols_c])
580
581! call elpa_hermitian_multiply_a_h_a_&
582! &ELPA_IMPL_SUFFIX&
583! & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, &
584! ncols_b, c, nrows_c, ncols_c, error)
585! end subroutine
586
587! #ifdef REALCASE
588! #ifdef DOUBLE_PRECISION_REAL
589! !c> void elpa_hermitian_multiply_d_ptr_d(elpa_t handle, char uplo_a, char uplo_c, int ncb, double *a, double *b, int nrows_b, int ncols_b, double *c, int nrows_c, int ncols_c, int *error);
590! #endif
591! #ifdef SINGLE_PRECISION_REAL
592! !c> void elpa_hermitian_multiply_d_ptr_f(elpa_t handle, char uplo_a, char uplo_c, int ncb, float *a, float *b, int nrows_b, int ncols_b, float *c, int nrows_c, int ncols_c, int *error);
593! #endif
594! #endif
595! #ifdef COMPLEXCASE
596! #ifdef DOUBLE_PRECISION_COMPLEX
597! !c> void elpa_hermitian_multiply_d_ptr_dc(elpa_t handle, char uplo_a, char uplo_c, int ncb, double_complex *a, double_complex *b, int nrows_b, int ncols_b, double_complex *c, int nrows_c, int ncols_c, int *error);
598! #endif
599! #ifdef SINGLE_PRECISION_COMPLEX
600! !c> void elpa_hermitian_multiply_d_ptr_fc(elpa_t handle, char uplo_a, char uplo_c, int ncb, float_complex *a, float_complex *b, int nrows_b, int ncols_b, float_complex *c, int nrows_c, int ncols_c, int *error);
601! #endif
602! #endif
603! subroutine elpa_hermitian_multiply_d_ptr_&
604! &ELPA_IMPL_SUFFIX&
605! &_c(handle, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
606! ncols_b, c_p, nrows_c, ncols_c, error) &
607! #ifdef REALCASE
608! #ifdef DOUBLE_PRECISION_REAL
609! bind(C, name="elpa_hermitian_multiply_d_ptr_d")
610! #endif
611! #ifdef SINGLE_PRECISION_REAL
612! bind(C, name="elpa_hermitian_multiply_d_ptr_f")
613! #endif
614! #endif
615! #ifdef COMPLEXCASE
616! #ifdef DOUBLE_PRECISION_COMPLEX
617! bind(C, name="elpa_hermitian_multiply_d_ptr_dc")
618! #endif
619! #ifdef SINGLE_PRECISION_COMPLEX
620! bind(C, name="elpa_hermitian_multiply_d_ptr_fc")
621! #endif
622! #endif
623
624! type(c_ptr), intent(in), value :: handle, a_p, b_p, c_p
625! character(1,C_CHAR), value :: uplo_a, uplo_c
626! integer(kind=c_int), value :: ncb, nrows_b, ncols_b, nrows_c, ncols_c
627! #ifdef USE_FORTRAN2008
628! integer(kind=c_int), optional, intent(in) :: error
629! #else
630! integer(kind=c_int), intent(in) :: error
631! #endif
632! type(elpa_impl_t), pointer :: self
633
634! call c_f_pointer(handle, self)
635! !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
636
637! call elpa_hermitian_multiply_d_ptr_&
638! &ELPA_IMPL_SUFFIX&
639! & (self, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
640! ncols_b, c_p, nrows_c, ncols_c, error)
641! end subroutine
642
643 !_____________________________________________________________________________________________________________________
644 ! cholesky
645
663 subroutine elpa_cholesky_a_h_a_&
664 &elpa_impl_suffix&
665 & (self, a, error)
666 class(elpa_impl_t) :: self
667#ifdef USE_ASSUMED_SIZE
668 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,*)
669#else
670 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,self%local_ncols)
671#endif
672#ifdef USE_FORTRAN2008
673 integer, optional :: error
674#else
675 integer :: error
676#endif
677 logical :: success_l
678
679 success_l = .false.
680#if defined(INCLUDE_ROUTINES)
681 success_l = elpa_cholesky_a_h_a_&
682 &math_datatype&
683 &_&
684 &precision&
685 &_impl(self, a)
686#endif
687
688#ifdef USE_FORTRAN2008
689 if (present(error)) then
690 if (success_l) then
691 error = elpa_ok
692 else
693 error = elpa_error
694 endif
695 else if (.not. success_l) then
696 write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
697 endif
698#else
699 if (success_l) then
700 error = elpa_ok
701 else
702 error = elpa_error
703 endif
704#endif
705 end subroutine
706
707#ifdef REALCASE
708#ifdef DOUBLE_PRECISION_REAL
709 !c> void elpa_cholesky_a_h_a_d(elpa_t handle, double *a, int *error);
710#endif
711#ifdef SINGLE_PRECISION_REAL
712 !c> void elpa_cholesky_a_h_a_f(elpa_t handle, float *a, int *error);
713#endif
714#endif
715#ifdef COMPLEXCASE
716#ifdef DOUBLE_PRECISION_COMPLEX
717 !c> void elpa_cholesky_a_h_a_dc(elpa_t handle, double_complex *a, int *error);
718#endif
719#ifdef SINGLE_PRECISION_COMPLEX
720 !c> void elpa_cholesky_a_h_a_fc(elpa_t handle, float_complex *a, int *error);
721#endif
722#endif
723 subroutine elpa_choleksy_a_h_a_&
724 &elpa_impl_suffix&
725 &_c(handle, a_p, error) &
726#ifdef REALCASE
727#ifdef DOUBLE_PRECISION_REAL
728 bind(C, name="elpa_cholesky_a_h_a_d")
729#endif
730#ifdef SINGLE_PRECISION_REAL
731 bind(C, name="elpa_cholesky_a_h_a_f")
732#endif
733#endif
734#ifdef COMPLEXCASE
735#ifdef DOUBLE_PRECISION_COMPLEX
736 bind(C, name="elpa_cholesky_a_h_a_dc")
737#endif
738#ifdef SINGLE_PRECISION_COMPLEX
739 bind(C, name="elpa_cholesky_a_h_a_fc")
740#endif
741#endif
742
743 type(c_ptr), intent(in), value :: handle, a_p
744#ifdef USE_FORTRAN2008
745 integer(kind=c_int), optional, intent(in) :: error
746#else
747 integer(kind=c_int), intent(in) :: error
748#endif
749 math_datatype(kind=c_datatype_kind), pointer :: a(:, :)
750 type(elpa_impl_t), pointer :: self
751
752 call c_f_pointer(handle, self)
753 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
754
755 call elpa_cholesky_a_h_a_&
756 &elpa_impl_suffix&
757 & (self, a, error)
758 end subroutine
759
760
778 subroutine elpa_cholesky_d_ptr_&
779 &elpa_impl_suffix&
780 & (self, a, error)
781 use iso_c_binding
782 class(elpa_impl_t) :: self
783 type(c_ptr) :: a
784#ifdef USE_FORTRAN2008
785 integer, optional :: error
786#else
787 integer :: error
788#endif
789 logical :: success_l
790
791 success_l = .false.
792#if defined(INCLUDE_ROUTINES)
793 success_l = elpa_cholesky_d_ptr_&
794 &math_datatype&
795 &_&
796 &precision&
797 &_impl(self, a)
798#endif
799
800#ifdef USE_FORTRAN2008
801 if (present(error)) then
802 if (success_l) then
803 error = elpa_ok
804 else
805 error = elpa_error
806 endif
807 else if (.not. success_l) then
808 write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
809 endif
810#else
811 if (success_l) then
812 error = elpa_ok
813 else
814 error = elpa_error
815 endif
816#endif
817 end subroutine
818
819#ifdef REALCASE
820#ifdef DOUBLE_PRECISION_REAL
821 !c> void elpa_cholesky_d_ptr_d(elpa_t handle, double *a, int *error);
822#endif
823#ifdef SINGLE_PRECISION_REAL
824 !c> void elpa_cholesky_d_ptr_f(elpa_t handle, float *a, int *error);
825#endif
826#endif
827#ifdef COMPLEXCASE
828#ifdef DOUBLE_PRECISION_COMPLEX
829 !c> void elpa_cholesky_d_ptr_dc(elpa_t handle, double_complex *a, int *error);
830#endif
831#ifdef SINGLE_PRECISION_COMPLEX
832 !c> void elpa_cholesky_d_ptr_fc(elpa_t handle, float_complex *a, int *error);
833#endif
834#endif
835 subroutine elpa_choleksy_d_ptr_&
836 &elpa_impl_suffix&
837 &_c(handle, a_p, error) &
838#ifdef REALCASE
839#ifdef DOUBLE_PRECISION_REAL
840 bind(C, name="elpa_cholesky_d_ptr_d")
841#endif
842#ifdef SINGLE_PRECISION_REAL
843 bind(C, name="elpa_cholesky_d_ptr_f")
844#endif
845#endif
846#ifdef COMPLEXCASE
847#ifdef DOUBLE_PRECISION_COMPLEX
848 bind(C, name="elpa_cholesky_d_ptr_dc")
849#endif
850#ifdef SINGLE_PRECISION_COMPLEX
851 bind(C, name="elpa_cholesky_d_ptr_fc")
852#endif
853#endif
854
855 type(c_ptr), intent(in), value :: handle, a_p
856#ifdef USE_FORTRAN2008
857 integer(kind=c_int), optional, intent(in) :: error
858#else
859 integer(kind=c_int), intent(in) :: error
860#endif
861 type(elpa_impl_t), pointer :: self
862
863 call c_f_pointer(handle, self)
864 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
865
866 call elpa_cholesky_d_ptr_&
867 &elpa_impl_suffix&
868 & (self, a_p, error)
869 end subroutine
870
871 !_____________________________________________________________________________________________________________________
872 ! invert_trm
873
891 subroutine elpa_invert_trm_a_h_a_&
892 &elpa_impl_suffix&
893 & (self, a, error)
894 class(elpa_impl_t) :: self
895#ifdef USE_ASSUMED_SIZE
896 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,*)
897#else
898 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,self%local_ncols)
899#endif
900#ifdef USE_FORTRAN2008
901 integer, optional :: error
902#else
903 integer :: error
904#endif
905 logical :: success_l
906
907 success_l = .false.
908#if defined(INCLUDE_ROUTINES)
909 success_l = elpa_invert_trm_a_h_a_&
910 &math_datatype&
911 &_&
912 &precision&
913 &_impl(self, a)
914#endif
915
916#ifdef USE_FORTRAN2008
917 if (present(error)) then
918 if (success_l) then
919 error = elpa_ok
920 else
921 error = elpa_error
922 endif
923 else if (.not. success_l) then
924 write(error_unit,'(a)') "ELPA: Error in invert_trm() and you did not check for errors!"
925 endif
926#else
927 if (success_l) then
928 error = elpa_ok
929 else
930 error = elpa_error
931 endif
932#endif
933 end subroutine
934
935
936
937#ifdef REALCASE
938#ifdef DOUBLE_PRECISION_REAL
939 !c> void elpa_invert_trm_a_h_a_d(elpa_t handle, double *a, int *error);
940#endif
941#ifdef SINGLE_PRECISION_REAL
942 !c> void elpa_invert_trm_a_h_a_f(elpa_t handle, float *a, int *error);
943#endif
944#endif
945#ifdef COMPLEXCASE
946#ifdef DOUBLE_PRECISION_COMPLEX
947 !c> void elpa_invert_trm_a_h_a_dc(elpa_t handle, double_complex *a, int *error);
948#endif
949#ifdef SINGLE_PRECISION_COMPLEX
950 !c> void elpa_invert_trm_a_h_a_fc(elpa_t handle, float_complex *a, int *error);
951#endif
952#endif
953 subroutine elpa_invert_trm_a_h_a_&
954 &elpa_impl_suffix&
955 &_c(handle, a_p, error) &
956#ifdef REALCASE
957#ifdef DOUBLE_PRECISION_REAL
958 bind(C, name="elpa_invert_trm_a_h_a_d")
959#endif
960#ifdef SINGLE_PRECISION_REAL
961 bind(C, name="elpa_invert_trm_a_h_a_f")
962#endif
963#endif
964#ifdef COMPLEXCASE
965#ifdef DOUBLE_PRECISION_COMPLEX
966 bind(C, name="elpa_invert_trm_a_h_a_dc")
967#endif
968#ifdef SINGLE_PRECISION_COMPLEX
969 bind(C, name="elpa_invert_trm_a_h_a_fc")
970#endif
971#endif
972
973 type(c_ptr), intent(in), value :: handle, a_p
974#ifdef USE_FORTRAN2008
975 integer(kind=c_int), optional, intent(in) :: error
976#else
977 integer(kind=c_int), intent(in) :: error
978#endif
979 math_datatype(kind=c_datatype_kind), pointer :: a(:, :)
980 type(elpa_impl_t), pointer :: self
981
982 call c_f_pointer(handle, self)
983 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
984
985 call elpa_invert_trm_a_h_a_&
986 &elpa_impl_suffix&
987 & (self, a, error)
988 end subroutine
989
990
1008 subroutine elpa_invert_trm_d_ptr_&
1009 &elpa_impl_suffix&
1010 & (self, a, error)
1011 use iso_c_binding
1012 class(elpa_impl_t) :: self
1013 type(c_ptr) :: a
1014#ifdef USE_FORTRAN2008
1015 integer, optional :: error
1016#else
1017 integer :: error
1018#endif
1019 logical :: success_l
1020
1021 success_l = .false.
1022#if defined(INCLUDE_ROUTINES)
1023 success_l = elpa_invert_trm_d_ptr_&
1024 &math_datatype&
1025 &_&
1026 &precision&
1027 &_impl(self, a)
1028#endif
1029
1030#ifdef USE_FORTRAN2008
1031 if (present(error)) then
1032 if (success_l) then
1033 error = elpa_ok
1034 else
1035 error = elpa_error
1036 endif
1037 else if (.not. success_l) then
1038 write(error_unit,'(a)') "ELPA: Error in invert_trm() and you did not check for errors!"
1039 endif
1040#else
1041 if (success_l) then
1042 error = elpa_ok
1043 else
1044 error = elpa_error
1045 endif
1046#endif
1047 end subroutine
1048
1049
1050
1051#ifdef REALCASE
1052#ifdef DOUBLE_PRECISION_REAL
1053 !c> void elpa_invert_trm_d_ptr_d(elpa_t handle, double *a, int *error);
1054#endif
1055#ifdef SINGLE_PRECISION_REAL
1056 !c> void elpa_invert_trm_d_ptr_f(elpa_t handle, float *a, int *error);
1057#endif
1058#endif
1059#ifdef COMPLEXCASE
1060#ifdef DOUBLE_PRECISION_COMPLEX
1061 !c> void elpa_invert_trm_d_ptr_dc(elpa_t handle, double_complex *a, int *error);
1062#endif
1063#ifdef SINGLE_PRECISION_COMPLEX
1064 !c> void elpa_invert_trm_d_ptr_fc(elpa_t handle, float_complex *a, int *error);
1065#endif
1066#endif
1067 subroutine elpa_invert_trm_d_ptr_&
1068 &elpa_impl_suffix&
1069 &_c(handle, a_p, error) &
1070#ifdef REALCASE
1071#ifdef DOUBLE_PRECISION_REAL
1072 bind(C, name="elpa_invert_trm_d_ptr_d")
1073#endif
1074#ifdef SINGLE_PRECISION_REAL
1075 bind(C, name="elpa_invert_trm_d_ptr_f")
1076#endif
1077#endif
1078#ifdef COMPLEXCASE
1079#ifdef DOUBLE_PRECISION_COMPLEX
1080 bind(C, name="elpa_invert_trm_d_ptr_dc")
1081#endif
1082#ifdef SINGLE_PRECISION_COMPLEX
1083 bind(C, name="elpa_invert_trm_d_ptr_fc")
1084#endif
1085#endif
1086
1087 type(c_ptr), intent(in), value :: handle, a_p
1088#ifdef USE_FORTRAN2008
1089 integer(kind=c_int), optional, intent(in) :: error
1090#else
1091 integer(kind=c_int), intent(in) :: error
1092#endif
1093 type(elpa_impl_t), pointer :: self
1094
1095 call c_f_pointer(handle, self)
1096
1097 call elpa_invert_trm_d_ptr_&
1098 &elpa_impl_suffix&
1099 & (self, a_p, error)
1100 end subroutine
1101
1102 !_____________________________________________________________________________________________________________________
1103 ! solve_tridiagonal
1104
1121 subroutine elpa_solve_tridiagonal_&
1122 &elpa_impl_suffix&
1123 & (self, d, e, q, error)
1124 use solve_tridi
1125 implicit none
1126 class(elpa_impl_t) :: self
1127 real(kind=c_real_datatype) :: d(self%na), e(self%na)
1128#ifdef USE_ASSUMED_SIZE
1129 real(kind=c_real_datatype) :: q(self%local_nrows,*)
1130#else
1131 real(kind=c_real_datatype) :: q(self%local_nrows,self%local_ncols)
1132#endif
1133#ifdef USE_FORTRAN2008
1134 integer, optional :: error
1135#else
1136 integer :: error
1137#endif
1138 logical :: success_l
1139
1140#if defined(INCLUDE_ROUTINES)
1141 success_l = elpa_solve_tridi_&
1142 &precision&
1143 &_impl(self, d, e, q)
1144#else
1145 write(error_unit,*) "ELPA is not compiled with single-precision support"
1146#ifdef USE_FORTRAN2008
1147 if (present(error)) then
1148 error = elpa_error
1149 return
1150 else
1151 return
1152 endif
1153#else
1154 error = elpa_error
1155 return
1156#endif
1157#endif
1158#ifdef USE_FORTRAN2008
1159 if (present(error)) then
1160 if (success_l) then
1161 error = elpa_ok
1162 else
1163 error = elpa_error
1164 endif
1165 else if (.not. success_l) then
1166 write(error_unit,'(a)') "ELPA: Error in solve_tridiagonal() and you did not check for errors!"
1167 endif
1168#else
1169 if (success_l) then
1170 error = elpa_ok
1171 else
1172 error = elpa_error
1173 endif
1174#endif
1175 end subroutine
1176
1177
1178#ifdef DOUBLE_PRECISION_REAL
1179 !c> void elpa_solve_tridiagonal_d(elpa_t handle, double *d, double *e, double *q, int *error);
1180#endif
1181#ifdef SINGLE_PRECISION_REAL
1182 !c> void elpa_solve_tridiagonal_f(elpa_t handle, float *d, float *e, float *q, int *error);
1183#endif
1184
1185 subroutine elpa_solve_tridiagonal_&
1186 &elpa_impl_suffix&
1187 &_c(handle, d_p, e_p, q_p, error) &
1188#ifdef REALCASE
1189#ifdef DOUBLE_PRECISION_REAL
1190 bind(C, name="elpa_solve_tridiagonal_d")
1191#endif
1192#ifdef SINGLE_PRECISION_REAL
1193 bind(C, name="elpa_solve_tridiagonal_f")
1194#endif
1195#endif
1196#ifdef COMPLEXCASE
1197#ifdef DOUBLE_PRECISION_COMPLEX
1198 & !bind(C, name="elpa_solve_tridiagonal_dc")
1199#endif
1200#ifdef SINGLE_PRECISION_COMPLEX
1201 & !bind(C, name="elpa_solve_tridiagonal_fc")
1202#endif
1203#endif
1204
1205 type(c_ptr), intent(in), value :: handle, d_p, e_p, q_p
1206#ifdef USE_FORTRAN2008
1207 integer(kind=c_int), optional, intent(in) :: error
1208#else
1209 integer(kind=c_int), intent(in) :: error
1210#endif
1211 real(kind=c_real_datatype), pointer :: d(:), e(:), q(:, :)
1212 type(elpa_impl_t), pointer :: self
1213
1214 call c_f_pointer(handle, self)
1215 call c_f_pointer(d_p, d, [self%na])
1216 call c_f_pointer(e_p, e, [self%na])
1217 call c_f_pointer(q_p, q, [self%local_nrows, self%local_ncols])
1218
1219 call elpa_solve_tridiagonal_&
1220 &elpa_impl_suffix&
1221 & (self, d, e, q, error)
1222 end subroutine
1223
solve_tridi
Definition mod_solve_tridi.F90:3
Generated by doxygen 1.10.0