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