Line data Source code
1 : #if 0
2 : ! This file is part of ELPA.
3 : !
4 : ! The ELPA library was originally created by the ELPA consortium,
5 : ! consisting of the following organizations:
6 : !
7 : ! - Max Planck Computing and Data Facility (MPCDF), formerly known as
8 : ! Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
9 : ! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
10 : ! Informatik,
11 : ! - Technische Universität München, Lehrstuhl für Informatik mit
12 : ! Schwerpunkt Wissenschaftliches Rechnen ,
13 : ! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
14 : ! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
15 : ! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
16 : ! and
17 : ! - IBM Deutschland GmbH
18 : !
19 : ! This particular source code file contains additions, changes and
20 : ! enhancements authored by Intel Corporation which is not part of
21 : ! the ELPA consortium.
22 : !
23 : ! More information can be found here:
24 : ! http://elpa.mpcdf.mpg.de/
25 : !
26 : ! ELPA is free software: you can redistribute it and/or modify
27 : ! it under the terms of the version 3 of the license of the
28 : ! GNU Lesser General Public License as published by the Free
29 : ! Software Foundation.
30 : !
31 : ! ELPA is distributed in the hope that it will be useful,
32 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
33 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
34 : ! GNU Lesser General Public License for more details.
35 : !
36 : ! You should have received a copy of the GNU Lesser General Public License
37 : ! along with ELPA. If not, see <http://www.gnu.org/licenses/>
38 : !
39 : ! ELPA reflects a substantial effort on the part of the original
40 : ! ELPA consortium, and we ask you to respect the spirit of the
41 : ! license that we chose: i.e., please contribute any changes you
42 : ! may have back to the original ELPA library distribution, and keep
43 : ! any derivatives of ELPA under the same license that we chose for
44 : ! the original distribution, the GNU Lesser General Public License.
45 : !
46 : !
47 : ! ELPA1 -- Faster replacements for ScaLAPACK symmetric eigenvalue routines
48 : !
49 : ! Copyright of the original code rests with the authors inside the ELPA
50 : ! consortium. The copyright of any additional modifications shall rest
51 : ! with their original authors, but shall adhere to the licensing terms
52 : ! distributed along with the original code in the file "COPYING".
53 : #endif
54 :
55 : #include "../../general/sanity.F90"
56 :
57 4224 : function elpa_solve_evp_&
58 : &MATH_DATATYPE&
59 : &_1stage_&
60 : &PRECISION&
61 4224 : & (na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
62 : useGPU) result(success)
63 : use precision
64 : use iso_c_binding
65 : use elpa_mpi
66 : use elpa
67 : implicit none
68 :
69 : integer(kind=c_int), intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_rows, &
70 : mpi_comm_cols, mpi_comm_all
71 : real(kind=REAL_DATATYPE), intent(out) :: ev(na)
72 :
73 : integer(kind=c_int) :: my_prow, my_pcol, mpierr,error
74 :
75 : #if REALCASE == 1
76 : #ifdef USE_ASSUMED_SIZE
77 : real(kind=C_DATATYPE_KIND), intent(inout) :: a(lda,*)
78 : real(kind=C_DATATYPE_KIND), intent(out) :: q(ldq,*)
79 : #else
80 : real(kind=C_DATATYPE_KIND), intent(inout) :: a(lda,matrixCols)
81 : real(kind=C_DATATYPE_KIND), intent(out) :: q(ldq,matrixCols)
82 : #endif
83 : #endif /* REALCASE */
84 :
85 : #if COMPLEXCASE == 1
86 : #ifdef USE_ASSUMED_SIZE
87 : complex(kind=C_DATATYPE_KIND), intent(inout) :: a(lda,*)
88 : complex(kind=C_DATATYPE_KIND), intent(out) :: q(ldq,*)
89 : #else
90 : complex(kind=C_DATATYPE_KIND), intent(inout) :: a(lda,matrixCols)
91 : complex(kind=C_DATATYPE_KIND), intent(out) :: q(ldq,matrixCols)
92 : #endif
93 :
94 : #endif /* COMPLEXCASE */
95 :
96 : logical, intent(in), optional :: useGPU
97 : logical :: success
98 :
99 : integer(kind=c_int) :: successInternal
100 :
101 : class(elpa_t), pointer :: e
102 :
103 4224 : call mpi_comm_rank(mpi_comm_rows,my_prow,mpierr)
104 4224 : call mpi_comm_rank(mpi_comm_cols,my_pcol,mpierr)
105 :
106 4224 : success = .true.
107 4224 : if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
108 0 : print *, "ELPA API version not supported"
109 0 : success = .false.
110 0 : return
111 : endif
112 :
113 4224 : e => elpa_allocate()
114 :
115 4224 : call e%set("na", na,error)
116 4224 : if (error .ne. ELPA_OK) then
117 0 : print *,"Problem setting option. Aborting ..."
118 0 : stop
119 : endif
120 4224 : call e%set("nev", nev,error)
121 4224 : if (error .ne. ELPA_OK) then
122 0 : print *,"Problem setting option. Aborting ..."
123 0 : stop
124 : endif
125 4224 : call e%set("local_nrows", lda,error)
126 4224 : if (error .ne. ELPA_OK) then
127 0 : print *,"Problem setting option. Aborting ..."
128 0 : stop
129 : endif
130 4224 : call e%set("local_ncols", matrixCols,error)
131 4224 : if (error .ne. ELPA_OK) then
132 0 : print *,"Problem setting option. Aborting ..."
133 0 : stop
134 : endif
135 4224 : call e%set("nblk", nblk,error)
136 4224 : if (error .ne. ELPA_OK) then
137 0 : print *,"Problem setting option. Aborting ..."
138 0 : stop
139 : endif
140 :
141 4224 : call e%set("mpi_comm_parent", mpi_comm_all,error)
142 4224 : if (error .ne. ELPA_OK) then
143 0 : print *,"Problem setting option. Aborting ..."
144 0 : stop
145 : endif
146 4224 : call e%set("mpi_comm_rows", mpi_comm_rows,error)
147 4224 : if (error .ne. ELPA_OK) then
148 0 : print *,"Problem setting option. Aborting ..."
149 0 : stop
150 : endif
151 4224 : call e%set("mpi_comm_cols", mpi_comm_cols,error)
152 4224 : if (error .ne. ELPA_OK) then
153 0 : print *,"Problem setting option. Aborting ..."
154 0 : stop
155 : endif
156 :
157 4224 : call e%set("timings",1,error)
158 4224 : if (error .ne. ELPA_OK) then
159 0 : print *,"Problem setting option. Aborting ..."
160 0 : stop
161 : endif
162 :
163 4224 : if (e%setup() .ne. ELPA_OK) then
164 0 : print *, "Cannot setup ELPA instance"
165 0 : success = .false.
166 0 : return
167 : endif
168 :
169 4224 : call e%set("solver", ELPA_SOLVER_1STAGE, successInternal)
170 4224 : if (successInternal .ne. ELPA_OK) then
171 0 : print *, "Cannot set ELPA 1stage solver"
172 0 : success = .false.
173 0 : return
174 : endif
175 :
176 4224 : if (present(useGPU)) then
177 1920 : if (useGPU) then
178 0 : call e%set("gpu", 1, successInternal)
179 0 : if (successInternal .ne. ELPA_OK) then
180 0 : print *, "Cannot set gpu"
181 0 : success = .false.
182 0 : return
183 : endif
184 : else
185 1920 : call e%set("gpu", 0, successInternal)
186 1920 : if (successInternal .ne. ELPA_OK) then
187 0 : print *, "Cannot set gpu"
188 0 : success = .false.
189 0 : return
190 : endif
191 : endif
192 : endif
193 :
194 4224 : call e%set("print_flops", 1,successInternal)
195 4224 : if (successInternal .ne. ELPA_OK) then
196 0 : print *, "Cannot set print_flops"
197 0 : success = .false.
198 0 : return
199 : endif
200 :
201 4224 : call e%set("timings", 1,error)
202 4224 : if (error .ne. ELPA_OK) then
203 0 : print *,"Problem setting option. Aborting ..."
204 0 : stop
205 : endif
206 :
207 4224 : call e%eigenvectors(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal)
208 :
209 : time_evp_fwd = e%get_time("elpa_solve_evp_&
210 : &MATH_DATATYPE&
211 : &_1stage_&
212 : &PRECISION&
213 4224 : &","forward")
214 :
215 4224 : if(my_prow==0 .and. my_pcol==0 .and. elpa_print_times) write(error_unit,*) 'Time tridiag_real :',time_evp_fwd
216 :
217 : time_evp_solve = e%get_time("elpa_solve_evp_&
218 : &MATH_DATATYPE&
219 : &_1stage_&
220 : &PRECISION&
221 4224 : &","solve")
222 :
223 4224 : if(my_prow==0 .and. my_pcol==0 .and. elpa_print_times) write(error_unit,*) 'Time solve_tridi :',time_evp_solve
224 :
225 4224 : if (nev .ge. 1) then
226 : time_evp_back = e%get_time("elpa_solve_evp_&
227 : &MATH_DATATYPE&
228 : &_1stage_&
229 : &PRECISION&
230 4224 : &","back")
231 :
232 4224 : if(my_prow==0 .and. my_pcol==0 .and. elpa_print_times) write(error_unit,*) 'Time trans_ev_real:',time_evp_back
233 : endif
234 :
235 4224 : if (successInternal .ne. ELPA_OK) then
236 0 : print *, "Cannot solve with ELPA 1stage"
237 0 : success = .false.
238 0 : return
239 : endif
240 :
241 4224 : call elpa_deallocate(e)
242 :
243 4224 : call elpa_uninit()
244 :
245 4224 : end function
246 :
247 : ! vim: syntax=fortran
|
