test_new_interface_complex_single.F90 5.12 KB
Newer Older
Andreas Marek's avatar
Andreas Marek committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
!    This file is part of ELPA.
!
!    The ELPA library was originally created by the ELPA consortium,
!    consisting of the following organizations:
!
!    - Max Planck Computing and Data Facility (MPCDF), formerly known as
!      Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
!    - Bergische Universität Wuppertal, Lehrstuhl für angewandte
!      Informatik,
!    - Technische Universität München, Lehrstuhl für Informatik mit
!      Schwerpunkt Wissenschaftliches Rechnen ,
!    - Fritz-Haber-Institut, Berlin, Abt. Theorie,
!    - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
!      Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
!      and
!    - IBM Deutschland GmbH
!
!
!    More information can be found here:
!    http://elpa.mpcdf.mpg.de/
!
!    ELPA is free software: you can redistribute it and/or modify
!    it under the terms of the version 3 of the license of the
!    GNU Lesser General Public License as published by the Free
!    Software Foundation.
!
!    ELPA is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU Lesser General Public License for more details.
!
!    You should have received a copy of the GNU Lesser General Public License
!    along with ELPA.  If not, see <http://www.gnu.org/licenses/>
!
!    ELPA reflects a substantial effort on the part of the original
!    ELPA consortium, and we ask you to respect the spirit of the
!    license that we chose: i.e., please contribute any changes you
!    may have back to the original ELPA library distribution, and keep
!    any derivatives of ELPA under the same license that we chose for
!    the original distribution, the GNU Lesser General Public License.
!
!
#include "config-f90.h"

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
45
46
47
#define stringify_(x) "x"
#define stringify(x) stringify_(x)
#define assert(x) call x_assert(x, stringify(x), __FILE__, __LINE__)
Andreas Marek's avatar
Andreas Marek committed
48

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module assert
  implicit none
  contains
    subroutine x_assert(condition, condition_string, file, line)
      use elpa_utilities, only : error_unit
      logical, intent(in) :: condition
      character(len=*), intent(in) :: condition_string
      character(len=*), intent(in) :: file
      integer, intent(in) :: line

      if (.not. condition) then
        write(error_unit,'(a,i0)') "Assertion failed:" // condition_string // " at " // file // ":", line
      end if
    end subroutine
end module

program test_interface
Andreas Marek's avatar
Andreas Marek committed
66
   use precision
67
   use assert
Andreas Marek's avatar
Andreas Marek committed
68
69
   use mod_setup_mpi
   use elpa_mpi
Andreas Marek's avatar
Andreas Marek committed
70
   use elpa_type
71
72
   use mod_prepare_matrix
   use mod_read_input_parameters
73
   use mod_blacs_infrastructure
74
   use mod_check_correctness
Andreas Marek's avatar
Andreas Marek committed
75
76
77

   implicit none

Andreas Marek's avatar
Andreas Marek committed
78
79
   ! matrix dimensions
   integer :: na, nev, nblk
Andreas Marek's avatar
Andreas Marek committed
80

Andreas Marek's avatar
Andreas Marek committed
81
82
83
84
85
86
   ! mpi
   integer :: myid, nprocs
   integer :: na_cols, na_rows  ! local matrix size
   integer :: np_cols, np_rows  ! number of MPI processes per column/row
   integer :: my_prow, my_pcol  ! local MPI task position (my_prow, my_pcol) in the grid (0..np_cols -1, 0..np_rows -1)
   integer :: mpierr
Andreas Marek's avatar
Andreas Marek committed
87

88
   ! blacs
89
   integer :: my_blacs_ctxt, sc_desc(9), info, nprow, npcol
90

Andreas Marek's avatar
Andreas Marek committed
91
   ! The Matrix
92
   real(kind=C_FLOAT_COMPLEX), allocatable :: a(:,:), as(:,:)
Andreas Marek's avatar
Andreas Marek committed
93
   ! eigenvectors
94
   real(kind=C_FLOAT_COMPLEX), allocatable :: z(:,:)
Andreas Marek's avatar
Andreas Marek committed
95
   ! eigenvalues
