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 | Intent | Optional | 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 |
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