elpa_multiply_a_b_legacy.X90 6.2 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_type
Andreas Marek's avatar
Andreas Marek committed
58 59 60 61 62
#ifdef HAVE_DETAILED_TIMINGS
      use timings
#else
      use timings_dummy
#endif
63
!      use elpa1_compute
Andreas Marek's avatar
Andreas Marek committed
64 65 66 67 68 69 70 71 72
      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
73 74 75
#ifdef USE_ASSUMED_SIZE
      real(kind=REAL_DATATYPE)                 :: a(lda,*), b(ldb,*), c(ldc,*)
#else
Andreas Marek's avatar
Andreas Marek committed
76
      real(kind=REAL_DATATYPE)                 :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
77
#endif
Andreas Marek's avatar
Andreas Marek committed
78 79
#endif
#if COMPLEXCASE == 1
80
#ifdef USE_ASSUMED_SIZE
Andreas Marek's avatar
Andreas Marek committed
81
      complex(kind=COMPLEX_DATATYPE)           ::  a(lda,*), b(ldb,*), c(ldc,*)
82 83 84
#else
      complex(kind=COMPLEX_DATATYPE)           :: a(lda,ldaCols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
#endif
  !    integer(kind=ik)                         :: my_prow, my_pcol, np_rows, np_cols, mpierr
       integer(kind=ik)                         :: nev
  !    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
105
      type(elpa_t)                                :: e
Andreas Marek's avatar
Andreas Marek committed
106 107 108 109

      call timer%start("elpa_mult_at_b_&
      &MATH_DATATYPE&
      &_&
110 111
      &PRECISION&
      &_legacy_interface")
Andreas Marek's avatar
Andreas Marek committed
112 113 114

      success = .true.

115 116 117 118
      !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
119

120 121
      !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
122

123
      if (elpa_init(20170403) /= ELPA_OK) then
Pavel Kus's avatar
Pavel Kus committed
124
        print *, "ELPA API version not supported"
125
        success = .false.
126
        stop
Pavel Kus's avatar
Pavel Kus committed
127
        return
Andreas Marek's avatar
Andreas Marek committed
128 129
      endif

130 131 132 133 134 135 136 137 138 139 140
      e = elpa_allocate()

      call e%set("na", na)
      call e%set("local_nrows", lda)
      call e%set("local_ncols", matrixCols)
      call e%set("nblk", nblk)

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

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

148
      call e%hermitian_multiply(uplo_a, uplo_c, na, ncb, a(1:lda,1:ldaCols), lda, ldaCols, &
149 150
                                b(1:ldb,1:ldbCols), ldb, ldbCols, &
                                c(1:ldc,1:ldcCols), ldc, ldcCols, successInternal)
Andreas Marek's avatar
Andreas Marek committed
151

152 153 154 155 156
      if (successInternal .ne. ELPA_OK) then
        print *, "Cannot run multiply_a_b"
        stop
        success = .false.
        return
Andreas Marek's avatar
Andreas Marek committed
157
      endif
158
      call e%destroy()
Andreas Marek's avatar
Andreas Marek committed
159

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

      call timer%stop("elpa_mult_at_b_&
      &MATH_DATATYPE&
      &_&
165 166
      &PRECISION&
      &_legacy_interface")
Andreas Marek's avatar
Andreas Marek committed
167 168 169 170 171 172

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