Eigenvalue SoLvers for Petaflop-Applications (ELPA) 2024.03.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
84 subroutine elpa_hermitian_multiply_a_h_a_&
85 &elpa_impl_suffix&
86 & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
87 c, nrows_c, ncols_c, error)
88 class(elpa_impl_t) :: self
89 character*1 :: uplo_a, uplo_c
90 integer(kind=c_int), intent(in) :: nrows_b, ncols_b, nrows_c, ncols_c, ncb
91#ifdef USE_ASSUMED_SIZE
92 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,*), b(nrows_b,*), c(nrows_c,*)
93#else
94 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,self%local_ncols), b(nrows_b,ncols_b), c(nrows_c,ncols_c)
95#endif
96#ifdef USE_FORTRAN2008
97 integer, optional :: error
98#else
99 integer :: error
100#endif
101 logical :: success_l
102
103 success_l = .false.
104#if defined(INCLUDE_ROUTINES)
105#ifdef REALCASE
106 success_l = elpa_mult_at_b_a_h_a_&
107#endif
108#ifdef COMPLEXCASE
109 success_l = elpa_mult_ah_b_a_h_a_&
110#endif
111 &math_datatype&
112 &_&
113 &precision&
114 &_impl(self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
115 c, nrows_c, ncols_c)
116#endif
117#ifdef USE_FORTRAN2008
118 if (present(error)) then
119 if (success_l) then
120 error = elpa_ok
121 else
122 error = elpa_error
123 endif
124 else if (.not. success_l) then
125 write(error_unit,'(a)') "ELPA: Error in hermitian_multiply() and you did not check for errors!"
126 endif
127#else
128 if (success_l) then
129 error = elpa_ok
130 else
131 error = elpa_error
132 endif
133#endif
134 end subroutine
135
136
172 subroutine elpa_hermitian_multiply_d_ptr_&
173 &elpa_impl_suffix&
174 & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
175 c, nrows_c, ncols_c, error)
176 class(elpa_impl_t) :: self
177 character*1 :: uplo_a, uplo_c
178 integer(kind=c_int), intent(in) :: nrows_b, ncols_b, nrows_c, ncols_c, ncb
179 type(c_ptr) :: a, b, c
180#ifdef USE_FORTRAN2008
181 integer, optional :: error
182#else
183 integer :: error
184#endif
185 logical :: success_l
186
187 success_l = .false.
188#if defined(INCLUDE_ROUTINES)
189#ifdef REALCASE
190 success_l = elpa_mult_at_b_d_ptr_&
191#endif
192#ifdef COMPLEXCASE
193 success_l = elpa_mult_ah_b_d_ptr_&
194#endif
195 &math_datatype&
196 &_&
197 &precision&
198 &_impl(self, uplo_a, uplo_c, ncb, a, b, nrows_b, ncols_b, &
199 c, nrows_c, ncols_c)
200#endif
201#ifdef USE_FORTRAN2008
202 if (present(error)) then
203 if (success_l) then
204 error = elpa_ok
205 else
206 error = elpa_error
207 endif
208 else if (.not. success_l) then
209 write(error_unit,'(a)') "ELPA: Error in hermitian_multiply() and you did not check for errors!"
210 endif
211#else
212 if (success_l) then
213 error = elpa_ok
214 else
215 error = elpa_error
216 endif
217#endif
218 end subroutine
219
220 !c> // /src/elpa_impl_math_template.F90
221
222#ifdef REALCASE
223#ifdef DOUBLE_PRECISION_REAL
224 !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);
225#endif
226#ifdef SINGLE_PRECISION_REAL
227 !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);
228#endif
229#endif
230#ifdef COMPLEXCASE
231#ifdef DOUBLE_PRECISION_COMPLEX
232 !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);
233#endif
234#ifdef SINGLE_PRECISION_COMPLEX
235 !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);
236#endif
237#endif
238 subroutine elpa_hermitian_multiply_a_h_a_&
239 &elpa_impl_suffix&
240 &_c(handle, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
241 ncols_b, c_p, nrows_c, ncols_c, error) &
242#ifdef REALCASE
243#ifdef DOUBLE_PRECISION_REAL
244 bind(C, name="elpa_hermitian_multiply_a_h_a_d")
245#endif
246#ifdef SINGLE_PRECISION_REAL
247 bind(C, name="elpa_hermitian_multiply_a_h_a_f")
248#endif
249#endif
250#ifdef COMPLEXCASE
251#ifdef DOUBLE_PRECISION_COMPLEX
252 bind(C, name="elpa_hermitian_multiply_a_h_a_dc")
253#endif
254#ifdef SINGLE_PRECISION_COMPLEX
255 bind(C, name="elpa_hermitian_multiply_a_h_a_fc")
256#endif
257#endif
258
259 type(c_ptr), intent(in), value :: handle, a_p, b_p, c_p
260 character(1,C_CHAR), value :: uplo_a, uplo_c
261 integer(kind=c_int), value :: ncb, nrows_b, ncols_b, nrows_c, ncols_c
262#ifdef USE_FORTRAN2008
263 integer(kind=c_int), optional, intent(in) :: error
264#else
265 integer(kind=c_int), intent(in) :: error
266#endif
267 math_datatype(kind=c_datatype_kind), pointer :: a(:, :), b(:,:), c(:,:)
268!#ifdef USE_ASSUMED_SIZE
269! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: b(nrows_b,*), c(nrows_c,*)
270!#else
271! MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: b(nrows_b,ncols_b), c(nrows_c,ncols_c)
272!#endif
273 type(elpa_impl_t), pointer :: self
274
275 call c_f_pointer(handle, self)
276 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
277 call c_f_pointer(b_p, b, [nrows_b, ncols_b])
278 call c_f_pointer(c_p, c, [nrows_c, ncols_c])
279
280 call elpa_hermitian_multiply_a_h_a_&
281 &elpa_impl_suffix&
282 & (self, uplo_a, uplo_c, ncb, a, b, nrows_b, &
283 ncols_b, c, nrows_c, ncols_c, error)
284 end subroutine
285
286#ifdef REALCASE
287#ifdef DOUBLE_PRECISION_REAL
288 !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);
289#endif
290#ifdef SINGLE_PRECISION_REAL
291 !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);
292#endif
293#endif
294#ifdef COMPLEXCASE
295#ifdef DOUBLE_PRECISION_COMPLEX
296 !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);
297#endif
298#ifdef SINGLE_PRECISION_COMPLEX
299 !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);
300#endif
301#endif
302 subroutine elpa_hermitian_multiply_d_ptr_&
303 &elpa_impl_suffix&
304 &_c(handle, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
305 ncols_b, c_p, nrows_c, ncols_c, error) &
306#ifdef REALCASE
307#ifdef DOUBLE_PRECISION_REAL
308 bind(C, name="elpa_hermitian_multiply_d_ptr_d")
309#endif
310#ifdef SINGLE_PRECISION_REAL
311 bind(C, name="elpa_hermitian_multiply_d_ptr_f")
312#endif
313#endif
314#ifdef COMPLEXCASE
315#ifdef DOUBLE_PRECISION_COMPLEX
316 bind(C, name="elpa_hermitian_multiply_d_ptr_dc")
317#endif
318#ifdef SINGLE_PRECISION_COMPLEX
319 bind(C, name="elpa_hermitian_multiply_d_ptr_fc")
320#endif
321#endif
322
323 type(c_ptr), intent(in), value :: handle, a_p, b_p, c_p
324 character(1,C_CHAR), value :: uplo_a, uplo_c
325 integer(kind=c_int), value :: ncb, nrows_b, ncols_b, nrows_c, ncols_c
326#ifdef USE_FORTRAN2008
327 integer(kind=c_int), optional, intent(in) :: error
328#else
329 integer(kind=c_int), intent(in) :: error
330#endif
331 type(elpa_impl_t), pointer :: self
332
333 call c_f_pointer(handle, self)
334 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
335
336 call elpa_hermitian_multiply_d_ptr_&
337 &elpa_impl_suffix&
338 & (self, uplo_a, uplo_c, ncb, a_p, b_p, nrows_b, &
339 ncols_b, c_p, nrows_c, ncols_c, error)
340 end subroutine
341
342
360 subroutine elpa_cholesky_a_h_a_&
361 &elpa_impl_suffix&
362 & (self, a, error)
363 class(elpa_impl_t) :: self
364#ifdef USE_ASSUMED_SIZE
365 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,*)
366#else
367 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,self%local_ncols)
368#endif
369#ifdef USE_FORTRAN2008
370 integer, optional :: error
371#else
372 integer :: error
373#endif
374 logical :: success_l
375
376 success_l = .false.
377#if defined(INCLUDE_ROUTINES)
378 success_l = elpa_cholesky_a_h_a_&
379 &math_datatype&
380 &_&
381 &precision&
382 &_impl(self, a)
383#endif
384
385#ifdef USE_FORTRAN2008
386 if (present(error)) then
387 if (success_l) then
388 error = elpa_ok
389 else
390 error = elpa_error
391 endif
392 else if (.not. success_l) then
393 write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
394 endif
395#else
396 if (success_l) then
397 error = elpa_ok
398 else
399 error = elpa_error
400 endif
401#endif
402 end subroutine
403
404#ifdef REALCASE
405#ifdef DOUBLE_PRECISION_REAL
406 !c> void elpa_cholesky_a_h_a_d(elpa_t handle, double *a, int *error);
407#endif
408#ifdef SINGLE_PRECISION_REAL
409 !c> void elpa_cholesky_a_h_a_f(elpa_t handle, float *a, int *error);
410#endif
411#endif
412#ifdef COMPLEXCASE
413#ifdef DOUBLE_PRECISION_COMPLEX
414 !c> void elpa_cholesky_a_h_a_dc(elpa_t handle, double_complex *a, int *error);
415#endif
416#ifdef SINGLE_PRECISION_COMPLEX
417 !c> void elpa_cholesky_a_h_a_fc(elpa_t handle, float_complex *a, int *error);
418#endif
419#endif
420 subroutine elpa_choleksy_a_h_a_&
421 &elpa_impl_suffix&
422 &_c(handle, a_p, error) &
423#ifdef REALCASE
424#ifdef DOUBLE_PRECISION_REAL
425 bind(C, name="elpa_cholesky_a_h_a_d")
426#endif
427#ifdef SINGLE_PRECISION_REAL
428 bind(C, name="elpa_cholesky_a_h_a_f")
429#endif
430#endif
431#ifdef COMPLEXCASE
432#ifdef DOUBLE_PRECISION_COMPLEX
433 bind(C, name="elpa_cholesky_a_h_a_dc")
434#endif
435#ifdef SINGLE_PRECISION_COMPLEX
436 bind(C, name="elpa_cholesky_a_h_a_fc")
437#endif
438#endif
439
440 type(c_ptr), intent(in), value :: handle, a_p
441#ifdef USE_FORTRAN2008
442 integer(kind=c_int), optional, intent(in) :: error
443#else
444 integer(kind=c_int), intent(in) :: error
445#endif
446 math_datatype(kind=c_datatype_kind), pointer :: a(:, :)
447 type(elpa_impl_t), pointer :: self
448
449 call c_f_pointer(handle, self)
450 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
451
452 call elpa_cholesky_a_h_a_&
453 &elpa_impl_suffix&
454 & (self, a, error)
455 end subroutine
456
457
475 subroutine elpa_cholesky_d_ptr_&
476 &elpa_impl_suffix&
477 & (self, a, error)
478 use iso_c_binding
479 class(elpa_impl_t) :: self
480 type(c_ptr) :: a
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 success_l = elpa_cholesky_d_ptr_&
491 &math_datatype&
492 &_&
493 &precision&
494 &_impl(self, a)
495#endif
496
497#ifdef USE_FORTRAN2008
498 if (present(error)) then
499 if (success_l) then
500 error = elpa_ok
501 else
502 error = elpa_error
503 endif
504 else if (.not. success_l) then
505 write(error_unit,'(a)') "ELPA: Error in cholesky() and you did not check for errors!"
506 endif
507#else
508 if (success_l) then
509 error = elpa_ok
510 else
511 error = elpa_error
512 endif
513#endif
514 end subroutine
515
516#ifdef REALCASE
517#ifdef DOUBLE_PRECISION_REAL
518 !c> void elpa_cholesky_d_ptr_d(elpa_t handle, double *a, int *error);
519#endif
520#ifdef SINGLE_PRECISION_REAL
521 !c> void elpa_cholesky_d_ptr_f(elpa_t handle, float *a, int *error);
522#endif
523#endif
524#ifdef COMPLEXCASE
525#ifdef DOUBLE_PRECISION_COMPLEX
526 !c> void elpa_cholesky_d_ptr_dc(elpa_t handle, double_complex *a, int *error);
527#endif
528#ifdef SINGLE_PRECISION_COMPLEX
529 !c> void elpa_cholesky_d_ptr_fc(elpa_t handle, float_complex *a, int *error);
530#endif
531#endif
532 subroutine elpa_choleksy_d_ptr_&
533 &elpa_impl_suffix&
534 &_c(handle, a_p, error) &
535#ifdef REALCASE
536#ifdef DOUBLE_PRECISION_REAL
537 bind(C, name="elpa_cholesky_d_ptr_d")
538#endif
539#ifdef SINGLE_PRECISION_REAL
540 bind(C, name="elpa_cholesky_d_ptr_f")
541#endif
542#endif
543#ifdef COMPLEXCASE
544#ifdef DOUBLE_PRECISION_COMPLEX
545 bind(C, name="elpa_cholesky_d_ptr_dc")
546#endif
547#ifdef SINGLE_PRECISION_COMPLEX
548 bind(C, name="elpa_cholesky_d_ptr_fc")
549#endif
550#endif
551
552 type(c_ptr), intent(in), value :: handle, a_p
553#ifdef USE_FORTRAN2008
554 integer(kind=c_int), optional, intent(in) :: error
555#else
556 integer(kind=c_int), intent(in) :: error
557#endif
558 type(elpa_impl_t), pointer :: self
559
560 call c_f_pointer(handle, self)
561 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
562
563 call elpa_cholesky_d_ptr_&
564 &elpa_impl_suffix&
565 & (self, a_p, error)
566 end subroutine
567
568
586 subroutine elpa_invert_trm_a_h_a_&
587 &elpa_impl_suffix&
588 & (self, a, error)
589 class(elpa_impl_t) :: self
590#ifdef USE_ASSUMED_SIZE
591 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,*)
592#else
593 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows,self%local_ncols)
594#endif
595#ifdef USE_FORTRAN2008
596 integer, optional :: error
597#else
598 integer :: error
599#endif
600 logical :: success_l
601
602 success_l = .false.
603#if defined(INCLUDE_ROUTINES)
604 success_l = elpa_invert_trm_a_h_a_&
605 &math_datatype&
606 &_&
607 &precision&
608 &_impl(self, a)
609#endif
610
611#ifdef USE_FORTRAN2008
612 if (present(error)) then
613 if (success_l) then
614 error = elpa_ok
615 else
616 error = elpa_error
617 endif
618 else if (.not. success_l) then
619 write(error_unit,'(a)') "ELPA: Error in invert_trm() and you did not check for errors!"
620 endif
621#else
622 if (success_l) then
623 error = elpa_ok
624 else
625 error = elpa_error
626 endif
627#endif
628 end subroutine
629
630
631
632#ifdef REALCASE
633#ifdef DOUBLE_PRECISION_REAL
634 !c> void elpa_invert_trm_a_h_a_d(elpa_t handle, double *a, int *error);
635#endif
636#ifdef SINGLE_PRECISION_REAL
637 !c> void elpa_invert_trm_a_h_a_f(elpa_t handle, float *a, int *error);
638#endif
639#endif
640#ifdef COMPLEXCASE
641#ifdef DOUBLE_PRECISION_COMPLEX
642 !c> void elpa_invert_trm_a_h_a_dc(elpa_t handle, double_complex *a, int *error);
643#endif
644#ifdef SINGLE_PRECISION_COMPLEX
645 !c> void elpa_invert_trm_a_h_a_fc(elpa_t handle, float_complex *a, int *error);
646#endif
647#endif
648 subroutine elpa_invert_trm_a_h_a_&
649 &elpa_impl_suffix&
650 &_c(handle, a_p, error) &
651#ifdef REALCASE
652#ifdef DOUBLE_PRECISION_REAL
653 bind(C, name="elpa_invert_trm_a_h_a_d")
654#endif
655#ifdef SINGLE_PRECISION_REAL
656 bind(C, name="elpa_invert_trm_a_h_a_f")
657#endif
658#endif
659#ifdef COMPLEXCASE
660#ifdef DOUBLE_PRECISION_COMPLEX
661 bind(C, name="elpa_invert_trm_a_h_a_dc")
662#endif
663#ifdef SINGLE_PRECISION_COMPLEX
664 bind(C, name="elpa_invert_trm_a_h_a_fc")
665#endif
666#endif
667
668 type(c_ptr), intent(in), value :: handle, a_p
669#ifdef USE_FORTRAN2008
670 integer(kind=c_int), optional, intent(in) :: error
671#else
672 integer(kind=c_int), intent(in) :: error
673#endif
674 math_datatype(kind=c_datatype_kind), pointer :: a(:, :)
675 type(elpa_impl_t), pointer :: self
676
677 call c_f_pointer(handle, self)
678 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
679
680 call elpa_invert_trm_a_h_a_&
681 &elpa_impl_suffix&
682 & (self, a, error)
683 end subroutine
684
685
703 subroutine elpa_invert_trm_d_ptr_&
704 &elpa_impl_suffix&
705 & (self, a, error)
706 use iso_c_binding
707 class(elpa_impl_t) :: self
708 type(c_ptr) :: a
709#ifdef USE_FORTRAN2008
710 integer, optional :: error
711#else
712 integer :: error
713#endif
714 logical :: success_l
715
716 success_l = .false.
717#if defined(INCLUDE_ROUTINES)
718 success_l = elpa_invert_trm_d_ptr_&
719 &math_datatype&
720 &_&
721 &precision&
722 &_impl(self, a)
723#endif
724
725#ifdef USE_FORTRAN2008
726 if (present(error)) then
727 if (success_l) then
728 error = elpa_ok
729 else
730 error = elpa_error
731 endif
732 else if (.not. success_l) then
733 write(error_unit,'(a)') "ELPA: Error in invert_trm() and you did not check for errors!"
734 endif
735#else
736 if (success_l) then
737 error = elpa_ok
738 else
739 error = elpa_error
740 endif
741#endif
742 end subroutine
743
744
745
746#ifdef REALCASE
747#ifdef DOUBLE_PRECISION_REAL
748 !c> void elpa_invert_trm_d_ptr_d(elpa_t handle, double *a, int *error);
749#endif
750#ifdef SINGLE_PRECISION_REAL
751 !c> void elpa_invert_trm_d_ptr_f(elpa_t handle, float *a, int *error);
752#endif
753#endif
754#ifdef COMPLEXCASE
755#ifdef DOUBLE_PRECISION_COMPLEX
756 !c> void elpa_invert_trm_d_ptr_dc(elpa_t handle, double_complex *a, int *error);
757#endif
758#ifdef SINGLE_PRECISION_COMPLEX
759 !c> void elpa_invert_trm_d_ptr_fc(elpa_t handle, float_complex *a, int *error);
760#endif
761#endif
762 subroutine elpa_invert_trm_d_ptr_&
763 &elpa_impl_suffix&
764 &_c(handle, a_p, error) &
765#ifdef REALCASE
766#ifdef DOUBLE_PRECISION_REAL
767 bind(C, name="elpa_invert_trm_d_ptr_d")
768#endif
769#ifdef SINGLE_PRECISION_REAL
770 bind(C, name="elpa_invert_trm_d_ptr_f")
771#endif
772#endif
773#ifdef COMPLEXCASE
774#ifdef DOUBLE_PRECISION_COMPLEX
775 bind(C, name="elpa_invert_trm_d_ptr_dc")
776#endif
777#ifdef SINGLE_PRECISION_COMPLEX
778 bind(C, name="elpa_invert_trm_d_ptr_fc")
779#endif
780#endif
781
782 type(c_ptr), intent(in), value :: handle, a_p
783#ifdef USE_FORTRAN2008
784 integer(kind=c_int), optional, intent(in) :: error
785#else
786 integer(kind=c_int), intent(in) :: error
787#endif
788 type(elpa_impl_t), pointer :: self
789
790 call c_f_pointer(handle, self)
791
792 call elpa_invert_trm_d_ptr_&
793 &elpa_impl_suffix&
794 & (self, a_p, error)
795 end subroutine
796
797
814 subroutine elpa_solve_tridiagonal_&
815 &elpa_impl_suffix&
816 & (self, d, e, q, error)
817 use solve_tridi
818 implicit none
819 class(elpa_impl_t) :: self
820 real(kind=c_real_datatype) :: d(self%na), e(self%na)
821#ifdef USE_ASSUMED_SIZE
822 real(kind=c_real_datatype) :: q(self%local_nrows,*)
823#else
824 real(kind=c_real_datatype) :: q(self%local_nrows,self%local_ncols)
825#endif
826#ifdef USE_FORTRAN2008
827 integer, optional :: error
828#else
829 integer :: error
830#endif
831 logical :: success_l
832
833#if defined(INCLUDE_ROUTINES)
834 success_l = elpa_solve_tridi_&
835 &precision&
836 &_impl(self, d, e, q)
837#else
838 write(error_unit,*) "ELPA is not compiled with single-precision support"
839#ifdef USE_FORTRAN2008
840 if (present(error)) then
841 error = elpa_error
842 return
843 else
844 return
845 endif
846#else
847 error = elpa_error
848 return
849#endif
850#endif
851#ifdef USE_FORTRAN2008
852 if (present(error)) then
853 if (success_l) then
854 error = elpa_ok
855 else
856 error = elpa_error
857 endif
858 else if (.not. success_l) then
859 write(error_unit,'(a)') "ELPA: Error in solve_tridiagonal() and you did not check for errors!"
860 endif
861#else
862 if (success_l) then
863 error = elpa_ok
864 else
865 error = elpa_error
866 endif
867#endif
868 end subroutine
869
870
871#ifdef DOUBLE_PRECISION_REAL
872 !c> void elpa_solve_tridiagonal_d(elpa_t handle, double *d, double *e, double *q, int *error);
873#endif
874#ifdef SINGLE_PRECISION_REAL
875 !c> void elpa_solve_tridiagonal_f(elpa_t handle, float *d, float *e, float *q, int *error);
876#endif
877
878 subroutine elpa_solve_tridiagonal_&
879 &elpa_impl_suffix&
880 &_c(handle, d_p, e_p, q_p, error) &
881#ifdef REALCASE
882#ifdef DOUBLE_PRECISION_REAL
883 bind(C, name="elpa_solve_tridiagonal_d")
884#endif
885#ifdef SINGLE_PRECISION_REAL
886 bind(C, name="elpa_solve_tridiagonal_f")
887#endif
888#endif
889#ifdef COMPLEXCASE
890#ifdef DOUBLE_PRECISION_COMPLEX
891 & !bind(C, name="elpa_solve_tridiagonal_dc")
892#endif
893#ifdef SINGLE_PRECISION_COMPLEX
894 & !bind(C, name="elpa_solve_tridiagonal_fc")
895#endif
896#endif
897
898 type(c_ptr), intent(in), value :: handle, d_p, e_p, q_p
899#ifdef USE_FORTRAN2008
900 integer(kind=c_int), optional, intent(in) :: error
901#else
902 integer(kind=c_int), intent(in) :: error
903#endif
904 real(kind=c_real_datatype), pointer :: d(:), e(:), q(:, :)
905 type(elpa_impl_t), pointer :: self
906
907 call c_f_pointer(handle, self)
908 call c_f_pointer(d_p, d, [self%na])
909 call c_f_pointer(e_p, e, [self%na])
910 call c_f_pointer(q_p, q, [self%local_nrows, self%local_ncols])
911
912 call elpa_solve_tridiagonal_&
913 &elpa_impl_suffix&
914 & (self, d, e, q, error)
915 end subroutine
916
solve_tridi
Definition mod_solve_tridi.F90:3
Generated by doxygen 1.10.0