elpa_multiply_a_b.X90 5.97 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
45
46
47
48
49
50
51
52
53
54
55
!    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
!
!    This particular source code file contains additions, changes and
!    enhancements authored by Intel Corporation which is not part of
!    the ELPA consortium.
!
!    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.
!
!
! ELPA1 -- Faster replacements for ScaLAPACK symmetric eigenvalue routines
!
! Copyright of the original code rests with the authors inside the ELPA
! consortium. The copyright of any additional modifications shall rest
! with their original authors, but shall adhere to the licensing terms
! distributed along with the original code in the file "COPYING".
!
! Author: A. Marek, MPCDF


56
#include "../../general/sanity.X90"
57
      use elpa
58
!      use elpa1_compute
Andreas Marek's avatar
Andreas Marek committed
59
60
61
62
63
64
65
66
67
      use elpa_mpi
      use precision
      implicit none

      character*1                   :: uplo_a, uplo_c

      integer(kind=ik), intent(in)  :: na, lda, ldaCols, ldb, ldbCols, ldc, ldcCols, nblk
      integer(kind=ik)              :: ncb, mpi_comm_rows, mpi_comm_cols
#if REALCASE == 1
68
69
70
#ifdef USE_ASSUMED_SIZE
      real(kind=REAL_DATATYPE)                 :: a(lda,*), b(ldb,*), c(ldc,*)
#else
Andreas Marek's avatar
Andreas Marek committed
71
      real(kind=REAL_DATATYPE)                 :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
72
#endif
Andreas Marek's avatar
Andreas Marek committed
73
74
#endif
#if COMPLEXCASE == 1
75
#ifdef USE_ASSUMED_SIZE
Andreas Marek's avatar
Andreas Marek committed
76
      complex(kind=COMPLEX_DATATYPE)           ::  a(lda,*), b(ldb,*), c(ldc,*)
77
78
79
#else
      complex(kind=COMPLEX_DATATYPE)           :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
#endif
  !    integer(kind=ik)                         :: my_prow, my_pcol, np_rows, np_cols, mpierr
  !    integer(kind=ik)                         :: l_cols, l_rows, l_rows_np
!      integer(kind=ik)                         :: np, n, nb, nblk_mult, lrs, lre, lcs, lce
!      integer(kind=ik)                         :: gcol_min, gcol, goff
!      integer(kind=ik)                         :: nstor, nr_done, noff, np_bc, n_aux_bc, nvals
!      integer(kind=ik), allocatable            :: lrs_save(:), lre_save(:)

!      logical                                     :: a_lower, a_upper, c_lower, c_upper
!#if REALCASE == 1
!      real(kind=REAL_DATATYPE), allocatable       :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
!#endif
!#if COMPLEXCASE == 1
!      complex(kind=COMPLEX_DATATYPE), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
!#endif
!      integer(kind=ik)                            :: istat
!      character(200)                              :: errorMessage
      logical                                     :: success
      integer(kind=ik)                            :: successInternal
99
      class(elpa_t), pointer                      :: e
Andreas Marek's avatar
Andreas Marek committed
100

101
102
103
104
105
      !call timer%start("elpa_mult_at_b_&
      !&MATH_DATATYPE&
      !&_&
      !&PRECISION&
      !&_legacy_interface")
Andreas Marek's avatar
Andreas Marek committed
106
107
108

      success = .true.

109
110
111
112
      !call mpi_comm_rank(mpi_comm_rows,my_prow,mpierr)
      !call mpi_comm_size(mpi_comm_rows,np_rows,mpierr)
      !call mpi_comm_rank(mpi_comm_cols,my_pcol,mpierr)
      !call mpi_comm_size(mpi_comm_cols,np_cols,mpierr)
Andreas Marek's avatar
Andreas Marek committed
113

114
115
      !l_rows = local_index(na,  my_prow, np_rows, nblk, -1) ! Local rows of a and b
      !l_cols = local_index(ncb, my_pcol, np_cols, nblk, -1) ! Local cols of b
Andreas Marek's avatar
Andreas Marek committed
116

117
      if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
Pavel Kus's avatar
Pavel Kus committed
118
        print *, "ELPA API version not supported"
119
        success = .false.
Pavel Kus's avatar
Pavel Kus committed
120
        return
Andreas Marek's avatar
Andreas Marek committed
121
122
      endif

123
      e => elpa_allocate()
124
125
126

      call e%set("na", na)
      call e%set("local_nrows", lda)
127
      call e%set("local_ncols", ldaCols)
128
129
130
131
132
      call e%set("nblk", nblk)

      call e%set("mpi_comm_rows", mpi_comm_rows)
      call e%set("mpi_comm_cols", mpi_comm_cols)

133
      if (e%setup() .ne. ELPA_OK) then
134
        print *, "Cannot setup ELPA instance"
135
        success = .false.
Andreas Marek's avatar
Andreas Marek committed
136
137
      endif

138
      call e%hermitian_multiply(uplo_a, uplo_c, ncb, a(1:lda,1:ldaCols), &
139
140
                                b(1:ldb,1:ldbCols), ldb, ldbCols, &
                                c(1:ldc,1:ldcCols), ldc, ldcCols, successInternal)
Andreas Marek's avatar
Andreas Marek committed
141

142
143
144
145
      if (successInternal .ne. ELPA_OK) then
        print *, "Cannot run multiply_a_b"
        success = .false.
        return
Andreas Marek's avatar
Andreas Marek committed
146
      endif
147
      call elpa_deallocate(e)
Andreas Marek's avatar
Andreas Marek committed
148

149
      call elpa_uninit()
Andreas Marek's avatar
Andreas Marek committed
150

151
152
153
154
155
      !call timer%stop("elpa_mult_at_b_&
      !&MATH_DATATYPE&
      !&_&
      !&PRECISION&
      !&_legacy_interface")
Andreas Marek's avatar
Andreas Marek committed
156
157
158
159
160
161

#undef REALCASE
#undef COMPLEXCASE
#undef DOUBLE_PRECISION
#undef SINGLE_PRECISION