elpa_multiply_a_b.F90 6.86 KB
Newer Older
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)                            :: successInternal, 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
      e => elpa_allocate()
124

125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
      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
145

146 147 148 149 150 151 152 153 154 155
      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
156

157 158 159 160 161 162
      call e%set("legacy_api", 1, error)
      if (error .ne. ELPA_OK) then
         print *,"Problem setting option. Aborting..."
         stop 1
      endif

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 170
                                b(1:ldb,1:ldbCols), ldb, ldbCols, &
                                c(1:ldc,1:ldcCols), ldc, ldcCols, successInternal)
Andreas Marek's avatar
Andreas Marek committed
171

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

179
      call elpa_uninit()
Andreas Marek's avatar
Andreas Marek committed
180

181 182 183 184 185
      !call timer%stop("elpa_mult_at_b_&
      !&MATH_DATATYPE&
      !&_&
      !&PRECISION&
      !&_legacy_interface")
Andreas Marek's avatar
Andreas Marek committed
186 187 188 189 190 191

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