elpa_multiply_a_b.F90 7.15 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.F90"
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
#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
98
      integer(kind=ik)                            :: error
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 124 125 126 127
      e => elpa_allocate(error)
      if (error .ne. ELPA_OK) then
        print *,"Problem calling internal elpa_allocate. Aborting ..."
        stop
      endif
128

Andreas Marek's avatar
Andreas Marek committed
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
      call e%set("na", na, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop
      endif
      call e%set("local_nrows", lda, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop
      endif
      call e%set("local_ncols", ldaCols, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop
      endif
      call e%set("nblk", nblk, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop
      endif
149

Andreas Marek's avatar
Andreas Marek committed
150 151 152 153 154 155 156 157 158 159
      call e%set("mpi_comm_rows", mpi_comm_rows, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop
      endif
      call e%set("mpi_comm_cols", mpi_comm_cols, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop
      endif
160

Pavel Kus's avatar
Pavel Kus committed
161
      call e%creating_from_legacy_api()
162

163
      if (e%setup() .ne. ELPA_OK) then
164
        print *, "Cannot setup ELPA instance"
165
        success = .false.
Andreas Marek's avatar
Andreas Marek committed
166 167
      endif

168
      call e%hermitian_multiply(uplo_a, uplo_c, ncb, a(1:lda,1:ldaCols), &
169
                                b(1:ldb,1:ldbCols), ldb, ldbCols, &
170
                                c(1:ldc,1:ldcCols), ldc, ldcCols, error)
Andreas Marek's avatar
Andreas Marek committed
171

172
      if (error .ne. ELPA_OK) then
173 174 175
        print *, "Cannot run multiply_a_b"
        success = .false.
        return
Andreas Marek's avatar
Andreas Marek committed
176 177
      endif

178 179 180 181 182 183 184 185 186 187 188
      call elpa_deallocate(e, error)
      if (error .ne. ELPA_OK) then
        print *," Cannot deallocate the internal ELPA object! This might lead to a memory leak!"
!        stop
      endif
 
      call elpa_uninit(error)
      if (error .ne. ELPA_OK) then
        print *," Cannot uninit the internal ELPA object! This might lead to a memory leak!"
!        stop
      endif
Andreas Marek's avatar
Andreas Marek committed
189

190 191 192 193 194
      !call timer%stop("elpa_mult_at_b_&
      !&MATH_DATATYPE&
      !&_&
      !&PRECISION&
      !&_legacy_interface")
Andreas Marek's avatar
Andreas Marek committed
195 196 197 198 199 200

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