96
   real(kind=C_FLOAT), allocatable :: ev(:)
Andreas Marek's avatar
Andreas Marek committed
97

98
   integer :: success, status
Andreas Marek's avatar
Andreas Marek committed
99

100
101
   integer(kind=c_int) :: solver
   integer(kind=c_int) :: qr
Andreas Marek's avatar
Andreas Marek committed
102

103
   type(output_t) :: write_to_file
Andreas Marek's avatar
Andreas Marek committed
104
   type(elpa_t) :: e
Andreas Marek's avatar
Andreas Marek committed
105

106
   call read_input_parameters(na, nev, nblk, write_to_file)
Andreas Marek's avatar
Andreas Marek committed
107
108
109
110
111
112
113
114
   call setup_mpi(myid, nprocs)

   do np_cols = NINT(SQRT(REAL(nprocs))),2,-1
      if(mod(nprocs,np_cols) == 0 ) exit
   enddo

   np_rows = nprocs/np_cols

Andreas Marek's avatar
Andreas Marek committed
115
116
   my_prow = mod(myid, np_cols)
   my_pcol = myid / np_cols
Andreas Marek's avatar
Andreas Marek committed
117

118
119
120
   call set_up_blacsgrid(mpi_comm_world, my_blacs_ctxt, np_rows, np_cols, &
                         nprow, npcol, my_prow, my_pcol)

121
122
123
   call set_up_blacs_descriptor(na, nblk, my_prow, my_pcol, np_rows, np_cols, &
                                na_rows, na_cols, sc_desc, my_blacs_ctxt, info)

124
   allocate(a (na_rows,na_cols), as(na_rows,na_cols))
Andreas Marek's avatar
Andreas Marek committed
125
126
127
   allocate(z (na_rows,na_cols))
   allocate(ev(na))

Andreas Marek's avatar
Andreas Marek committed
128
129
130
   a(:,:) = 0.0
   z(:,:) = 0.0
   ev(:) = 0.0
Andreas Marek's avatar
Andreas Marek committed
131

132
   call prepare_matrix_single(na, myid, sc_desc, a, z, as)
133

134
135
136
137
138
139
140
141
142
143
144
145
146
147
   if (elpa_init(20170403) /= ELPA_OK) then
     error stop "ELPA API version not supported"
   endif

   e = elpa_create(na, nev, na_rows, na_cols, nblk, mpi_comm_world, my_prow, my_pcol, success)
   assert(success == ELPA_OK)

   qr = e%get("qr", success)
   print *, "qr =", qr
   assert(success == ELPA_OK)

   solver = e%get("solver", success)
   print *, "solver =", solver
   assert(success == ELPA_OK)
Andreas Marek's avatar
Andreas Marek committed
148

149
150
   call e%set("solver", ELPA_SOLVER_2STAGE, success)
   assert(success == ELPA_OK)
Andreas Marek's avatar
Andreas Marek committed
151

152
153
   call e%set("complex_kernel", ELPA_2STAGE_COMPLEX_GENERIC, success)
   assert(success == ELPA_OK)
Andreas Marek's avatar
Andreas Marek committed
154

155
156
   call e%solve(a, ev, z, success)
   assert(success == ELPA_OK)
Andreas Marek's avatar
Andreas Marek committed
157

158
   call e%destroy()
Andreas Marek's avatar
Andreas Marek committed
159

Andreas Marek's avatar
Andreas Marek committed
160
   call elpa_uninit()
Andreas Marek's avatar
Andreas Marek committed
161

162
   status = check_correctness_single(na, nev, as, z, ev, sc_desc, myid)
163

Andreas Marek's avatar
Andreas Marek committed
164
   deallocate(a)
165
   deallocate(as)
Andreas Marek's avatar
Andreas Marek committed
166
167
168
   deallocate(z)
   deallocate(ev)

169
#ifdef WITH_MPI
Andreas Marek's avatar
Andreas Marek committed
170
   call mpi_finalize(mpierr)
171
#endif
Andreas Marek's avatar
Andreas Marek committed
172

Andreas Marek's avatar
Andreas Marek committed
173
end program