Line data    Source code

       1             : module single_hh_trafo_real
       2             :   implicit none
       3             : #include "config-f90.h"
       4             : 
       5             : #ifdef WITH_OPENMP
       6             :   public single_hh_trafo_real_cpu_openmp_double
       7             : #else
       8             :   public single_hh_trafo_real_cpu_double
       9             : #endif
      10             : 
      11             : #ifdef WANT_SINGLE_PRECISION_REAL
      12             : 
      13             : #ifdef WITH_OPENMP
      14             :   public single_hh_trafo_real_cpu_openmp_single
      15             : #else
      16             :   public single_hh_trafo_real_cpu_single
      17             : #endif
      18             : 
      19             : #endif
      20             : 
      21             :   contains
      22             : 
      23             : #ifdef WITH_OPENMP
      24       72192 :     subroutine single_hh_trafo_real_cpu_openmp_double(q, hh, nb, nq, ldq)
      25             : #else
      26       72192 :     subroutine single_hh_trafo_real_cpu_double(q, hh, nb, nq, ldq)
      27             : #endif
      28             : 
      29             :       use elpa_abstract_impl
      30             :       use precision
      31             :       ! Perform single real Householder transformation.
      32             :       ! This routine is not performance critical and thus it is coded here in Fortran
      33             : 
      34             :       implicit none
      35             :  !     class(elpa_abstract_impl_t), intent(inout) :: obj
      36             : 
      37             :       integer(kind=ik), intent(in)   :: nb, nq, ldq
      38             : !      real(kind=rk8), intent(inout)   :: q(ldq, *)
      39             : !      real(kind=rk8), intent(in)      :: hh(*)
      40             :       real(kind=rk8), intent(inout)   :: q(1:ldq, 1:nb)
      41             :       real(kind=rk8), intent(in)      :: hh(1:nb)
      42             :       integer(kind=ik)               :: i
      43      288768 :       real(kind=rk8)                  :: v(nq)
      44             : 
      45             : !#ifdef WITH_OPENMP
      46             : !      call obj%timer%start("single_hh_trafo_real_cpu_openmp_double")
      47             : !#else
      48             : !      call obj%timer%start("single_hh_trafo_real_cpu_double")
      49             : !#endif
      50             : 
      51             :       ! v = q * hh
      52      144384 :       v(:) = q(1:nq,1)
      53     8798208 :       do i=2,nb
      54     8653824 :         v(:) = v(:) + q(1:nq,i) * hh(i)
      55             :       enddo
      56             : 
      57             :       ! v = v * tau
      58      144384 :       v(:) = v(:) * hh(1)
      59             : 
      60             :       ! q = q - v * hh**T
      61      144384 :       q(1:nq,1) = q(1:nq,1) - v(:)
      62     8798208 :       do i=2,nb
      63     8653824 :         q(1:nq,i) = q(1:nq,i) - v(:) * hh(i)
      64             :       enddo
      65             : 
      66             : !#ifdef WITH_OPENMP
      67             : !      call obj%timer%stop("single_hh_trafo_real_cpu_openmp_double")
      68             : !#else
      69             : !      call obj%timer%stop("single_hh_trafo_real_cpu_double")
      70             : !#endif
      71      144384 :     end subroutine
      72             : 
      73             : #ifdef WANT_SINGLE_PRECISION_REAL
      74             : ! single precision implementation at the moment duplicated !!!
      75             : 
      76             : #ifdef WITH_OPENMP
      77       14080 :     subroutine single_hh_trafo_real_cpu_openmp_single(q, hh, nb, nq, ldq)
      78             : #else
      79       14080 :     subroutine single_hh_trafo_real_cpu_single(q, hh, nb, nq, ldq)
      80             : #endif
      81             : 
      82             :       use elpa_abstract_impl
      83             :       use precision
      84             :       ! Perform single real Householder transformation.
      85             :       ! This routine is not performance critical and thus it is coded here in Fortran
      86             : 
      87             :       implicit none
      88             :       !class(elpa_abstract_impl_t), intent(inout) :: obj
      89             : 
      90             :       integer(kind=ik), intent(in)   :: nb, nq, ldq
      91             : !      real(kind=rk4), intent(inout)   :: q(ldq, *)
      92             : !      real(kind=rk4), intent(in)      :: hh(*)
      93             :       real(kind=rk4), intent(inout)   :: q(1:ldq, 1:nb)
      94             :       real(kind=rk4), intent(in)      :: hh(1:nb)
      95             :       integer(kind=ik)               :: i
      96       56320 :       real(kind=rk4)                  :: v(nq)
      97             : 
      98             : !#ifdef WITH_OPENMP
      99             : !      call obj%timer%start("single_hh_trafo_real_cpu_openmp_single")
     100             : !#else
     101             : !      call obj%timer%start("single_hh_trafo_real_cpu_single")
     102             : !#endif
     103             : 
     104             :       ! v = q * hh
     105       28160 :       v(:) = q(1:nq,1)
     106     1691648 :       do i=2,nb
     107     1663488 :         v(:) = v(:) + q(1:nq,i) * hh(i)
     108             :       enddo
     109             : 
     110             :       ! v = v * tau
     111       28160 :       v(:) = v(:) * hh(1)
     112             : 
     113             :       ! q = q - v * hh**T
     114       28160 :       q(1:nq,1) = q(1:nq,1) - v(:)
     115     1691648 :       do i=2,nb
     116     1663488 :         q(1:nq,i) = q(1:nq,i) - v(:) * hh(i)
     117             :       enddo
     118             : 
     119             : !#ifdef WITH_OPENMP
     120             : !      call obj%timer%stop("single_hh_trafo_real_cpu_openmp_single")
     121             : !#else
     122             : !      call obj%timer%stop("single_hh_trafo_real_cpu_single")
     123             : !#endif
     124       28160 :     end subroutine
     125             : 
     126             : 
     127             : #endif /* WANT_SINGLE_PRECISION_REAL */
     128             : end module