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 : !
19 : ! More information can be found here:
20 : ! http://elpa.mpcdf.mpg.de/
21 : !
22 : ! ELPA is free software: you can redistribute it and/or modify
23 : ! it under the terms of the version 3 of the license of the
24 : ! GNU Lesser General Public License as published by the Free
25 : ! Software Foundation.
26 : !
27 : ! ELPA is distributed in the hope that it will be useful,
28 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
29 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
30 : ! GNU Lesser General Public License for more details.
31 : !
32 : ! You should have received a copy of the GNU Lesser General Public License
33 : ! along with ELPA. If not, see <http://www.gnu.org/licenses/>
34 : !
35 : ! ELPA reflects a substantial effort on the part of the original
36 : ! ELPA consortium, and we ask you to respect the spirit of the
37 : ! license that we chose: i.e., please contribute any changes you
38 : ! may have back to the original ELPA library distribution, and keep
39 : ! any derivatives of ELPA under the same license that we chose for
40 : ! the original distribution, the GNU Lesser General Public License.
41 : !
42 : !
43 : #include "config-f90.h"
44 :
45 : #include "../assert.h"
46 :
47 192 : program test_interface
48 192 : use elpa
49 : use test_util
50 : use test_setup_mpi
51 : use test_prepare_matrix
52 : use test_read_input_parameters
53 : use test_blacs_infrastructure
54 : use test_check_correctness
55 : implicit none
56 :
57 : ! matrix dimensions
58 : integer :: na, nev, nblk
59 :
60 : ! mpi
61 : integer :: myid, nprocs
62 : integer :: na_cols, na_rows ! local matrix size
63 : integer :: np_cols, np_rows ! number of MPI processes per column/row
64 : integer :: my_prow, my_pcol ! local MPI task position (my_prow, my_pcol) in the grid (0..np_cols -1, 0..np_rows -1)
65 : integer :: mpierr
66 :
67 : ! blacs
68 : integer :: my_blacs_ctxt, sc_desc(9), info, nprow, npcol
69 :
70 : ! The Matrix
71 384 : real(kind=C_DOUBLE), allocatable :: a1(:,:), as1(:,:)
72 : ! eigenvectors
73 192 : real(kind=C_DOUBLE), allocatable :: z1(:,:)
74 : ! eigenvalues
75 192 : real(kind=C_DOUBLE), allocatable :: ev1(:)
76 :
77 : ! The Matrix
78 384 : complex(kind=C_DOUBLE_COMPLEX), allocatable :: a2(:,:), as2(:,:)
79 : ! eigenvectors
80 192 : complex(kind=C_DOUBLE_COMPLEX), allocatable :: z2(:,:)
81 : ! eigenvalues
82 192 : real(kind=C_DOUBLE), allocatable :: ev2(:)
83 : integer :: success, status
84 :
85 : integer(kind=c_int) :: solver
86 : integer(kind=c_int) :: qr
87 :
88 : type(output_t) :: write_to_file
89 : class(elpa_t), pointer :: e1, e2
90 :
91 192 : call read_input_parameters_traditional(na, nev, nblk, write_to_file)
92 192 : call setup_mpi(myid, nprocs)
93 :
94 192 : status = 0
95 :
96 192 : do np_cols = NINT(SQRT(REAL(nprocs))),2,-1
97 0 : if(mod(nprocs,np_cols) == 0 ) exit
98 : enddo
99 :
100 192 : np_rows = nprocs/np_cols
101 :
102 192 : my_prow = mod(myid, np_cols)
103 192 : my_pcol = myid / np_cols
104 :
105 : call set_up_blacsgrid(mpi_comm_world, np_rows, np_cols, 'C', &
106 192 : my_blacs_ctxt, my_prow, my_pcol)
107 :
108 : call set_up_blacs_descriptor(na, nblk, my_prow, my_pcol, np_rows, np_cols, &
109 192 : na_rows, na_cols, sc_desc, my_blacs_ctxt, info)
110 :
111 192 : allocate(a1 (na_rows,na_cols), as1(na_rows,na_cols))
112 192 : allocate(z1 (na_rows,na_cols))
113 192 : allocate(ev1(na))
114 :
115 192 : a1(:,:) = 0.0
116 192 : z1(:,:) = 0.0
117 192 : ev1(:) = 0.0
118 :
119 192 : call prepare_matrix_random(na, myid, sc_desc, a1, z1, as1)
120 192 : allocate(a2 (na_rows,na_cols), as2(na_rows,na_cols))
121 192 : allocate(z2 (na_rows,na_cols))
122 192 : allocate(ev2(na))
123 :
124 192 : a2(:,:) = 0.0
125 192 : z2(:,:) = 0.0
126 192 : ev2(:) = 0.0
127 :
128 192 : call prepare_matrix_random(na, myid, sc_desc, a2, z2, as2)
129 :
130 192 : if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
131 0 : print *, "ELPA API version not supported"
132 0 : stop 1
133 : endif
134 :
135 192 : e1 => elpa_allocate()
136 :
137 192 : call e1%set("na", na, success)
138 192 : assert_elpa_ok(success)
139 192 : call e1%set("nev", nev, success)
140 192 : assert_elpa_ok(success)
141 192 : call e1%set("local_nrows", na_rows, success)
142 192 : assert_elpa_ok(success)
143 192 : call e1%set("local_ncols", na_cols, success)
144 192 : assert_elpa_ok(success)
145 192 : call e1%set("nblk", nblk, success)
146 192 : assert_elpa_ok(success)
147 192 : call e1%set("mpi_comm_parent", MPI_COMM_WORLD, success)
148 192 : assert_elpa_ok(success)
149 192 : call e1%set("process_row", my_prow, success)
150 192 : assert_elpa_ok(success)
151 192 : call e1%set("process_col", my_pcol, success)
152 192 : assert_elpa_ok(success)
153 :
154 192 : assert(e1%setup() .eq. ELPA_OK)
155 :
156 192 : call e1%set("solver", ELPA_SOLVER_2STAGE, success)
157 192 : assert_elpa_ok(success)
158 :
159 192 : call e1%set("real_kernel", ELPA_2STAGE_REAL_DEFAULT, success)
160 192 : assert_elpa_ok(success)
161 :
162 :
163 192 : e2 => elpa_allocate()
164 :
165 192 : call e2%set("na", na, success)
166 192 : assert_elpa_ok(success)
167 192 : call e2%set("nev", nev, success)
168 192 : assert_elpa_ok(success)
169 192 : call e2%set("local_nrows", na_rows, success)
170 192 : assert_elpa_ok(success)
171 192 : call e2%set("local_ncols", na_cols, success)
172 192 : assert_elpa_ok(success)
173 192 : call e2%set("nblk", nblk, success)
174 192 : assert_elpa_ok(success)
175 192 : call e2%set("mpi_comm_parent", MPI_COMM_WORLD, success)
176 192 : assert_elpa_ok(success)
177 192 : call e2%set("process_row", my_prow, success)
178 192 : assert_elpa_ok(success)
179 192 : call e2%set("process_col", my_pcol, success)
180 192 : assert_elpa_ok(success)
181 :
182 192 : assert(e2%setup() .eq. ELPA_OK)
183 :
184 192 : call e2%set("solver", ELPA_SOLVER_1STAGE, success)
185 192 : assert_elpa_ok(success)
186 :
187 192 : call e1%eigenvectors(a1, ev1, z1, success)
188 192 : assert_elpa_ok(success)
189 192 : call elpa_deallocate(e1)
190 :
191 192 : call e2%eigenvectors(a2, ev2, z2, success)
192 192 : assert_elpa_ok(success)
193 192 : call elpa_deallocate(e2)
194 192 : call elpa_uninit()
195 :
196 192 : status = check_correctness_evp_numeric_residuals(na, nev, as1, z1, ev1, sc_desc, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
197 :
198 192 : deallocate(a1)
199 192 : deallocate(as1)
200 192 : deallocate(z1)
201 192 : deallocate(ev1)
202 :
203 192 : status = check_correctness_evp_numeric_residuals(na, nev, as2, z2, ev2, sc_desc, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
204 :
205 192 : deallocate(a2)
206 192 : deallocate(as2)
207 192 : deallocate(z2)
208 192 : deallocate(ev2)
209 :
210 : #ifdef WITH_MPI
211 128 : call blacs_gridexit(my_blacs_ctxt)
212 128 : call mpi_finalize(mpierr)
213 : #endif
214 192 : call EXIT(STATUS)
215 :
216 :
217 : end program
|
