Eigenvalue SoLvers for Petaflop-Applications (ELPA) 2024.05.001
Loading...
Searching...
No Matches
elpa_impl_math_solvers_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!
73
74 subroutine elpa_eigenvectors_a_h_a_&
75 &elpa_impl_suffix&
76 & (self, a, ev, q, error)
77 class(elpa_impl_t) :: self
78
79#ifdef USE_ASSUMED_SIZE
80 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, *), q(self%local_nrows, *)
81#else
82 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols)
83#endif
84 real(kind=c_real_datatype) :: ev(self%na)
85
86#ifdef USE_FORTRAN2008
87 integer, optional :: error
88#else
89 integer :: error
90#endif
91 integer :: error2
92 integer(kind=c_int) :: solver
93 logical :: success_l
94
95 success_l = .false.
96 call self%get("solver", solver,error2)
97 if (error2 .ne. elpa_ok) then
98 print *,"Problem setting solver. Aborting..."
99#ifdef USE_FORTRAN2008
100 if (present(error)) then
101 error = error2
102 endif
103#else
104 error = error2
105#endif
106 return
107 endif
108 if (solver .eq. elpa_solver_1stage) then
109 call self%autotune_timer%start("accumulator")
110#if defined(INCLUDE_ROUTINES)
111 success_l = elpa_solve_evp_&
112 &math_datatype&
113 &_1stage_a_h_a_&
114 &precision&
115 &_impl(self, a, ev, q)
116#endif
117 call self%autotune_timer%stop("accumulator")
118
119 else if (solver .eq. elpa_solver_2stage) then
120 call self%autotune_timer%start("accumulator")
121#if defined(INCLUDE_ROUTINES)
122 success_l = elpa_solve_evp_&
123 &math_datatype&
124 &_2stage_a_h_a_&
125 &precision&
126 &_impl(self, a, ev, q)
127#endif
128 call self%autotune_timer%stop("accumulator")
129
130 else ! solver
131 write(error_unit,'(a)') "Unknown solver: Aborting!"
132#ifdef USE_FORTRAN2008
133 if (present(error)) then
134 error = elpa_error
135 return
136 else
137 return
138 endif
139#else
140 error = elpa_error
141 return
142#endif
143 endif
144
145#ifdef USE_FORTRAN2008
146 if (present(error)) then
147 if (success_l) then
148 error = elpa_ok
149 else
150 error = elpa_error_during_computation
151 endif
152 else if (.not. success_l) then
153 write(error_unit,'(a)') "ELPA: Error in eigenvectors() and you did not check for errors!"
154 endif
155#else
156 if (success_l) then
157 error = elpa_ok
158 else
159 error = elpa_error_during_computation
160 endif
161#endif
162 end subroutine
163
189
190 subroutine elpa_eigenvectors_d_ptr_&
191 &elpa_impl_suffix&
192 & (self, a, ev, q, error)
193 use iso_c_binding
194
195 implicit none
196 class(elpa_impl_t) :: self
197
198 type(c_ptr) :: a, q, ev
199
200#ifdef USE_FORTRAN2008
201 integer, optional :: error
202#else
203 integer :: error
204#endif
205 integer :: error2
206 integer(kind=c_int) :: solver
207 logical :: success_l
208
209 success_l = .false.
210 call self%get("solver", solver,error2)
211 if (error2 .ne. elpa_ok) then
212 print *,"Problem setting solver. Aborting..."
213#ifdef USE_FORTRAN2008
214 if (present(error)) then
215 error = error2
216 endif
217#else
218 error = error2
219#endif
220 return
221 endif
222 if (solver .eq. elpa_solver_1stage) then
223 call self%autotune_timer%start("accumulator")
224#if defined(INCLUDE_ROUTINES)
225 success_l = elpa_solve_evp_&
226 &math_datatype&
227 &_1stage_d_ptr_&
228 &precision&
229 &_impl(self, a, ev, q)
230#endif
231 call self%autotune_timer%stop("accumulator")
232
233 else if (solver .eq. elpa_solver_2stage) then
234 call self%autotune_timer%start("accumulator")
235#if defined(INCLUDE_ROUTINES)
236 success_l = elpa_solve_evp_&
237 &math_datatype&
238 &_2stage_d_ptr_&
239 &precision&
240 &_impl(self, a, ev, q)
241#endif
242 call self%autotune_timer%stop("accumulator")
243
244 else ! solver
245 write(error_unit,'(a)') "Unknown solver: Aborting!"
246#ifdef USE_FORTRAN2008
247 if (present(error)) then
248 error = elpa_error
249 return
250 else
251 return
252 endif
253#else
254 error = elpa_error
255 return
256#endif
257 endif
258
259#ifdef USE_FORTRAN2008
260 if (present(error)) then
261 if (success_l) then
262 error = elpa_ok
263 else
264 error = elpa_error_during_computation
265 endif
266 else if (.not. success_l) then
267 write(error_unit,'(a)') "ELPA: Error in eigenvectors() and you did not check for errors!"
268 endif
269#else
270 if (success_l) then
271 error = elpa_ok
272 else
273 error = elpa_error_during_computation
274 endif
275#endif
276 end subroutine
277
278 !c> // /src/elpa_impl_math_solvers_template.F90
279
280#ifdef REALCASE
281#ifdef DOUBLE_PRECISION_REAL
282 !c> void elpa_eigenvectors_a_h_a_d(elpa_t handle, double *a, double *ev, double *q, int *error);
283#endif
284#ifdef SINGLE_PRECISION_REAL
285 !c> void elpa_eigenvectors_a_h_a_f(elpa_t handle, float *a, float *ev, float *q, int *error);
286#endif
287#endif
288#ifdef COMPLEXCASE
289#ifdef DOUBLE_PRECISION_COMPLEX
290 !c> void elpa_eigenvectors_a_h_a_dc(elpa_t handle, double_complex *a, double *ev, double_complex *q, int *error);
291#endif
292#ifdef SINGLE_PRECISION_COMPLEX
293 !c> void elpa_eigenvectors_a_h_a_fc(elpa_t handle, float_complex *a, float *ev, float_complex *q, int *error);
294#endif
295#endif
296 subroutine elpa_eigenvectors_a_h_a_&
297 &elpa_impl_suffix&
298 &_c(handle, a_p, ev_p, q_p, error) &
299#ifdef REALCASE
300#ifdef DOUBLE_PRECISION_REAL
301 bind(C, name="elpa_eigenvectors_a_h_a_d")
302#endif
303#ifdef SINGLE_PRECISION_REAL
304 bind(C, name="elpa_eigenvectors_a_h_a_f")
305#endif
306#endif
307#ifdef COMPLEXCASE
308#ifdef DOUBLE_PRECISION_COMPLEX
309 bind(C, name="elpa_eigenvectors_a_h_a_dc")
310#endif
311#ifdef SINGLE_PRECISION_COMPLEX
312 bind(C, name="elpa_eigenvectors_a_h_a_fc")
313#endif
314#endif
315 type(c_ptr), intent(in), value :: handle, a_p, ev_p, q_p
316#ifdef USE_FORTRAN2008
317 integer(kind=c_int), optional, intent(in) :: error
318#else
319 integer(kind=c_int), intent(in) :: error
320#endif
321
322 math_datatype(kind=c_datatype_kind), pointer :: a(:, :), q(:, :)
323 real(kind=c_real_datatype), pointer :: ev(:)
324 type(elpa_impl_t), pointer :: self
325
326 call c_f_pointer(handle, self)
327 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
328 call c_f_pointer(ev_p, ev, [self%na])
329 call c_f_pointer(q_p, q, [self%local_nrows, self%local_ncols])
330
331 call elpa_eigenvectors_a_h_a_&
332 &elpa_impl_suffix&
333 & (self, a, ev, q, error)
334 end subroutine
335
336#ifdef REALCASE
337#ifdef DOUBLE_PRECISION_REAL
338 !c> void elpa_eigenvectors_d_ptr_d(elpa_t handle, double *a, double *ev, double *q, int *error);
339#endif
340#ifdef SINGLE_PRECISION_REAL
341 !c> void elpa_eigenvectors_d_ptr_f(elpa_t handle, float *a, float *ev, float *q, int *error);
342#endif
343#endif
344#ifdef COMPLEXCASE
345#ifdef DOUBLE_PRECISION_COMPLEX
346 !c> void elpa_eigenvectors_d_ptr_dc(elpa_t handle, double_complex *a, double *ev, double_complex *q, int *error);
347#endif
348#ifdef SINGLE_PRECISION_COMPLEX
349 !c> void elpa_eigenvectors_d_ptr_fc(elpa_t handle, float_complex *a, float *ev, float_complex *q, int *error);
350#endif
351#endif
352 subroutine elpa_eigenvectors_d_ptr_&
353 &elpa_impl_suffix&
354 &_c(handle, a_p, ev_p, q_p, error) &
355#ifdef REALCASE
356#ifdef DOUBLE_PRECISION_REAL
357 bind(C, name="elpa_eigenvectors_d_ptr_d")
358#endif
359#ifdef SINGLE_PRECISION_REAL
360 bind(C, name="elpa_eigenvectors_d_ptr_f")
361#endif
362#endif
363#ifdef COMPLEXCASE
364#ifdef DOUBLE_PRECISION_COMPLEX
365 bind(C, name="elpa_eigenvectors_d_ptr_dc")
366#endif
367#ifdef SINGLE_PRECISION_COMPLEX
368 bind(C, name="elpa_eigenvectors_d_ptr_fc")
369#endif
370#endif
371 type(c_ptr), intent(in), value :: handle, a_p, ev_p, q_p
372#ifdef USE_FORTRAN2008
373 integer(kind=c_int), optional, intent(in) :: error
374#else
375 integer(kind=c_int), intent(in) :: error
376#endif
377
378 !MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: a(:, :), q(:, :)
379 !real(kind=C_REAL_DATATYPE), pointer :: ev(:)
380 type(elpa_impl_t), pointer :: self
381
382 call c_f_pointer(handle, self)
383 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
384 !call c_f_pointer(ev_p, ev, [self%na])
385 !call c_f_pointer(q_p, q, [self%local_nrows, self%local_ncols])
386
387 call elpa_eigenvectors_d_ptr_&
388 &elpa_impl_suffix&
389 & (self, a_p, ev_p, q_p, error)
390 end subroutine
391
392#ifdef HAVE_SKEWSYMMETRIC
393#ifdef REALCASE
394
419
420 subroutine elpa_skew_eigenvectors_a_h_a_&
421 &elpa_impl_suffix&
422 & (self, a, ev, q, error)
423 class(elpa_impl_t) :: self
424
425#ifdef USE_ASSUMED_SIZE
426 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, *), q(self%local_nrows, *)
427#else
428 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, self%local_ncols)
429 math_datatype(kind=c_datatype_kind) :: q(self%local_nrows, 2*self%local_ncols)
430#endif
431 real(kind=c_real_datatype) :: ev(self%na)
432
433#ifdef USE_FORTRAN2008
434 integer, optional :: error
435#else
436 integer :: error
437#endif
438 integer :: error2
439 integer(kind=c_int) :: solver
440 logical :: success_l
441
442 success_l = .false.
443 call self%get("solver", solver,error2)
444 !call self%set("is_skewsymmetric",1,error2)
445 if (error2 .ne. elpa_ok) then
446 print *,"Problem setting is_skewsymmetric. Aborting..."
447#ifdef USE_FORTRAN2008
448 if (present(error)) then
449 error = error2
450 endif
451#else
452 error = error2
453#endif
454 return
455 endif
456 if (solver .eq. elpa_solver_1stage) then
457 call self%autotune_timer%start("accumulator")
458#if defined(INCLUDE_ROUTINES)
459 success_l = elpa_solve_skew_evp_&
460 &math_datatype&
461 &_1stage_a_h_a_&
462 &precision&
463 &_impl(self, a, ev, q)
464#endif
465 call self%autotune_timer%stop("accumulator")
466
467 else if (solver .eq. elpa_solver_2stage) then
468 call self%autotune_timer%start("accumulator")
469#if defined(INCLUDE_ROUTINES)
470 success_l = elpa_solve_skew_evp_&
471 &math_datatype&
472 &_2stage_a_h_a_&
473 &precision&
474 &_impl(self, a, ev, q)
475#endif
476 call self%autotune_timer%stop("accumulator")
477
478 else ! solver
479 write(error_unit,'(a)') "Unknown solver: Aborting!"
480#ifdef USE_FORTRAN2008
481 if (present(error)) then
482 error = elpa_error
483 return
484 else
485 return
486 endif
487#else
488 error = elpa_error
489 return
490#endif
491 endif
492
493#ifdef USE_FORTRAN2008
494 if (present(error)) then
495 if (success_l) then
496 error = elpa_ok
497 else
498 error = elpa_error_during_computation
499 endif
500 else if (.not. success_l) then
501 write(error_unit,'(a)') "ELPA: Error in skew_eigenvectors() and you did not check for errors!"
502 endif
503#else
504 if (success_l) then
505 error = elpa_ok
506 else
507 error = elpa_error_during_computation
508 endif
509#endif
510 end subroutine
511
512#ifdef REALCASE
513#ifdef DOUBLE_PRECISION_REAL
514 !c> #ifdef HAVE_SKEWSYMMETRIC
515 !c> void elpa_skew_eigenvectors_a_h_a_d(elpa_t handle, double *a, double *ev, double *q, int *error);
516 !c> #endif
517#endif
518#ifdef SINGLE_PRECISION_REAL
519 !c> #ifdef HAVE_SKEWSYMMETRIC
520 !c> void elpa_skew_eigenvectors_a_h_a_f(elpa_t handle, float *a, float *ev, float *q, int *error);
521 !c> #endif
522#endif
523#endif
524 subroutine elpa_skew_eigenvectors_a_h_a_&
525 &elpa_impl_suffix&
526 &_c(handle, a_p, ev_p, q_p, error) &
527#ifdef REALCASE
528#ifdef DOUBLE_PRECISION_REAL
529 bind(C, name="elpa_skew_eigenvectors_a_h_a_d")
530#endif
531#ifdef SINGLE_PRECISION_REAL
532 bind(C, name="elpa_skew_eigenvectors_a_h_a_f")
533#endif
534#endif
535
536 type(c_ptr), intent(in), value :: handle, a_p, ev_p, q_p
537#ifdef USE_FORTRAN2008
538 integer(kind=c_int), optional, intent(in) :: error
539#else
540 integer(kind=c_int), intent(in) :: error
541#endif
542
543 math_datatype(kind=c_datatype_kind), pointer :: a(:, :), q(:, :)
544 real(kind=c_real_datatype), pointer :: ev(:)
545 type(elpa_impl_t), pointer :: self
546
547 call c_f_pointer(handle, self)
548 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
549 call c_f_pointer(ev_p, ev, [self%na])
550 call c_f_pointer(q_p, q, [self%local_nrows, self%local_ncols])
551
552 call elpa_skew_eigenvectors_a_h_a_&
553 &elpa_impl_suffix&
554 & (self, a, ev, q, error)
555 end subroutine
556
582
583 subroutine elpa_skew_eigenvectors_d_ptr_&
584 &elpa_impl_suffix&
585 & (self, a, ev, q, error)
586 use iso_c_binding
587 implicit none
588 class(elpa_impl_t) :: self
589
590 type(c_ptr) :: a, q, ev
591
592#ifdef USE_FORTRAN2008
593 integer, optional :: error
594#else
595 integer :: error
596#endif
597 integer :: error2
598 integer(kind=c_int) :: solver
599 logical :: success_l
600
601 success_l = .false.
602 call self%get("solver", solver,error2)
603 !call self%set("is_skewsymmetric",1,error2)
604 if (error2 .ne. elpa_ok) then
605 print *,"Problem setting is_skewsymmetric. Aborting..."
606#ifdef USE_FORTRAN2008
607 if (present(error)) then
608 error = error2
609 endif
610#else
611 error = error2
612#endif
613 return
614 endif
615 if (solver .eq. elpa_solver_1stage) then
616 call self%autotune_timer%start("accumulator")
617#if defined(INCLUDE_ROUTINES)
618 success_l = elpa_solve_skew_evp_&
619 &math_datatype&
620 &_1stage_d_ptr_&
621 &precision&
622 &_impl(self, a, ev, q)
623#endif
624 call self%autotune_timer%stop("accumulator")
625
626 else if (solver .eq. elpa_solver_2stage) then
627 call self%autotune_timer%start("accumulator")
628#if defined(INCLUDE_ROUTINES)
629 success_l = elpa_solve_skew_evp_&
630 &math_datatype&
631 &_2stage_d_ptr_&
632 &precision&
633 &_impl(self, a, ev, q)
634#endif
635 call self%autotune_timer%stop("accumulator")
636
637 else ! solver
638 write(error_unit,'(a)') "Unknown solver: Aborting!"
639#ifdef USE_FORTRAN2008
640 if (present(error)) then
641 error = elpa_error
642 return
643 else
644 return
645 endif
646#else
647 error = elpa_error
648 return
649#endif
650 endif
651
652#ifdef USE_FORTRAN2008
653 if (present(error)) then
654 if (success_l) then
655 error = elpa_ok
656 else
657 error = elpa_error_during_computation
658 endif
659 else if (.not. success_l) then
660 write(error_unit,'(a)') "ELPA: Error in skew_eigenvectors() and you did not check for errors!"
661 endif
662#else
663 if (success_l) then
664 error = elpa_ok
665 else
666 error = elpa_error_during_computation
667 endif
668#endif
669 end subroutine
670
671#ifdef REALCASE
672#ifdef DOUBLE_PRECISION_REAL
673 !c> #ifdef HAVE_SKEWSYMMETRIC
674 !c> void elpa_skew_eigenvectors_d_ptr_d(elpa_t handle, double *a, double *ev, double *q, int *error);
675 !c> #endif
676#endif
677#ifdef SINGLE_PRECISION_REAL
678 !c> #ifdef HAVE_SKEWSYMMETRIC
679 !c> void elpa_skew_eigenvectors_d_ptr_f(elpa_t handle, float *a, float *ev, float *q, int *error);
680 !c> #endif
681#endif
682#endif
683 subroutine elpa_skew_eigenvectors_d_ptr_&
684 &elpa_impl_suffix&
685 &_c(handle, a_p, ev_p, q_p, error) &
686#ifdef REALCASE
687#ifdef DOUBLE_PRECISION_REAL
688 bind(C, name="elpa_skew_eigenvectors_d_ptr_d")
689#endif
690#ifdef SINGLE_PRECISION_REAL
691 bind(C, name="elpa_skew_eigenvectors_d_ptr_f")
692#endif
693#endif
694
695 type(c_ptr), intent(in), value :: handle, a_p, ev_p, q_p
696#ifdef USE_FORTRAN2008
697 integer(kind=c_int), optional, intent(in) :: error
698#else
699 integer(kind=c_int), intent(in) :: error
700#endif
701
702 !MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: a(:, :), q(:, :)
703 !real(kind=C_REAL_DATATYPE), pointer :: ev(:)
704 type(elpa_impl_t), pointer :: self
705
706 call c_f_pointer(handle, self)
707 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
708 !call c_f_pointer(ev_p, ev, [self%na])
709 !call c_f_pointer(q_p, q, [self%local_nrows, self%local_ncols])
710
711 call elpa_skew_eigenvectors_d_ptr_&
712 &elpa_impl_suffix&
713 & (self, a_p, ev_p, q_p, error)
714 end subroutine
715
716#endif /* REALCASE */
717#endif /* HAVE_SKEWSYMMETRIC */
718
739 subroutine elpa_eigenvalues_a_h_a_&
740 &elpa_impl_suffix&
741 & (self, a, ev, error)
742 class(elpa_impl_t) :: self
743#ifdef USE_ASSUMED_SIZE
744 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, *)
745#else
746 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, self%local_ncols)
747#endif
748 real(kind=c_real_datatype) :: ev(self%na)
749#ifdef USE_FORTRAN2008
750 integer, optional :: error
751#else
752 integer :: error
753#endif
754 integer :: error2
755 integer(kind=c_int) :: solver
756 logical :: success_l
757
758 success_l = .false.
759 call self%get("solver", solver,error2)
760 if (error2 .ne. elpa_ok) then
761 print *,"Problem getting solver option. Aborting..."
762#ifdef USE_FORTRAN2008
763 if (present(error)) then
764 error = error2
765 endif
766#else
767 error = error2
768#endif
769 return
770 endif
771
772 if (solver .eq. elpa_solver_1stage) then
773 call self%autotune_timer%start("accumulator")
774#if defined(INCLUDE_ROUTINES)
775 success_l = elpa_solve_evp_&
776 &math_datatype&
777 &_1stage_a_h_a_&
778 &precision&
779 &_impl(self, a, ev)
780#endif
781 call self%autotune_timer%stop("accumulator")
782
783 else if (solver .eq. elpa_solver_2stage) then
784 call self%autotune_timer%start("accumulator")
785#if defined(INCLUDE_ROUTINES)
786 success_l = elpa_solve_evp_&
787 &math_datatype&
788 &_2stage_a_h_a_&
789 &precision&
790 &_impl(self, a, ev)
791#endif
792 call self%autotune_timer%stop("accumulator")
793
794 else ! solver
795 write(error_unit,'(a)') "Unknown solver: Aborting!"
796#ifdef USE_FORTRAN2008
797 if (present(error)) then
798 error = elpa_error
799 return
800 else
801 return
802 endif
803#else
804 error = elpa_error
805 return
806#endif
807 endif
808#ifdef USE_FORTRAN2008
809 if (present(error)) then
810 if (success_l) then
811 error = elpa_ok
812 else
813 error = elpa_error_during_computation
814 endif
815 else if (.not. success_l) then
816 write(error_unit,'(a)') "ELPA: Error in eigenvalues() and you did not check for errors!"
817 endif
818#else
819 if (success_l) then
820 error = elpa_ok
821 else
822 error = elpa_error_during_computation
823 endif
824#endif
825 end subroutine
826
827
848 subroutine elpa_eigenvalues_d_ptr_&
849 &elpa_impl_suffix&
850 & (self, a, ev, error)
851 use iso_c_binding
852 implicit none
853
854 class(elpa_impl_t) :: self
855 type(c_ptr) :: a, ev
856#ifdef USE_FORTRAN2008
857 integer, optional :: error
858#else
859 integer :: error
860#endif
861 integer :: error2
862 integer(kind=c_int) :: solver
863 logical :: success_l
864
865 success_l = .false.
866 call self%get("solver", solver,error2)
867 if (error2 .ne. elpa_ok) then
868 print *,"Problem getting solver option. Aborting..."
869#ifdef USE_FORTRAN2008
870 if (present(error)) then
871 error = error2
872 endif
873#else
874 error = error2
875#endif
876 return
877 endif
878
879 if (solver .eq. elpa_solver_1stage) then
880 call self%autotune_timer%start("accumulator")
881#if defined(INCLUDE_ROUTINES)
882 success_l = elpa_solve_evp_&
883 &math_datatype&
884 &_1stage_d_ptr_&
885 &precision&
886 &_impl(self, a, ev)
887#endif
888 call self%autotune_timer%stop("accumulator")
889
890 else if (solver .eq. elpa_solver_2stage) then
891 call self%autotune_timer%start("accumulator")
892#if defined(INCLUDE_ROUTINES)
893 success_l = elpa_solve_evp_&
894 &math_datatype&
895 &_2stage_d_ptr_&
896 &precision&
897 &_impl(self, a, ev)
898#endif
899 call self%autotune_timer%stop("accumulator")
900
901 else ! solver
902 write(error_unit,*) "Unkown solver. Aborting!"
903#ifdef USE_FORTRAN2008
904 if (present(error)) then
905 error = elpa_error
906 return
907 else
908 return
909 endif
910#else
911 error = elpa_error
912 return
913#endif
914 endif
915#ifdef USE_FORTRAN2008
916 if (present(error)) then
917 if (success_l) then
918 error = elpa_ok
919 else
920 error = elpa_error_during_computation
921 endif
922 else if (.not. success_l) then
923 write(error_unit,'(a)') "ELPA: Error in eigenvalues() and you did not check for errors!"
924 endif
925#else
926 if (success_l) then
927 error = elpa_ok
928 else
929 error = elpa_error_during_computation
930 endif
931#endif
932 end subroutine
933
934#ifdef REALCASE
935#ifdef DOUBLE_PRECISION_REAL
936 !c> void elpa_eigenvalues_a_h_a_d(elpa_t handle, double *a, double *ev, int *error);
937#endif
938#ifdef SINGLE_PRECISION_REAL
939 !c> void elpa_eigenvalues_a_h_a_f(elpa_t handle, float *a, float *ev, int *error);
940#endif
941#endif
942#ifdef COMPLEXCASE
943#ifdef DOUBLE_PRECISION_COMPLEX
944 !c> void elpa_eigenvalues_a_h_a_dc(elpa_t handle, double_complex *a, double *ev, int *error);
945#endif
946#ifdef SINGLE_PRECISION_COMPLEX
947 !c> void elpa_eigenvalues_a_h_a_fc(elpa_t handle, float_complex *a, float *ev, int *error);
948#endif
949#endif
950 subroutine elpa_eigenvalues_a_h_a_&
951 &elpa_impl_suffix&
952 &_c(handle, a_p, ev_p, error) &
953#ifdef REALCASE
954#ifdef DOUBLE_PRECISION_REAL
955 bind(C, name="elpa_eigenvalues_a_h_a_d")
956#endif
957#ifdef SINGLE_PRECISION_REAL
958 bind(C, name="elpa_eigenvalues_a_h_a_f")
959#endif
960#endif
961#ifdef COMPLEXCASE
962#ifdef DOUBLE_PRECISION_COMPLEX
963 bind(C, name="elpa_eigenvalues_a_h_a_dc")
964#endif
965#ifdef SINGLE_PRECISION_COMPLEX
966 bind(C, name="elpa_eigenvalues_a_h_a_fc")
967#endif
968#endif
969
970 type(c_ptr), intent(in), value :: handle, a_p, ev_p
971 integer(kind=c_int), intent(in) :: error
972
973 math_datatype(kind=c_datatype_kind), pointer :: a(:, :)
974 real(kind=c_real_datatype), pointer :: ev(:)
975 type(elpa_impl_t), pointer :: self
976
977 call c_f_pointer(handle, self)
978 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
979 call c_f_pointer(ev_p, ev, [self%na])
980
981 call elpa_eigenvalues_a_h_a_&
982 &elpa_impl_suffix&
983 & (self, a, ev, error)
984 end subroutine
985
986#ifdef REALCASE
987#ifdef DOUBLE_PRECISION_REAL
988 !c> void elpa_eigenvalues_d_ptr_d(elpa_t handle, double *a, double *ev, int *error);
989#endif
990#ifdef SINGLE_PRECISION_REAL
991 !c> void elpa_eigenvalues_d_ptr_f(elpa_t handle, float *a, float *ev, int *error);
992#endif
993#endif
994#ifdef COMPLEXCASE
995#ifdef DOUBLE_PRECISION_COMPLEX
996 !c> void elpa_eigenvalues_d_ptr_dc(elpa_t handle, double_complex *a, double *ev, int *error);
997#endif
998#ifdef SINGLE_PRECISION_COMPLEX
999 !c> void elpa_eigenvalues_d_ptr_fc(elpa_t handle, float_complex *a, float *ev, int *error);
1000#endif
1001#endif
1002 subroutine elpa_eigenvalues_d_ptr_&
1003 &elpa_impl_suffix&
1004 &_c(handle, a_p, ev_p, error) &
1005#ifdef REALCASE
1006#ifdef DOUBLE_PRECISION_REAL
1007 bind(C, name="elpa_eigenvalues_d_ptr_d")
1008#endif
1009#ifdef SINGLE_PRECISION_REAL
1010 bind(C, name="elpa_eigenvalues_d_ptr_f")
1011#endif
1012#endif
1013#ifdef COMPLEXCASE
1014#ifdef DOUBLE_PRECISION_COMPLEX
1015 bind(C, name="elpa_eigenvalues_d_ptr_dc")
1016#endif
1017#ifdef SINGLE_PRECISION_COMPLEX
1018 bind(C, name="elpa_eigenvalues_d_ptr_fc")
1019#endif
1020#endif
1021
1022 type(c_ptr), intent(in), value :: handle, a_p, ev_p
1023 integer(kind=c_int), intent(in) :: error
1024
1025 !MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: a(:, :)
1026 !real(kind=C_REAL_DATATYPE), pointer :: ev(:)
1027 type(elpa_impl_t), pointer :: self
1028
1029 call c_f_pointer(handle, self)
1030 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
1031 !call c_f_pointer(ev_p, ev, [self%na])
1032
1033 call elpa_eigenvalues_d_ptr_&
1034 &elpa_impl_suffix&
1035 & (self, a_p, ev_p, error)
1036 end subroutine
1037
1038#ifdef HAVE_SKEWSYMMETRIC
1039#ifdef REALCASE
1040
1060 subroutine elpa_skew_eigenvalues_a_h_a_&
1061 &elpa_impl_suffix&
1062 & (self, a, ev, error)
1063 class(elpa_impl_t) :: self
1064#ifdef USE_ASSUMED_SIZE
1065 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, *)
1066#else
1067 math_datatype(kind=c_datatype_kind) :: a(self%local_nrows, self%local_ncols)
1068#endif
1069 real(kind=c_real_datatype) :: ev(self%na)
1070#ifdef USE_FORTRAN2008
1071 integer, optional :: error
1072#else
1073 integer :: error
1074#endif
1075 integer :: error2
1076 integer(kind=c_int) :: solver
1077 logical :: success_l
1078
1079 success_l = .false.
1080 call self%get("solver", solver,error2)
1081 !call self%set("is_skewsymmetric",1,error2)
1082 if (error2 .ne. elpa_ok) then
1083 print *,"Problem getting solver option. Aborting..."
1084#ifdef USE_FORTRAN2008
1085 if (present(error)) then
1086 error = error2
1087 endif
1088#else
1089 error = error2
1090#endif
1091 return
1092 endif
1093
1094 if (solver .eq. elpa_solver_1stage) then
1095 call self%autotune_timer%start("accumulator")
1096#if defined(INCLUDE_ROUTINES)
1097 success_l = elpa_solve_skew_evp_&
1098 &math_datatype&
1099 &_1stage_a_h_a_&
1100 &precision&
1101 &_impl(self, a, ev)
1102#endif
1103 call self%autotune_timer%stop("accumulator")
1104
1105 else if (solver .eq. elpa_solver_2stage) then
1106 call self%autotune_timer%start("accumulator")
1107#if defined(INCLUDE_ROUTINES)
1108 success_l = elpa_solve_skew_evp_&
1109 &math_datatype&
1110 &_2stage_a_h_a_&
1111 &precision&
1112 &_impl(self, a, ev)
1113#endif
1114 call self%autotune_timer%stop("accumulator")
1115
1116 else ! solver
1117 write(error_unit,'(a)') "Unknown solver: Aborting!"
1118#ifdef USE_FORTRAN2008
1119 if (present(error)) then
1120 error = elpa_error
1121 return
1122 else
1123 return
1124 endif
1125#else
1126 error = elpa_error
1127 return
1128#endif
1129 endif
1130#ifdef USE_FORTRAN2008
1131 if (present(error)) then
1132 if (success_l) then
1133 error = elpa_ok
1134 else
1135 error = elpa_error_during_computation
1136 endif
1137 else if (.not. success_l) then
1138 write(error_unit,'(a)') "ELPA: Error in skew_eigenvalues() and you did not check for errors!"
1139 endif
1140#else
1141 if (success_l) then
1142 error = elpa_ok
1143 else
1144 error = elpa_error_during_computation
1145 endif
1146#endif
1147 end subroutine
1148
1169 subroutine elpa_skew_eigenvalues_d_ptr_&
1170 &elpa_impl_suffix&
1171 & (self, a, ev, error)
1172 use iso_c_binding
1173 implicit none
1174 class(elpa_impl_t) :: self
1175 type(c_ptr) :: a, ev
1176#ifdef USE_FORTRAN2008
1177 integer, optional :: error
1178#else
1179 integer :: error
1180#endif
1181 integer :: error2
1182 integer(kind=c_int) :: solver
1183 logical :: success_l
1184
1185 success_l = .false.
1186 call self%get("solver", solver,error2)
1187 !call self%set("is_skewsymmetric",1,error2)
1188 if (error2 .ne. elpa_ok) then
1189 print *,"Problem getting solver option. Aborting..."
1190#ifdef USE_FORTRAN2008
1191 if (present(error)) then
1192 error = error2
1193 endif
1194#else
1195 error = error2
1196#endif
1197 return
1198 endif
1199
1200 if (solver .eq. elpa_solver_1stage) then
1201 call self%autotune_timer%start("accumulator")
1202#if defined(INCLUDE_ROUTINES)
1203 success_l = elpa_solve_skew_evp_&
1204 &math_datatype&
1205 &_1stage_d_ptr_&
1206 &precision&
1207 &_impl(self, a, ev)
1208#endif
1209 call self%autotune_timer%stop("accumulator")
1210
1211 else if (solver .eq. elpa_solver_2stage) then
1212 call self%autotune_timer%start("accumulator")
1213#if defined(INCLUDE_ROUTINES)
1214 success_l = elpa_solve_skew_evp_&
1215 &math_datatype&
1216 &_2stage_d_ptr_&
1217 &precision&
1218 &_impl(self, a, ev)
1219#endif
1220 call self%autotune_timer%stop("accumulator")
1221
1222 else ! solver
1223 write(error_unit,'(a)') "Unknown solver: Aborting!"
1224#ifdef USE_FORTRAN2008
1225 if (present(error)) then
1226 error = elpa_error
1227 return
1228 else
1229 return
1230 endif
1231#else
1232 error = elpa_error
1233 return
1234#endif
1235 endif
1236#ifdef USE_FORTRAN2008
1237 if (present(error)) then
1238 if (success_l) then
1239 error = elpa_ok
1240 else
1241 error = elpa_error_during_computation
1242 endif
1243 else if (.not. success_l) then
1244 write(error_unit,'(a)') "ELPA: Error in skew_eigenvalues() and you did not check for errors!"
1245 endif
1246#else
1247 if (success_l) then
1248 error = elpa_ok
1249 else
1250 error = elpa_error_during_computation
1251 endif
1252#endif
1253 end subroutine
1254
1255
1256#ifdef REALCASE
1257#ifdef DOUBLE_PRECISION_REAL
1258 !c> #ifdef HAVE_SKEWSYMMETRIC
1259 !c> void elpa_skew_eigenvalues_a_h_a_d(elpa_t handle, double *a, double *ev, int *error);
1260 !c> #endif
1261#endif
1262#ifdef SINGLE_PRECISION_REAL
1263 !c> #ifdef HAVE_SKEWSYMMETRIC
1264 !c> void elpa_skew_eigenvalues_a_h_a_f(elpa_t handle, float *a, float *ev, int *error);
1265 !c> #endif
1266#endif
1267#endif
1268 subroutine elpa_skew_eigenvalues_a_h_a_&
1269 &elpa_impl_suffix&
1270 &_c(handle, a_p, ev_p, error) &
1271#ifdef REALCASE
1272#ifdef DOUBLE_PRECISION_REAL
1273 bind(C, name="elpa_skew_eigenvalues_a_h_a_d")
1274#endif
1275#ifdef SINGLE_PRECISION_REAL
1276 bind(C, name="elpa_skew_eigenvalues_a_h_a_f")
1277#endif
1278#endif
1279 type(c_ptr), intent(in), value :: handle, a_p, ev_p
1280 integer(kind=c_int), intent(in) :: error
1281
1282 math_datatype(kind=c_datatype_kind), pointer :: a(:, :)
1283 real(kind=c_real_datatype), pointer :: ev(:)
1284 type(elpa_impl_t), pointer :: self
1285
1286 call c_f_pointer(handle, self)
1287 call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
1288 call c_f_pointer(ev_p, ev, [self%na])
1289
1290 call elpa_skew_eigenvalues_a_h_a_&
1291 &elpa_impl_suffix&
1292 & (self, a, ev, error)
1293 end subroutine
1294
1295#ifdef REALCASE
1296#ifdef DOUBLE_PRECISION_REAL
1297 !c> #ifdef HAVE_SKEWSYMMETRIC
1298 !c> void elpa_skew_eigenvalues_d_ptr_d(elpa_t handle, double *a, double *ev, int *error);
1299 !c> #endif
1300#endif
1301#ifdef SINGLE_PRECISION_REAL
1302 !c> #ifdef HAVE_SKEWSYMMETRIC
1303 !c> void elpa_skew_eigenvalues_d_ptr_f(elpa_t handle, float *a, float *ev, int *error);
1304 !c> #endif
1305#endif
1306#endif
1307 subroutine elpa_skew_eigenvalues_d_ptr_&
1308 &elpa_impl_suffix&
1309 &_c(handle, a_p, ev_p, error) &
1310#ifdef REALCASE
1311#ifdef DOUBLE_PRECISION_REAL
1312 bind(C, name="elpa_skew_eigenvalues_d_ptr_d")
1313#endif
1314#ifdef SINGLE_PRECISION_REAL
1315 bind(C, name="elpa_skew_eigenvalues_d_ptr_f")
1316#endif
1317#endif
1318 type(c_ptr), intent(in), value :: handle, a_p, ev_p
1319 integer(kind=c_int), intent(in) :: error
1320
1321 !MATH_DATATYPE(kind=C_DATATYPE_KIND), pointer :: a(:, :)
1322 !real(kind=C_REAL_DATATYPE), pointer :: ev(:)
1323 type(elpa_impl_t), pointer :: self
1324
1325 call c_f_pointer(handle, self)
1326 !call c_f_pointer(a_p, a, [self%local_nrows, self%local_ncols])
1327 !call c_f_pointer(ev_p, ev, [self%na])
1328
1329 call elpa_skew_eigenvalues_d_ptr_&
1330 &elpa_impl_suffix&
1331 & (self, a_p, ev_p, error)
1332 end subroutine
1333#endif /* REALCASE */
1334#endif /* HAVE_SKEWSYMMETRIC */
1335
Generated by doxygen 1.10.0