dbcsr_block_real_neg Subroutine

public subroutine dbcsr_block_real_neg(dst, row_size, col_size, lb, lb2)

Negates the real part of a block There are no checks done for correctness!

History - 2010-09 [??] Copied from block_transpose? - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds

Arguments

Type IntentOptional Attributes Name
type(dbcsr_data_obj), intent(inout) :: dst
integer, intent(in) :: row_size

row size of existing block column size of existing block

integer, intent(in) :: col_size

row size of existing block column size of existing block

integer, intent(in), optional :: lb

lower bound for destination (and source if not given explicitly) lower bound of 2nd dimension for target

integer, intent(in), optional :: lb2

lower bound for destination (and source if not given explicitly) lower bound of 2nd dimension for target


Source Code

   SUBROUTINE dbcsr_block_real_neg(dst, &
                                   row_size, col_size, lb, lb2)
      !! Negates the real part of a block
      !! There are no checks done for correctness!
      !!
      !! History
      !! - 2010-09 [??] Copied from block_transpose?
      !! - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds

      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
      INTEGER, INTENT(IN)                                :: row_size, col_size
         !! row size of existing block
         !! column size of existing block
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, lb2
         !! lower bound for destination (and source if not given explicitly)
         !! lower bound of 2nd dimension for target

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_real_neg'

      INTEGER                                            :: data_size, handle, lb2_t, lb_t, ub_t
!     ---------------------------------------------------------------------------
      IF (careful_mod) CALL timeset(routineN, handle)
      IF (debug_mod) THEN
         IF (.NOT. ASSOCIATED(dst%d)) &
            DBCSR_ABORT("Data area must be setup.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
            DBCSR_WARN("Incorrect data type.")
      END IF

      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t + data_size - 1
      lb2_t = 1
      IF (PRESENT(lb2)) lb2_t = lb2
      SELECT CASE (dst%d%data_type)
      CASE (dbcsr_type_real_8)
         dst%d%r_dp(lb_t:ub_t) = -dst%d%r_dp(lb_t:ub_t)
      CASE (dbcsr_type_real_4)
         dst%d%r_sp(lb_t:ub_t) = -dst%d%r_sp(lb_t:ub_t)
      CASE (dbcsr_type_complex_8)
         dst%d%c_dp(lb_t:ub_t) = CMPLX( &
                                 -REAL(dst%d%c_dp(lb_t:ub_t), KIND=real_8), &
                                 AIMAG(dst%d%c_dp(lb_t:ub_t)), &
                                 KIND=real_8)
      CASE (dbcsr_type_complex_4)
         dst%d%c_sp(lb_t:ub_t) = CMPLX( &
                                 -REAL(dst%d%c_sp(lb_t:ub_t), KIND=real_4), &
                                 AIMAG(dst%d%c_sp(lb_t:ub_t)), &
                                 KIND=real_4)
      CASE (dbcsr_type_real_8_2d)
         dst%d%r2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
            -dst%d%r2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)
      CASE (dbcsr_type_real_4_2d)
         dst%d%r2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
            -dst%d%r2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)
      CASE (dbcsr_type_complex_8_2d)
         dst%d%c2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
            CMPLX( &
            -REAL(dst%d%c2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1), KIND=real_8), &
            AIMAG(dst%d%c2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)), &
            KIND=real_8)
      CASE (dbcsr_type_complex_4_2d)
         dst%d%c2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
            CMPLX( &
            -REAL(dst%d%c2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1), KIND=real_4), &
            AIMAG(dst%d%c2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)), &
            KIND=real_4)
      CASE default
         DBCSR_ABORT("Incorrect data type.")
      END SELECT
      IF (careful_mod) CALL timestop(handle)
   END SUBROUTINE dbcsr_block_real_neg