Line data Source code
1 : ! This file is part of ELPA.
2 : !
3 : ! The ELPA library was originally created by the ELPA consortium,
4 : ! consisting of the following organizations:
5 : !
6 : ! - Max Planck Computing and Data Facility (MPCDF), formerly known as
7 : ! Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
8 : ! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
9 : ! Informatik,
10 : ! - Technische Universität München, Lehrstuhl für Informatik mit
11 : ! Schwerpunkt Wissenschaftliches Rechnen ,
12 : ! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
13 : ! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
14 : ! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
15 : ! and
16 : ! - IBM Deutschland GmbH
17 : !
18 : ! This particular source code file contains additions, changes and
19 : ! enhancements authored by Intel Corporation which is not part of
20 : ! the ELPA consortium.
21 : !
22 : ! More information can be found here:
23 : ! http://elpa.mpcdf.mpg.de/
24 : !
25 : ! ELPA is free software: you can redistribute it and/or modify
26 : ! it under the terms of the version 3 of the license of the
27 : ! GNU Lesser General Public License as published by the Free
28 : ! Software Foundation.
29 : !
30 : ! ELPA is distributed in the hope that it will be useful,
31 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
32 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33 : ! GNU Lesser General Public License for more details.
34 : !
35 : ! You should have received a copy of the GNU Lesser General Public License
36 : ! along with ELPA. If not, see <http://www.gnu.org/licenses/>
37 : !
38 : ! ELPA reflects a substantial effort on the part of the original
39 : ! ELPA consortium, and we ask you to respect the spirit of the
40 : ! license that we chose: i.e., please contribute any changes you
41 : ! may have back to the original ELPA library distribution, and keep
42 : ! any derivatives of ELPA under the same license that we chose for
43 : ! the original distribution, the GNU Lesser General Public License.
44 : !
45 : !
46 : ! ELPA1 -- Faster replacements for ScaLAPACK symmetric eigenvalue routines
47 : !
48 : ! Copyright of the original code rests with the authors inside the ELPA
49 : ! consortium. The copyright of any additional modifications shall rest
50 : ! with their original authors, but shall adhere to the licensing terms
51 : ! distributed along with the original code in the file "COPYING".
52 : !
53 : ! Author: A. Marek, MPCDF
54 :
55 :
56 :
57 : #include "../../general/sanity.F90"
58 :
59 : use precision
60 : use elpa1_auxiliary_impl, only : elpa_solve_tridi_&
61 : &PRECISION&
62 : &_impl
63 : use elpa
64 : use elpa_abstract_impl
65 : implicit none
66 : integer(kind=ik) :: na, nev, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols
67 : real(kind=REAL_DATATYPE) :: d(na), e(na)
68 : #ifdef USE_ASSUMED_SIZE
69 : real(kind=REAL_DATATYPE) :: q(ldq,*)
70 : #else
71 : real(kind=REAL_DATATYPE) :: q(ldq,matrixCols)
72 : #endif
73 :
74 : logical, intent(in) :: wantDebug
75 : logical :: success ! the return value
76 : integer :: error
77 : class(elpa_t), pointer :: obj
78 :
79 : !call timer%start("elpa_solve_tridi_&
80 : !&PRECISION&
81 : !&_legacy_interface")
82 :
83 384 : success = .false.
84 :
85 384 : if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
86 0 : print *, "ELPA API version not supported"
87 0 : success = .false.
88 : endif
89 :
90 384 : obj => elpa_allocate()
91 :
92 384 : call obj%set("na", na, error)
93 384 : if (error .ne. ELPA_OK) then
94 0 : print *,"Problem setting option. Aborting..."
95 0 : stop
96 : endif
97 384 : call obj%set("nev", nev, error)
98 384 : if (error .ne. ELPA_OK) then
99 0 : print *,"Problem setting option. Aborting..."
100 0 : stop
101 : endif
102 384 : call obj%set("local_nrows", ldq, error)
103 384 : if (error .ne. ELPA_OK) then
104 0 : print *,"Problem setting option. Aborting..."
105 0 : stop
106 : endif
107 384 : call obj%set("local_ncols", matrixCols, error)
108 384 : if (error .ne. ELPA_OK) then
109 0 : print *,"Problem setting option. Aborting..."
110 0 : stop
111 : endif
112 384 : call obj%set("nblk", nblk, error)
113 384 : if (error .ne. ELPA_OK) then
114 0 : print *,"Problem setting option. Aborting..."
115 0 : stop
116 : endif
117 :
118 384 : call obj%set("mpi_comm_rows", mpi_comm_rows, error)
119 384 : if (error .ne. ELPA_OK) then
120 0 : print *,"Problem setting option. Aborting..."
121 0 : stop
122 : endif
123 384 : call obj%set("mpi_comm_cols", mpi_comm_cols, error)
124 384 : if (error .ne. ELPA_OK) then
125 0 : print *,"Problem setting option. Aborting..."
126 0 : stop
127 : endif
128 :
129 384 : if (obj%setup() .ne. ELPA_OK) then
130 0 : print *, "Cannot setup ELPA instance"
131 0 : success = .false.
132 0 : return
133 : endif
134 :
135 384 : if (wantDebug) then
136 0 : call obj%set("debug",1, error)
137 0 : if (error .ne. ELPA_OK) then
138 0 : print *,"Problem setting option. Aborting..."
139 0 : stop
140 : endif
141 : endif
142 :
143 384 : call obj%solve_tridiagonal(d, e, q(1:ldq,1:matrixCols), error)
144 384 : if (error /= ELPA_OK) then
145 0 : print *, "Cannot run solve_tridi"
146 0 : success = .false.
147 0 : return
148 : else
149 384 : success = .true.
150 : endif
151 :
152 384 : call elpa_deallocate(obj)
153 384 : call elpa_uninit()
154 :
155 : !call timer%stop("elpa_solve_tridi_&
156 : !&PRECISION&
157 : !&_legacy_interface")
158 :
159 : #undef REALCASE
160 : #undef COMPLEXCASE
161 : #undef DOUBLE_PRECISION
162 : #undef SINGLE_PRECISION
163 :
164 : ! vim: syntax=fortran
|
