Line data Source code
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 : #include "config-f90.h"
49 : !> \brief Fortran module to provide an abstract definition of the implementation. Do not use directly. Use the module "elpa"
50 : module elpa_abstract_impl
51 : use elpa_api
52 : use elpa_generated_fortran_interfaces
53 : use elpa_utilities, only : error_unit
54 :
55 : #ifdef HAVE_DETAILED_TIMINGS
56 : use ftimings
57 : #else
58 : use timings_dummy
59 : #endif
60 :
61 :
62 : implicit none
63 :
64 : ! The reason to have this additional layer is to allow for members (here the
65 : ! 'timer' object) that can be used internally but are not exposed to the
66 : ! public API. This cannot be done via 'private' members, as the scope of
67 : ! 'private' is per-file.
68 : !
69 : ! Thus, other sub-types or suplementary routines cannot use these members
70 : ! (unless they would all be implemented in one giant file)
71 : !
72 : type, abstract, extends(elpa_t) :: elpa_abstract_impl_t
73 : #ifdef HAVE_DETAILED_TIMINGS
74 : type(timer_t) :: timer
75 : type(timer_t) :: autotune_timer
76 : #else
77 : type(timer_dummy_t) :: timer
78 : #endif
79 : type(c_ptr) :: index = C_NULL_PTR
80 : logical :: eigenvalues_only
81 : contains
82 : procedure, public :: elpa_set_integer !< private methods to implement the setting of an integer/double key/value pair
83 : procedure, public :: elpa_set_double
84 :
85 : procedure, public :: elpa_get_integer !< private methods to implement the querry of an integer/double key/value pair
86 : procedure, public :: elpa_get_double
87 :
88 : end type
89 :
90 : contains
91 :
92 : !> \brief internal subroutine to set an integer key/value pair
93 : !> Parameters
94 : !> \param self the allocated ELPA object
95 : !> \param name string, the key
96 : !> \param value integer, the value to be set
97 : !> \result error integer, the error code
98 280352 : subroutine elpa_set_integer(self, name, value, error)
99 : use iso_c_binding
100 : class(elpa_abstract_impl_t) :: self
101 : character(*), intent(in) :: name
102 : integer(kind=c_int), intent(in) :: value
103 : #ifdef USE_FORTRAN2008
104 : integer, optional :: error
105 : #else
106 : integer :: error
107 : #endif
108 : integer :: actual_error
109 :
110 280352 : actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value)
111 :
112 : #ifdef USE_FORTRAN2008
113 280352 : if (present(error)) then
114 280352 : error = actual_error
115 :
116 0 : else if (actual_error /= ELPA_OK) then
117 0 : write(error_unit,'(a,i0,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
118 0 : " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
119 : end if
120 : #else
121 : error = actual_error
122 : #endif
123 560704 : end subroutine
124 :
125 : !> \brief internal subroutine to get an integer key/value pair
126 : !> Parameters
127 : !> \param self the allocated ELPA object
128 : !> \param name string, the key
129 : !> \param value integer, the value of the key/vaue pair
130 : !> \param error integer, optional, to store an error code
131 476232 : subroutine elpa_get_integer(self, name, value, error)
132 : use iso_c_binding
133 : class(elpa_abstract_impl_t) :: self
134 : character(*), intent(in) :: name
135 : integer(kind=c_int) :: value
136 : #ifdef USE_FORTRAN2008
137 : integer, intent(out), optional :: error
138 : #else
139 : integer, intent(out) :: error
140 : #endif
141 : integer :: actual_error
142 :
143 476232 : value = elpa_index_get_int_value_c(self%index, name // c_null_char, actual_error)
144 :
145 : #ifdef USE_FORTRAN2008
146 476232 : if (present(error)) then
147 465944 : error = actual_error
148 10288 : else if (actual_error /= ELPA_OK) then
149 : write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
150 0 : " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
151 : end if
152 : #else
153 : error = actual_error
154 : #endif
155 952464 : end subroutine
156 :
157 : !> \brief internal subroutine to set a double key/value pair
158 : !> Parameters
159 : !> \param self the allocated ELPA object
160 : !> \param name string, the key
161 : !> \param value double, the value to be set
162 : !> \result error integer, the error code
163 0 : subroutine elpa_set_double(self, name, value, error)
164 : use iso_c_binding
165 : class(elpa_abstract_impl_t) :: self
166 : character(*), intent(in) :: name
167 : real(kind=c_double), intent(in) :: value
168 : integer :: actual_error
169 :
170 : #ifdef USE_FORTRAN2008
171 : integer, optional :: error
172 : #else
173 : integer :: error
174 : #endif
175 0 : actual_error = elpa_index_set_double_value_c(self%index, name // c_null_char, value)
176 :
177 : #ifdef USE_FORTRAN2008
178 0 : if (present(error)) then
179 0 : error = actual_error
180 0 : else if (actual_error /= ELPA_OK) then
181 0 : write(error_unit,'(a,es12.5,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
182 0 : " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
183 : end if
184 : #else
185 : error = actual_error
186 : #endif
187 0 : end subroutine
188 :
189 : !> \brief internal subroutine to get an double key/value pair
190 : !> Parameters
191 : !> \param self the allocated ELPA object
192 : !> \param name string, the key
193 : !> \param value double, the value of the key/vaue pair
194 : !> \param error integer, optional, to store an error code
195 0 : subroutine elpa_get_double(self, name, value, error)
196 : use iso_c_binding
197 : class(elpa_abstract_impl_t) :: self
198 : character(*), intent(in) :: name
199 : real(kind=c_double) :: value
200 : #ifdef USE_FORTRAN2008
201 : integer, intent(out), optional :: error
202 : #else
203 : integer, intent(out) :: error
204 : #endif
205 : integer :: actual_error
206 :
207 0 : value = elpa_index_get_double_value_c(self%index, name // c_null_char, actual_error)
208 : #ifdef USE_FORTRAN2008
209 0 : if (present(error)) then
210 0 : error = actual_error
211 0 : else if (actual_error /= ELPA_OK) then
212 : write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
213 0 : " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
214 : end if
215 : #else
216 : error = actual_error
217 : #endif
218 0 : end subroutine
219 :
220 : end module
|
