Commit 6f4f00e5 by Pavel Kus

### some single/double in elpa1 directory

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