Line data Source code
1 : ! (c) Copyright Pavel Kus, 2017, MPCDF
2 : !
3 : ! This file is part of ELPA.
4 : !
5 : ! The ELPA library was originally created by the ELPA consortium,
6 : ! consisting of the following organizations:
7 : !
8 : ! - Max Planck Computing and Data Facility (MPCDF), formerly known as
9 : ! Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
10 : ! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
11 : ! Informatik,
12 : ! - Technische Universität München, Lehrstuhl für Informatik mit
13 : ! Schwerpunkt Wissenschaftliches Rechnen ,
14 : ! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
15 : ! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
16 : ! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
17 : ! and
18 : ! - IBM Deutschland GmbH
19 : !
20 : !
21 : ! More information can be found here:
22 : ! http://elpa.mpcdf.mpg.de/
23 : !
24 : ! ELPA is free software: you can redistribute it and/or modify
25 : ! it under the terms of the version 3 of the license of the
26 : ! GNU Lesser General Public License as published by the Free
27 : ! Software Foundation.
28 : !
29 : ! ELPA is distributed in the hope that it will be useful,
30 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
31 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
32 : ! GNU Lesser General Public License for more details.
33 : !
34 : ! You should have received a copy of the GNU Lesser General Public License
35 : ! along with ELPA. If not, see <http://www.gnu.org/licenses/>
36 : !
37 : ! ELPA reflects a substantial effort on the part of the original
38 : ! ELPA consortium, and we ask you to respect the spirit of the
39 : ! license that we chose: i.e., please contribute any changes you
40 : ! may have back to the original ELPA library distribution, and keep
41 : ! any derivatives of ELPA under the same license that we chose for
42 : ! the original distribution, the GNU Lesser General Public License.
43 :
44 : #include "../Fortran/assert.h"
45 : #include "config-f90.h"
46 :
47 : module test_analytic
48 :
49 : use test_util
50 : use ftimings
51 : interface prepare_matrix_analytic
52 : module procedure prepare_matrix_analytic_complex_double
53 : module procedure prepare_matrix_analytic_real_double
54 : #ifdef WANT_SINGLE_PRECISION_REAL
55 : module procedure prepare_matrix_analytic_real_single
56 : #endif
57 : #ifdef WANT_SINGLE_PRECISION_COMPLEX
58 : module procedure prepare_matrix_analytic_complex_single
59 : #endif
60 : end interface
61 :
62 : interface check_correctness_analytic
63 : module procedure check_correctness_analytic_complex_double
64 : module procedure check_correctness_analytic_real_double
65 : #ifdef WANT_SINGLE_PRECISION_REAL
66 : module procedure check_correctness_analytic_real_single
67 : #endif
68 : #ifdef WANT_SINGLE_PRECISION_COMPLEX
69 : module procedure check_correctness_analytic_complex_single
70 : #endif
71 : end interface
72 :
73 :
74 : interface print_matrix
75 : module procedure print_matrix_complex_double
76 : module procedure print_matrix_real_double
77 : #ifdef WANT_SINGLE_PRECISION_REAL
78 : module procedure print_matrix_real_single
79 : #endif
80 : #ifdef WANT_SINGLE_PRECISION_COMPLEX
81 : module procedure print_matrix_complex_single
82 : #endif
83 : end interface
84 :
85 : integer(kind=ik), parameter, private :: num_primes = 3
86 : integer(kind=ik), parameter, private :: primes(num_primes) = (/2,3,5/)
87 :
88 : integer(kind=ik), parameter, private :: ANALYTIC_MATRIX = 0
89 : integer(kind=ik), parameter, private :: ANALYTIC_EIGENVECTORS = 1
90 : integer(kind=ik), parameter, private :: ANALYTIC_EIGENVALUES = 2
91 :
92 : contains
93 :
94 429122592 : function decompose(num, decomposition) result(possible)
95 : implicit none
96 : integer(kind=ik), intent(in) :: num
97 : integer(kind=ik), intent(out) :: decomposition(num_primes)
98 : logical :: possible
99 : integer(kind=ik) :: reminder, prime, prime_id
100 :
101 429122592 : decomposition = 0
102 429122592 : possible = .true.
103 429122592 : reminder = num
104 1716490368 : do prime_id = 1, num_primes
105 1287367776 : prime = primes(prime_id)
106 4699553760 : do while (MOD(reminder, prime) == 0)
107 1706092992 : decomposition(prime_id) = decomposition(prime_id) + 1
108 1706092992 : reminder = reminder / prime
109 : end do
110 : end do
111 429122592 : if(reminder > 1) then
112 0 : possible = .false.
113 : end if
114 429122592 : end function
115 :
116 0 : function compose(decomposition) result(num)
117 : implicit none
118 : integer(kind=ik), intent(in) :: decomposition(num_primes)
119 : integer(kind=ik) :: num, prime_id
120 :
121 0 : num = 1;
122 0 : do prime_id = 1, num_primes
123 0 : num = num * primes(prime_id) ** decomposition(prime_id)
124 : end do
125 0 : end function
126 :
127 :
128 : #include "../../src/general/prow_pcol.F90"
129 : #include "../../src/general/map_global_to_local.F90"
130 :
131 :
132 : #define COMPLEXCASE 1
133 : #define DOUBLE_PRECISION 1
134 : #include "../../src/general/precision_macros.h"
135 : #include "test_analytic_template.F90"
136 : #undef DOUBLE_PRECISION
137 : #undef COMPLEXCASE
138 :
139 : #ifdef WANT_SINGLE_PRECISION_COMPLEX
140 :
141 : #define COMPLEXCASE 1
142 : #define SINGLE_PRECISION 1
143 : #include "../../src/general/precision_macros.h"
144 : #include "test_analytic_template.F90"
145 : #undef SINGLE_PRECISION
146 : #undef COMPLEXCASE
147 :
148 : #endif /* WANT_SINGLE_PRECISION_COMPLEX */
149 :
150 : #define REALCASE 1
151 : #define DOUBLE_PRECISION 1
152 : #include "../../src/general/precision_macros.h"
153 : #include "test_analytic_template.F90"
154 : #undef DOUBLE_PRECISION
155 : #undef REALCASE
156 :
157 : #ifdef WANT_SINGLE_PRECISION_REAL
158 :
159 : #define REALCASE 1
160 : #define SINGLE_PRECISION 1
161 : #include "../../src/general/precision_macros.h"
162 : #include "test_analytic_template.F90"
163 : #undef SINGLE_PRECISION
164 : #undef REALCASE
165 :
166 : #endif /* WANT_SINGLE_PRECISION_REAL */
167 :
168 :
169 : end module
|
