dbcsr_put_block_area Subroutine

private subroutine dbcsr_put_block_area(matrix, row, col, block, lb_row_col, transposed, summation, flop, scale)

We allow : matrix(dp) [+]= [scale(dp)] * block(dp) matrix(dp) [+]= [scale(dp)] * block(sp) matrix(sp) [+]= [scale(dp)] * block(sp)

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(inout) :: matrix
integer, intent(in) :: row
integer, intent(in) :: col
type(dbcsr_data_obj) :: block
integer, intent(inout), optional DIMENSION(2):: lb_row_col
logical, intent(in), optional :: transposed
logical, intent(in), optional :: summation
integer(kind=int_8), intent(inout), optional :: flop
type(dbcsr_scalar_type), intent(in), optional :: scale

Contents

Source Code


Source Code

   SUBROUTINE dbcsr_put_block_area(matrix, row, col, block, lb_row_col, transposed, &
                                   summation, flop, scale)
      !! We allow :
      !! matrix(dp) [+]= [scale(dp)] * block(dp)
      !! matrix(dp) [+]= [scale(dp)] * block(sp)
      !! matrix(sp) [+]= [scale(dp)] * block(sp)

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
      INTEGER, INTENT(IN)                                :: row, col
      TYPE(dbcsr_data_obj)                               :: block
      INTEGER, DIMENSION(2), INTENT(INOUT), OPTIONAL     :: lb_row_col
      LOGICAL, INTENT(IN), OPTIONAL                      :: transposed, summation
      INTEGER(KIND=int_8), INTENT(INOUT), OPTIONAL       :: flop
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: scale

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

      INTEGER                                            :: data_type_m, error_handle
      LOGICAL                                            :: do_scale

!   ---------------------------------------------------------------------------

      IF (careful_mod) CALL timeset(routineN, error_handle)
      data_type_m = dbcsr_get_data_type(matrix)
      do_scale = PRESENT(scale)
      IF (do_scale) THEN
         !IF(data_type_m /= scale%data_type) &
         !   DBCSR_ABORT("Incompatible data types matrix="//data_type_m//" scale="//scale%data_type)
      END IF
      IF (.NOT. ASSOCIATED(block%d)) &
         DBCSR_ABORT("Can only add valid data block!")
      SELECT CASE (block%d%data_type)
      CASE (dbcsr_type_real_4)
         IF (do_scale) THEN
            IF (data_type_m .EQ. dbcsr_type_real_4) THEN
               CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_s(block), lb_row_col, transposed, &
                                    summation, flop, scale=scale%r_sp)
            ELSEIF (data_type_m .EQ. dbcsr_type_real_8) THEN
               CALL dbcsr_put_block(matrix, row, col, &
                                    REAL(dbcsr_get_data_p_s(block), real_8), lb_row_col, transposed, &
                                    summation, flop, scale=REAL(scale%r_sp, real_8))
            END IF
         ELSE
            IF (data_type_m .EQ. dbcsr_type_real_4) THEN
               CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_s(block), lb_row_col, transposed, &
                                    summation, flop)
            ELSEIF (data_type_m .EQ. dbcsr_type_real_8) THEN
               CALL dbcsr_put_block(matrix, row, col, &
                                    REAL(dbcsr_get_data_p_s(block), real_8), lb_row_col, transposed, &
                                    summation, flop)
            END IF
         END IF
      CASE (dbcsr_type_real_8)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_d(block), lb_row_col, transposed, &
                                 summation, flop, scale=scale%r_dp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_d(block), lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE (dbcsr_type_complex_4)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_c(block), lb_row_col, transposed, &
                                 summation, flop, scale=scale%c_sp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_c(block), lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE (dbcsr_type_complex_8)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, block%d%c_dp, lb_row_col, transposed, &
                                 summation, flop, scale=scale%c_dp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, block%d%c_dp, lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE (dbcsr_type_real_4_2d)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, block%d%r2_sp, lb_row_col, transposed, &
                                 summation, flop, scale=scale%r_sp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, block%d%r2_sp, lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE (dbcsr_type_real_8_2d)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, block%d%r2_dp, lb_row_col, transposed, &
                                 summation, flop, scale=scale%r_dp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, block%d%r2_dp, lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE (dbcsr_type_complex_4_2d)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, block%d%c2_sp, lb_row_col, transposed, &
                                 summation, flop, scale=scale%c_sp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, block%d%c2_sp, lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE (dbcsr_type_complex_8_2d)
         IF (do_scale) THEN
            CALL dbcsr_put_block(matrix, row, col, block%d%c2_dp, lb_row_col, transposed, &
                                 summation, flop, scale=scale%c_dp)
         ELSE
            CALL dbcsr_put_block(matrix, row, col, block%d%c2_dp, lb_row_col, transposed, &
                                 summation, flop)
         END IF
      CASE default
         DBCSR_ABORT("Invalid data type")
      END SELECT
      IF (careful_mod) CALL timestop(error_handle)
   END SUBROUTINE dbcsr_put_block_area