Commit 6f4f00e5 by Pavel Kus

### some single/double in elpa1 directory

parent 8b7a8051
 ... ... @@ -62,6 +62,7 @@ use precision use elpa_abstract_impl implicit none #include "../general/precision_kinds.F90" class(elpa_abstract_impl_t), intent(inout) :: obj integer(kind=ik), intent(in) :: na, nm, ldq, nqoff, nblk, matrixCols, mpi_comm_rows, & mpi_comm_cols, npc_0, npc_n ... ... @@ -501,7 +502,7 @@ d(1:na1) = dbase(1:na1) - ddiff(1:na1) ! Calculate scale factors for eigenvectors ev_scale(:) = CONST_0_0 ev_scale(:) = 0.0_rk #ifdef WITH_OPENMP ... ...
 ... ... @@ -62,6 +62,7 @@ subroutine solve_tridi_& use precision use elpa_abstract_impl implicit none #include "../../src/general/precision_kinds.F90" class(elpa_abstract_impl_t), intent(inout) :: obj integer(kind=ik), intent(in) :: na, nev, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols real(kind=REAL_DATATYPE), intent(inout) :: d(na), e(na) ... ... @@ -96,7 +97,7 @@ subroutine solve_tridi_& l_cols = local_index(na, my_pcol, np_cols, nblk, -1) ! Local columns of q ! Set Q to 0 q(1:l_rows, 1:l_cols) = CONST_0_0 q(1:l_rows, 1:l_cols) = 0.0_rk ! Get the limits of the subdivisons, each subdivison has as many cols ! as fit on the respective processor column ... ...
 ... ... @@ -157,7 +157,7 @@ use precision use elpa_abstract_impl implicit none #include "../../src/general/precision_kinds.F90" class(elpa_abstract_impl_t), intent(inout) :: obj integer(kind=ik) :: n, i real(kind=REAL_DATATYPE) :: d(n), z(n), delta(n), rho, dlam ... ... @@ -180,7 +180,7 @@ dshift = d(n) delta(:) = d(:) - dshift a = CONST_0_0 ! delta(n) a = 0.0_rk ! delta(n) b = rho*SUM(z(:)**2) + CONST_1_0 ! rho*SUM(z(:)**2) is the lower bound for the guess else ... ...
 ! This file is part of ELPA. ! ! The ELPA library was originally created by the ELPA consortium, ! consisting of the following organizations: ... ... @@ -61,25 +60,17 @@ use elpa_abstract_impl implicit none #include "../../src/general/precision_kinds.F90" class(elpa_abstract_impl_t), intent(inout) :: obj character*1 :: uplo_a, uplo_c integer(kind=ik), intent(in) :: ldb, ldbCols, ldc, ldcCols integer(kind=ik) :: na, ncb #if REALCASE == 1 #ifdef USE_ASSUMED_SIZE real(kind=REAL_DATATYPE) :: a(obj%local_nrows,*), b(ldb,*), c(ldc,*) #else real(kind=REAL_DATATYPE) :: a(obj%local_nrows,obj%local_ncols), b(ldb,ldbCols), c(ldc,ldcCols) #endif #endif #if COMPLEXCASE == 1 #ifdef USE_ASSUMED_SIZE complex(kind=COMPLEX_DATATYPE) :: a(obj%local_nrows,*), b(ldb,*), c(ldc,*) MATH_DATATYPE(kind=rck) :: a(obj%local_nrows,*), b(ldb,*), c(ldc,*) #else complex(kind=COMPLEX_DATATYPE) :: a(obj%local_nrows,obj%local_ncols), b(ldb,ldbCols), c(ldc,ldcCols) #endif MATH_DATATYPE(kind=rck) :: a(obj%local_nrows,obj%local_ncols), b(ldb,ldbCols), c(ldc,ldcCols) #endif integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr integer(kind=ik) :: l_cols, l_rows, l_rows_np ... ... @@ -89,12 +80,7 @@ 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 MATH_DATATYPE(kind=rck), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:) integer(kind=ik) :: istat character(200) :: errorMessage logical :: success ... ... @@ -279,28 +265,8 @@ if (lrs<=lre) then call obj%timer%start("blas") #if REALCASE == 1 call PRECISION_GEMM('T', 'N', & #endif #if COMPLEXCASE == 1 call PRECISION_GEMM('C', 'N', & #endif nstor, lce-lcs+1, lre-lrs+1, & #if REALCASE == 1 CONST_1_0, & #endif #if COMPLEXCASE == 1 CONST_COMPLEX_PAIR_1_0, & #endif aux_mat(lrs,1), ubound(aux_mat,dim=1), & b(lrs,lcs), ldb, & #if REALCASE == 1 CONST_0_0, & #endif #if COMPLEXCASE == 1 CONST_COMPLEX_PAIR_0_0, & #endif tmp1, nstor) call PRECISION_GEMM(BLAS_TRANS_OR_CONJ, 'N', nstor, lce-lcs+1, lre-lrs+1, ONE, & aux_mat(lrs,1), ubound(aux_mat,dim=1), b(lrs,lcs), ldb,ZERO, tmp1, nstor) call obj%timer%stop("blas") else tmp1 = 0 ... ... @@ -309,16 +275,8 @@ ! Sum up the results and send to processor row np #ifdef WITH_MPI call obj%timer%start("mpi_communication") call mpi_reduce(tmp1, tmp2, nstor*(lce-lcs+1), & #if REALCASE == 1 MPI_REAL_PRECISION, & #endif #if COMPLEXCASE == 1 MPI_COMPLEX_PRECISION, & #endif call mpi_reduce(tmp1, tmp2, nstor*(lce-lcs+1), MPI_MATH_DATATYPE_PRECISION, & MPI_SUM, np, mpi_comm_rows, mpierr) call obj%timer%stop("mpi_communication") ! Put the result into C if (my_prow==np) c(nr_done+1:nr_done+nstor,lcs:lce) = tmp2(1:nstor,lcs:lce) ... ... @@ -361,8 +319,3 @@ &PRECISION& &") #undef REALCASE #undef COMPLEXCASE #undef DOUBLE_PRECISION #undef SINGLE_PRECISION
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!