|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00015 MODULE cp_dbcsr_interface 00016 USE array_types, ONLY: array_data,& 00017 array_hold,& 00018 array_i1d_obj,& 00019 array_new,& 00020 array_release,& 00021 array_size 00022 USE cp_dbcsr_methods, ONLY: cp_dbcsr_col_block_offsets,& 00023 cp_dbcsr_col_block_sizes,& 00024 cp_dbcsr_row_block_offsets,& 00025 cp_dbcsr_row_block_sizes 00026 USE cp_dbcsr_types, ONLY: cp_dbcsr_iterator,& 00027 cp_dbcsr_type 00028 USE cp_log_handling, ONLY: cp_logger_get_default_io_unit,& 00029 cp_logger_type,& 00030 cp_logger_would_log,& 00031 cp_note_level 00032 USE dbcsr_block_access, ONLY: dbcsr_get_block,& 00033 dbcsr_get_block_p,& 00034 dbcsr_put_block,& 00035 dbcsr_reserve_block2d,& 00036 dbcsr_reserve_blocks 00037 USE dbcsr_config, ONLY: & 00038 dbcsr_get_conf_combtypes, dbcsr_get_conf_comm_thread_load, & 00039 dbcsr_get_conf_cuda_mem, dbcsr_get_conf_mm_driver, & 00040 dbcsr_get_conf_mm_stacksize, dbcsr_get_conf_mpi_mem, & 00041 dbcsr_get_conf_nstacks, dbcsr_get_conf_subcomm, & 00042 dbcsr_get_conf_use_comm_thread, dbcsr_set_conf_combtypes, & 00043 dbcsr_set_conf_comm_thread_load, dbcsr_set_conf_cuda_mem, & 00044 dbcsr_set_conf_external_timing, dbcsr_set_conf_mm_driver, & 00045 dbcsr_set_conf_mm_stacksize, dbcsr_set_conf_mpi_mem, & 00046 dbcsr_set_conf_nstacks, dbcsr_set_conf_subcomm, & 00047 dbcsr_set_conf_use_comm_thread, has_cuda, has_mpi, mm_driver_blas, & 00048 mm_driver_cuda, mm_driver_matmul, mm_driver_plasma, mm_driver_smm, & 00049 mm_name_blas, mm_name_cuda, mm_name_matmul, mm_name_plasma, mm_name_smm 00050 USE dbcsr_data_methods, ONLY: dbcsr_scalar,& 00051 dbcsr_scalar_fill_all,& 00052 dbcsr_scalar_get_value,& 00053 dbcsr_scalar_set_type,& 00054 dbcsr_scalar_zero 00055 USE dbcsr_dist_operations, ONLY: create_bl_distribution,& 00056 dbcsr_get_stored_coordinates 00057 USE dbcsr_error_handling, ONLY: dbcsr_error_set,& 00058 dbcsr_error_stop,& 00059 dbcsr_error_type 00060 USE dbcsr_io, ONLY: dbcsr_binary_read,& 00061 dbcsr_binary_write,& 00062 dbcsr_print 00063 USE dbcsr_iterator_operations, ONLY: dbcsr_iterator_blocks_left,& 00064 dbcsr_iterator_next_block,& 00065 dbcsr_iterator_start,& 00066 dbcsr_iterator_stop 00067 USE dbcsr_methods, ONLY: & 00068 dbcsr_blk_col_offset, dbcsr_blk_column_size, dbcsr_blk_row_offset, & 00069 dbcsr_blk_row_size, dbcsr_distribution, dbcsr_distribution_col_dist, & 00070 dbcsr_distribution_mp, dbcsr_distribution_new, & 00071 dbcsr_distribution_release, dbcsr_distribution_row_dist, & 00072 dbcsr_get_data_size, dbcsr_get_data_type, dbcsr_get_info, & 00073 dbcsr_get_matrix_type, dbcsr_get_num_blocks, dbcsr_get_occupation, & 00074 dbcsr_init, dbcsr_max_col_size, dbcsr_max_row_size, dbcsr_mp_new, & 00075 dbcsr_mp_release, dbcsr_name, dbcsr_nblkcols_local, & 00076 dbcsr_nblkcols_total, dbcsr_nblkrows_local, dbcsr_nblkrows_total, & 00077 dbcsr_nfullcols_local, dbcsr_nfullcols_total, dbcsr_nfullrows_local, & 00078 dbcsr_nfullrows_total, dbcsr_release, dbcsr_valid_index 00079 USE dbcsr_operations, ONLY: & 00080 dbcsr_add, dbcsr_add_on_diag, dbcsr_btriu, dbcsr_copy, & 00081 dbcsr_copy_into_existing, dbcsr_filter, dbcsr_finalize_lib, & 00082 dbcsr_frobenius_norm, dbcsr_gershgorin_norm, dbcsr_get_block_diag, & 00083 dbcsr_get_diag, dbcsr_hadamard_product, dbcsr_init_lib, dbcsr_maxabs, & 00084 dbcsr_multiply, dbcsr_norm, dbcsr_scale, dbcsr_scale_by_vector, & 00085 dbcsr_scale_mat, dbcsr_set, dbcsr_set_diag, dbcsr_sum_replicated, & 00086 dbcsr_trace 00087 USE dbcsr_toollib, ONLY: swap 00088 USE dbcsr_transformations, ONLY: dbcsr_complete_redistribute,& 00089 dbcsr_desymmetrize_deep,& 00090 dbcsr_distribute,& 00091 dbcsr_make_untransposed_blocks,& 00092 dbcsr_new_transposed,& 00093 dbcsr_replicate,& 00094 dbcsr_replicate_all 00095 USE dbcsr_types, ONLY: dbcsr_2d_array_type,& 00096 dbcsr_data_obj,& 00097 dbcsr_distribution_obj,& 00098 dbcsr_mp_obj,& 00099 dbcsr_no_transpose,& 00100 dbcsr_scalar_type,& 00101 dbcsr_type_complex_4,& 00102 dbcsr_type_complex_8 00103 USE dbcsr_util, ONLY: dbcsr_checksum,& 00104 dbcsr_verify_matrix 00105 USE dbcsr_work_operations, ONLY: dbcsr_create,& 00106 dbcsr_finalize,& 00107 dbcsr_work_create 00108 USE input_section_types, ONLY: section_vals_get_subs_vals,& 00109 section_vals_type,& 00110 section_vals_val_get 00111 USE kinds, ONLY: default_string_length,& 00112 dp,& 00113 int_8,& 00114 real_4,& 00115 real_8 00116 USE string_utilities, ONLY: integer_to_string,& 00117 uppercase 00118 USE timings, ONLY: timeset,& 00119 timestop 00120 00121 !$ USE OMP_LIB 00122 #include "cp_common_uses.h" 00123 #define CHECKUSAGE CALL cp_assert(.FALSE.,cp_fatal_level,cp_unimplemented_error_nr,routineN,"OBS") 00124 #define BUFFERME ! buffering code 00125 00126 IMPLICIT NONE 00127 00128 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_dbcsr_interface' 00129 00130 ! 00131 ! Interface to libdbcsr (contains cp2k timing and error) 00132 PUBLIC :: cp_dbcsr_conform_scalar 00133 PUBLIC :: cp_dbcsr_init_lib, cp_dbcsr_finalize_lib 00134 PUBLIC :: cp_dbcsr_config 00135 PUBLIC :: cp_dbcsr_print_config 00136 PUBLIC :: cp_dbcsr_untranspose_blocks 00137 PUBLIC :: cp_dbcsr_set 00138 PUBLIC :: cp_dbcsr_add 00139 PUBLIC :: cp_dbcsr_scale 00140 PUBLIC :: cp_dbcsr_scale_by_vector 00141 PUBLIC :: cp_dbcsr_hadamard_product 00142 PUBLIC :: cp_dbcsr_transposed 00143 PUBLIC :: cp_dbcsr_multiply 00144 PUBLIC :: cp_dbcsr_copy 00145 PUBLIC :: cp_dbcsr_copy_into_existing 00146 PUBLIC :: cp_dbcsr_desymmetrize 00147 PUBLIC :: cp_dbcsr_add_on_diag 00148 PUBLIC :: cp_dbcsr_get_block_diag 00149 PUBLIC :: cp_dbcsr_set_diag 00150 PUBLIC :: cp_dbcsr_get_diag 00151 PUBLIC :: cp_dbcsr_filter 00152 PUBLIC :: cp_dbcsr_finalize 00153 PUBLIC :: cp_dbcsr_create 00154 PUBLIC :: cp_dbcsr_work_create 00155 PUBLIC :: cp_dbcsr_verify_matrix 00156 PUBLIC :: cp_dbcsr_btriu 00157 PUBLIC :: cp_dbcsr_sum_replicated 00158 PUBLIC :: cp_dbcsr_checksum 00159 PUBLIC :: cp_dbcsr_trace 00160 PUBLIC :: cp_dbcsr_print 00161 PUBLIC :: cp_dbcsr_init 00162 PUBLIC :: cp_dbcsr_init_p 00163 PUBLIC :: cp_dbcsr_release 00164 PUBLIC :: cp_dbcsr_release_p 00165 PUBLIC :: cp_dbcsr_distribute 00166 PUBLIC :: cp_dbcsr_replicate_all 00167 PUBLIC :: cp_dbcsr_replicate 00168 PUBLIC :: cp_dbcsr_norm 00169 PUBLIC :: cp_dbcsr_get_info 00170 PUBLIC :: cp_dbcsr_get_block 00171 PUBLIC :: cp_dbcsr_get_block_p 00172 PUBLIC :: cp_dbcsr_put_block 00173 PUBLIC :: cp_dbcsr_iterator_start 00174 PUBLIC :: cp_dbcsr_iterator_stop 00175 PUBLIC :: cp_dbcsr_iterator_next_block 00176 PUBLIC :: cp_dbcsr_mp_new 00177 PUBLIC :: cp_dbcsr_mp_release 00178 PUBLIC :: cp_dbcsr_iterator_blocks_left 00179 PUBLIC :: cp_dbcsr_distribution_release 00180 PUBLIC :: cp_dbcsr_col_block_sizes 00181 PUBLIC :: cp_dbcsr_row_block_sizes 00182 PUBLIC :: cp_create_bl_distribution 00183 PUBLIC :: cp_dbcsr_get_matrix_type 00184 PUBLIC :: cp_dbcsr_get_occupation 00185 PUBLIC :: cp_dbcsr_distribution 00186 PUBLIC :: cp_dbcsr_nblkrows_local 00187 PUBLIC :: cp_dbcsr_nblkcols_local 00188 PUBLIC :: cp_dbcsr_nblkrows_total 00189 PUBLIC :: cp_dbcsr_nblkcols_total 00190 PUBLIC :: cp_dbcsr_get_num_blocks 00191 PUBLIC :: cp_dbcsr_get_data_size 00192 PUBLIC :: cp_dbcsr_col_block_offsets 00193 PUBLIC :: cp_dbcsr_row_block_offsets 00194 PUBLIC :: cp_dbcsr_nfullrows_total 00195 PUBLIC :: cp_dbcsr_nfullcols_total 00196 PUBLIC :: cp_dbcsr_nfullrows_local 00197 PUBLIC :: cp_dbcsr_nfullcols_local 00198 ! 1234567890123456789012345678901 00199 PUBLIC :: cp_dbcsr_get_stored_coordinates 00200 PUBLIC :: cp_dbcsr_valid_index 00201 PUBLIC :: cp_dbcsr_get_data_type 00202 PUBLIC :: cp_dbcsr_reserve_block2d 00203 PUBLIC :: cp_dbcsr_reserve_blocks 00204 PUBLIC :: cp_dbcsr_complete_redistribute 00205 PUBLIC :: cp_dbcsr_gershgorin_norm 00206 PUBLIC :: cp_dbcsr_frobenius_norm 00207 PUBLIC :: cp_dbcsr_maxabs 00208 PUBLIC :: cp_dbcsr_name 00209 PUBLIC :: cp_dbcsr_binary_write 00210 PUBLIC :: cp_dbcsr_binary_read 00211 00212 00213 INTERFACE cp_dbcsr_create 00214 MODULE PROCEDURE cp_dbcsr_create_new 00215 MODULE PROCEDURE cp_dbcsr_create_template 00216 END INTERFACE 00217 00218 INTERFACE cp_dbcsr_conform_scalar 00219 MODULE PROCEDURE make_conformant_scalar_r, make_conformant_scalar_d,& 00220 make_conformant_scalar_c, make_conformant_scalar_z 00221 END INTERFACE 00222 00223 INTERFACE cp_dbcsr_trace 00224 MODULE PROCEDURE cp_dbcsr_trace_ab_d 00225 MODULE PROCEDURE cp_dbcsr_trace_ab_s 00226 MODULE PROCEDURE cp_dbcsr_trace_a_d 00227 MODULE PROCEDURE cp_dbcsr_trace_a_s 00228 END INTERFACE 00229 00230 INTERFACE cp_dbcsr_set 00231 MODULE PROCEDURE cp_dbcsr_set_d 00232 MODULE PROCEDURE cp_dbcsr_set_s 00233 MODULE PROCEDURE cp_dbcsr_set_c 00234 MODULE PROCEDURE cp_dbcsr_set_z 00235 END INTERFACE 00236 00237 INTERFACE cp_dbcsr_add 00238 MODULE PROCEDURE cp_dbcsr_add_d 00239 MODULE PROCEDURE cp_dbcsr_add_s 00240 MODULE PROCEDURE cp_dbcsr_add_c 00241 MODULE PROCEDURE cp_dbcsr_add_z 00242 END INTERFACE 00243 00244 INTERFACE cp_dbcsr_scale 00245 MODULE PROCEDURE cp_dbcsr_scale_d 00246 MODULE PROCEDURE cp_dbcsr_scale_s 00247 MODULE PROCEDURE cp_dbcsr_scale_c 00248 MODULE PROCEDURE cp_dbcsr_scale_z 00249 MODULE PROCEDURE cp_dbcsr_scale_d_m 00250 MODULE PROCEDURE cp_dbcsr_scale_s_m 00251 MODULE PROCEDURE cp_dbcsr_scale_c_m 00252 MODULE PROCEDURE cp_dbcsr_scale_z_m 00253 END INTERFACE 00254 00255 INTERFACE cp_dbcsr_scale_by_vector 00256 MODULE PROCEDURE cp_dbcsr_scale_by_vector_d 00257 MODULE PROCEDURE cp_dbcsr_scale_by_vector_s 00258 MODULE PROCEDURE cp_dbcsr_scale_by_vector_c 00259 MODULE PROCEDURE cp_dbcsr_scale_by_vector_z 00260 END INTERFACE 00261 00262 INTERFACE cp_dbcsr_multiply 00263 MODULE PROCEDURE cp_dbcsr_multiply_d 00264 MODULE PROCEDURE cp_dbcsr_multiply_s 00265 MODULE PROCEDURE cp_dbcsr_multiply_c 00266 MODULE PROCEDURE cp_dbcsr_multiply_z 00267 END INTERFACE 00268 00269 INTERFACE cp_dbcsr_get_block_p 00270 MODULE PROCEDURE cp_dbcsr_get_block_p_d, cp_dbcsr_get_block_p_s,& 00271 cp_dbcsr_get_block_p_z, cp_dbcsr_get_block_p_c 00272 MODULE PROCEDURE cp_dbcsr_get_2d_block_p_d, cp_dbcsr_get_2d_block_p_s,& 00273 cp_dbcsr_get_2d_block_p_z, cp_dbcsr_get_2d_block_p_c 00274 END INTERFACE 00275 00276 INTERFACE cp_dbcsr_get_block 00277 MODULE PROCEDURE cp_dbcsr_get_block_d, cp_dbcsr_get_block_s,& 00278 cp_dbcsr_get_block_z, cp_dbcsr_get_block_c 00279 MODULE PROCEDURE cp_dbcsr_get_2d_block_d, cp_dbcsr_get_2d_block_s,& 00280 cp_dbcsr_get_2d_block_z, cp_dbcsr_get_2d_block_c 00281 END INTERFACE 00282 00283 INTERFACE cp_dbcsr_put_block 00284 MODULE PROCEDURE cp_dbcsr_put_block_d, cp_dbcsr_put_block_s,& 00285 cp_dbcsr_put_block_z, cp_dbcsr_put_block_c 00286 MODULE PROCEDURE cp_dbcsr_put_block2d_d, cp_dbcsr_put_block2d_s,& 00287 cp_dbcsr_put_block2d_z, cp_dbcsr_put_block2d_c 00288 END INTERFACE 00289 00290 INTERFACE cp_dbcsr_iterator_next_block 00291 MODULE PROCEDURE cp_iterator_next_block_index 00292 MODULE PROCEDURE cp_iterator_next_2d_block_d,& 00293 cp_iterator_next_2d_block_s,& 00294 cp_iterator_next_2d_block_c,& 00295 cp_iterator_next_2d_block_z,& 00296 cp_iterator_next_1d_block_d,& 00297 cp_iterator_next_1d_block_s,& 00298 cp_iterator_next_1d_block_c,& 00299 cp_iterator_next_1d_block_z 00300 END INTERFACE 00301 00302 INTERFACE cp_dbcsr_reserve_block2d 00303 MODULE PROCEDURE cp_dbcsr_reserve_block2d_d 00304 MODULE PROCEDURE cp_dbcsr_reserve_block2d_s 00305 MODULE PROCEDURE cp_dbcsr_reserve_block2d_c 00306 MODULE PROCEDURE cp_dbcsr_reserve_block2d_z 00307 END INTERFACE 00308 00309 PRIVATE 00310 00311 CONTAINS 00312 00313 ! ***************************************************************************** 00317 FUNCTION make_conformant_scalar_r (scalar, matrix, error) RESULT (encapsulated) 00318 REAL(kind=real_4), INTENT(IN) :: scalar 00319 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00320 TYPE(cp_error_type), INTENT(INOUT) :: error 00321 TYPE(dbcsr_scalar_type) :: encapsulated 00322 00323 encapsulated = dbcsr_scalar (scalar) 00324 CALL dbcsr_scalar_fill_all (encapsulated) 00325 CALL dbcsr_scalar_set_type (encapsulated,& 00326 dbcsr_get_data_type (matrix%matrix)) 00327 END FUNCTION make_conformant_scalar_r 00328 ! ***************************************************************************** 00332 FUNCTION make_conformant_scalar_d (scalar, matrix, error) RESULT (encapsulated) 00333 REAL(kind=real_8), INTENT(IN) :: scalar 00334 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00335 TYPE(cp_error_type), INTENT(INOUT) :: error 00336 TYPE(dbcsr_scalar_type) :: encapsulated 00337 00338 encapsulated = dbcsr_scalar (scalar) 00339 CALL dbcsr_scalar_fill_all (encapsulated) 00340 CALL dbcsr_scalar_set_type (encapsulated,& 00341 dbcsr_get_data_type (matrix%matrix)) 00342 END FUNCTION make_conformant_scalar_d 00343 ! ***************************************************************************** 00347 FUNCTION make_conformant_scalar_c (scalar, matrix, error) RESULT (encapsulated) 00348 COMPLEX(kind=real_4), INTENT(IN) :: scalar 00349 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00350 TYPE(cp_error_type), INTENT(INOUT) :: error 00351 TYPE(dbcsr_scalar_type) :: encapsulated 00352 00353 CHARACTER(len=*), PARAMETER :: routineN = 'make_conformant_scalar_c', 00354 routineP = moduleN//':'//routineN 00355 00356 INTEGER :: data_type 00357 00358 encapsulated = dbcsr_scalar (scalar) 00359 CALL dbcsr_scalar_fill_all (encapsulated) 00360 data_type = dbcsr_get_data_type (matrix%matrix) 00361 CALL cp_assert (data_type .EQ. dbcsr_type_complex_4 .OR.& 00362 data_type .EQ. dbcsr_type_complex_8,& 00363 cp_fatal_level, cp_wrong_args_error, routineN,& 00364 "Can not conform a complex to a real number", error=error) 00365 CALL dbcsr_scalar_set_type (encapsulated, data_type) 00366 END FUNCTION make_conformant_scalar_c 00367 ! ***************************************************************************** 00371 FUNCTION make_conformant_scalar_z (scalar, matrix, error) RESULT (encapsulated) 00372 COMPLEX(kind=real_8), INTENT(IN) :: scalar 00373 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00374 TYPE(cp_error_type), INTENT(INOUT) :: error 00375 TYPE(dbcsr_scalar_type) :: encapsulated 00376 00377 CHARACTER(len=*), PARAMETER :: routineN = 'make_conformant_scalar_z', 00378 routineP = moduleN//':'//routineN 00379 00380 INTEGER :: data_type 00381 00382 encapsulated = dbcsr_scalar (scalar) 00383 CALL dbcsr_scalar_fill_all (encapsulated) 00384 data_type = dbcsr_get_data_type (matrix%matrix) 00385 CALL cp_assert (data_type .EQ. dbcsr_type_complex_4 .OR.& 00386 data_type .EQ. dbcsr_type_complex_8,& 00387 cp_fatal_level, cp_wrong_args_error, routineN,& 00388 "Can not conform a complex to a real number", error=error) 00389 CALL dbcsr_scalar_set_type (encapsulated, data_type) 00390 END FUNCTION make_conformant_scalar_z 00391 00392 00393 ! ***************************************************************************** 00396 SUBROUTINE cp_dbcsr_init_lib (group, error) 00397 INTEGER, INTENT(IN) :: group 00398 TYPE(cp_error_type), INTENT(INOUT) :: error 00399 00400 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_init_lib', 00401 routineP = moduleN//':'//routineN 00402 00403 TYPE(dbcsr_error_type) :: dbcsr_error 00404 00405 CALL dbcsr_init_lib (group, dbcsr_error) 00406 END SUBROUTINE cp_dbcsr_init_lib 00407 00408 ! ***************************************************************************** 00411 SUBROUTINE cp_dbcsr_finalize_lib (error) 00412 TYPE(cp_error_type), INTENT(INOUT) :: error 00413 00414 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_finalize_lib', 00415 routineP = moduleN//':'//routineN 00416 00417 TYPE(dbcsr_error_type) :: dbcsr_error 00418 00419 CALL dbcsr_finalize_lib (dbcsr_error) 00420 END SUBROUTINE cp_dbcsr_finalize_lib 00421 00422 00423 ! ***************************************************************************** 00426 SUBROUTINE cp_dbcsr_config(root_section, error) 00427 TYPE(section_vals_type), POINTER :: root_section 00428 TYPE(cp_error_type), INTENT(INOUT) :: error 00429 00430 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_config', 00431 routineP = moduleN//':'//routineN 00432 00433 INTEGER :: comm_thread_load, 00434 error_handle, mm_driver, 00435 mm_ss, n_stack_buffers 00436 INTEGER, DIMENSION(3) :: nstacks 00437 LOGICAL :: use_combtypes, 00438 use_comm_thread, 00439 use_cuda_mem, use_mpi_mem, 00440 use_subcomms 00441 TYPE(dbcsr_error_type) :: dbcsr_error 00442 TYPE(section_vals_type), POINTER :: dbcsr_section 00443 00444 ! need to call dbcsr_set_conf_external_timing() before dbcsr_error_set() 00445 ! otherwise this would lead to mismatched calls to timeset/timestop 00446 00447 CALL dbcsr_set_conf_external_timing(timeset, timestop, error=dbcsr_error) 00448 00449 CALL dbcsr_error_set (routineN, error_handle, dbcsr_error) 00450 dbcsr_section => section_vals_get_subs_vals(root_section,& 00451 "GLOBAL%DBCSR",error=error) 00452 CALL section_vals_val_get(dbcsr_section,& 00453 "subcommunicators", l_val=use_subcomms, error=error) 00454 CALL section_vals_val_get(dbcsr_section,& 00455 "combined_types", l_val=use_combtypes, error=error) 00456 CALL section_vals_val_get(dbcsr_section,& 00457 "use_mpi_allocation", l_val=use_mpi_mem, error=error) 00458 CALL section_vals_val_get(dbcsr_section,& 00459 "use_cuda_host_allocation", l_val=use_cuda_mem, error=error) 00460 CALL section_vals_val_get(dbcsr_section,& 00461 "mm_stack_size", i_val=mm_ss, error=error) 00462 CALL section_vals_val_get(dbcsr_section,& 00463 "mm_driver", i_val=mm_driver, error=error) 00464 CALL section_vals_val_get(dbcsr_section,& 00465 "n_size_mnk_stacks", i_val=nstacks(1), error=error) 00466 nstacks(2:3) = nstacks(1) 00467 CALL section_vals_val_get(dbcsr_section,& 00468 "n_stack_buffers", i_val=n_stack_buffers, error=error) 00469 CALL section_vals_val_get(dbcsr_section,& 00470 "use_comm_thread", l_val=use_comm_thread, error=error) 00471 CALL section_vals_val_get(dbcsr_section,& 00472 "comm_thread_load", i_val=comm_thread_load, error=error) 00473 CALL dbcsr_set_conf_mm_driver (mm_driver, error=dbcsr_error) 00474 CALL dbcsr_set_conf_subcomm (use_subcomms, error=dbcsr_error) 00475 CALL dbcsr_set_conf_combtypes (use_combtypes, error=dbcsr_error) 00476 CALL dbcsr_set_conf_mpi_mem (use_mpi_mem, error=dbcsr_error) 00477 CALL dbcsr_set_conf_cuda_mem (use_cuda_mem, error=dbcsr_error) 00478 CALL dbcsr_set_conf_mm_stacksize (mm_ss, error=dbcsr_error) 00479 CALL dbcsr_set_conf_nstacks(nstacks, n_stack_buffers, error=dbcsr_error) 00480 CALL dbcsr_set_conf_use_comm_thread(use_comm_thread, error=dbcsr_error) 00481 CALL dbcsr_set_conf_comm_thread_load(comm_thread_load, error=dbcsr_error) 00482 CALL dbcsr_error_stop (error_handle, dbcsr_error) 00483 END SUBROUTINE cp_dbcsr_config 00484 00485 00486 ! ***************************************************************************** 00489 SUBROUTINE cp_dbcsr_print_config(unit_nr, error) 00490 INTEGER, INTENT(IN), OPTIONAL :: unit_nr 00491 TYPE(cp_error_type), INTENT(INOUT) :: error 00492 00493 CHARACTER(len=*), PARAMETER :: o_fmt = '(T2,A,"| ",A,T41,A40)', 00494 plabel = "DBCSR", routineN = 'cp_dbcsr_print_config', 00495 routineP = moduleN//':'//routineN 00496 INTEGER, PARAMETER :: info_len = 40 00497 00498 CHARACTER(len=default_string_length) :: comm_thread_load_str, mm_name, 00499 mm_ss_str, use_combtypes_str, use_comm_thread_str, use_cuda_mem_str, 00500 use_k_stacks, use_m_stacks, use_mpi_mem_str, use_n_stacks, 00501 use_stack_buffers, use_subcomms_str 00502 INTEGER :: comm_thread_load, mm_driver, 00503 mm_ss, nbuffers, unit_num 00504 INTEGER, DIMENSION(3) :: n_mnk_stacks 00505 LOGICAL :: use_combtypes, 00506 use_comm_thread, 00507 use_cuda_mem, use_mpi_mem, 00508 use_subcomms 00509 TYPE(cp_logger_type), POINTER :: logger 00510 TYPE(dbcsr_error_type) :: dbcsr_error 00511 00512 mm_driver = dbcsr_get_conf_mm_driver () 00513 use_subcomms = dbcsr_get_conf_subcomm () 00514 use_combtypes = dbcsr_get_conf_combtypes () 00515 use_mpi_mem = dbcsr_get_conf_mpi_mem () 00516 use_cuda_mem = dbcsr_get_conf_cuda_mem () 00517 mm_ss = dbcsr_get_conf_mm_stacksize () 00518 use_comm_thread = dbcsr_get_conf_use_comm_thread() 00519 comm_thread_load = dbcsr_get_conf_comm_thread_load() 00520 00521 SELECT CASE (mm_driver) 00522 CASE(mm_driver_blas) ; mm_name = mm_name_blas 00523 CASE(mm_driver_matmul) ; mm_name = mm_name_matmul 00524 CASE(mm_driver_smm) ; mm_name = mm_name_smm 00525 CASE(mm_driver_plasma) ; mm_name = mm_name_plasma 00526 CASE(mm_driver_cuda) ; mm_name = mm_name_cuda 00527 END SELECT 00528 00529 mm_name = ADJUSTR(mm_name(1:info_len)) 00530 00531 mm_ss_str = int2str_r(mm_ss,info_len) 00532 use_subcomms_str = l2str_r(use_subcomms,info_len) 00533 use_combtypes_str = l2str_r(use_combtypes,info_len) 00534 use_mpi_mem_str = l2str_r(use_mpi_mem,info_len) 00535 use_cuda_mem_str = l2str_r(use_cuda_mem,info_len) 00536 use_comm_thread_str = l2str_r(use_comm_thread,info_len) 00537 comm_thread_load_str = int2str_r(comm_thread_load,info_len) 00538 00539 CALL dbcsr_get_conf_nstacks (n_mnk_stacks, nbuffers, error=dbcsr_error) 00540 use_stack_buffers = int2str_r (nbuffers, info_len) 00541 use_m_stacks = int2str_r (n_mnk_stacks(1), info_len) 00542 use_n_stacks = int2str_r (n_mnk_stacks(2), info_len) 00543 use_k_stacks = int2str_r (n_mnk_stacks(3), info_len) 00544 00545 logger => cp_error_get_logger(error) 00546 IF (PRESENT (unit_nr)) THEN 00547 unit_num = unit_nr 00548 ELSE 00549 unit_num=cp_logger_get_default_io_unit(logger) 00550 ENDIF 00551 IF (unit_num>0 .AND. cp_logger_would_log(logger, cp_note_level)) THEN 00552 WRITE(UNIT=unit_num, FMT=o_fmt) & 00553 plabel, "Multiplication driver", mm_name(1:info_len),& 00554 plabel, "Multiplication stack size", mm_ss_str(1:info_len) 00555 IF (nbuffers .NE. 1) & 00556 WRITE(UNIT=unit_num, FMT=o_fmt) & 00557 plabel, "Multiplication stack buffers",& 00558 use_stack_buffers(1:info_len) 00559 IF (ALL(n_mnk_stacks .EQ. n_mnk_stacks(1))) THEN 00560 WRITE(UNIT=unit_num, FMT=o_fmt) & 00561 plabel, "Multiplication size stacks",& 00562 use_m_stacks(1:info_len) 00563 ELSE 00564 WRITE(UNIT=unit_num, FMT=o_fmt) & 00565 plabel, "Multiplication size m stacks",& 00566 use_m_stacks(1:info_len) 00567 WRITE(UNIT=unit_num, FMT=o_fmt) & 00568 plabel, "Multiplication size n stacks",& 00569 use_n_stacks(1:info_len) 00570 WRITE(UNIT=unit_num, FMT=o_fmt) & 00571 plabel, "Multiplication size k stacks",& 00572 use_k_stacks(1:info_len) 00573 ENDIF 00574 IF (has_mpi) & 00575 WRITE(UNIT=unit_num, FMT=o_fmt) & 00576 plabel, "Use subcommunicators", use_subcomms_str(1:info_len),& 00577 plabel, "Use MPI combined types" , use_combtypes_str(1:info_len),& 00578 plabel, "Use MPI memory allocation", use_mpi_mem_str(1:info_len),& 00579 plabel, "Use Communication thread", use_comm_thread_str(1:info_len),& 00580 plabel, "Communication thread load", comm_thread_load_str(1:info_len) 00581 IF (has_cuda) & 00582 WRITE(unit_num, FMT=o_fmt) & 00583 plabel, "Use CUDA host-pinned memory", use_cuda_mem_str 00584 ENDIF 00585 00586 END SUBROUTINE cp_dbcsr_print_config 00587 00588 FUNCTION int2str_r(number, str_len) RESULT (string) 00589 INTEGER, INTENT(IN) :: number, str_len 00590 CHARACTER(LEN=str_len) :: string 00591 00592 CALL integer_to_string(number, string) 00593 string = ADJUSTR (string) 00594 END FUNCTION int2str_r 00595 00596 FUNCTION l2str_r(lval, str_len) RESULT (string) 00597 LOGICAL, INTENT(IN) :: lval 00598 INTEGER, INTENT(IN) :: str_len 00599 CHARACTER(LEN=str_len) :: string 00600 00601 WRITE(UNIT=string, FMT='(L1)') lval 00602 string = ADJUSTR (string) 00603 END FUNCTION l2str_r 00604 00605 ! ***************************************************************************** 00611 00612 FUNCTION cp_dbcsr_name (matrix) RESULT (name) 00613 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00614 CHARACTER(len=default_string_length) :: name 00615 00616 name = dbcsr_name (matrix%matrix) 00617 END FUNCTION cp_dbcsr_name 00618 00619 00620 FUNCTION cp_dbcsr_gershgorin_norm(matrix) RESULT (norm) 00621 00622 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00623 REAL(KIND=real_8) :: norm 00624 00625 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_gershgorin_norm', 00626 routineP = moduleN//':'//routineN 00627 00628 INTEGER :: handle 00629 TYPE(cp_error_type) :: error 00630 00631 CALL timeset(routineN,handle) 00632 00633 CALL cp_error_init (error) 00634 norm = dbcsr_gershgorin_norm(matrix%matrix) 00635 00636 CALL timestop(handle) 00637 00638 END FUNCTION cp_dbcsr_gershgorin_norm 00639 00640 FUNCTION cp_dbcsr_frobenius_norm(matrix, local) RESULT (norm) 00641 00642 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00643 LOGICAL, INTENT(in), OPTIONAL :: local 00644 REAL(KIND=real_8) :: norm 00645 00646 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_frobenius_norm', 00647 routineP = moduleN//':'//routineN 00648 00649 INTEGER :: handle 00650 TYPE(cp_error_type) :: error 00651 00652 CALL timeset(routineN,handle) 00653 00654 CALL cp_error_init (error) 00655 norm = dbcsr_frobenius_norm(matrix%matrix, local) 00656 00657 CALL timestop(handle) 00658 END FUNCTION cp_dbcsr_frobenius_norm 00659 00660 FUNCTION cp_dbcsr_maxabs(matrix) RESULT (norm) 00661 00662 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00663 REAL(KIND=real_8) :: norm 00664 00665 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_maxabs', 00666 routineP = moduleN//':'//routineN 00667 00668 INTEGER :: handle 00669 TYPE(cp_error_type) :: error 00670 00671 CALL timeset(routineN,handle) 00672 00673 CALL cp_error_init (error) 00674 norm = dbcsr_maxabs(matrix%matrix) 00675 00676 CALL timestop(handle) 00677 END FUNCTION cp_dbcsr_maxabs 00678 00679 00680 00681 SUBROUTINE cp_dbcsr_complete_redistribute(matrix, redist, keep_sparsity, error) 00682 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00683 TYPE(cp_dbcsr_type), INTENT(INOUT) :: redist 00684 LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity 00685 TYPE(cp_error_type), INTENT(inout) :: error 00686 00687 CHARACTER(len=*), PARAMETER :: 00688 routineN = 'cp_dbcsr_complete_redistribute', 00689 routineP = moduleN//':'//routineN 00690 00691 INTEGER :: handle 00692 TYPE(dbcsr_error_type) :: dbcsr_error 00693 00694 CALL timeset(routineN,handle) 00695 00696 CALL dbcsr_complete_redistribute(matrix%matrix, redist%matrix, keep_sparsity, dbcsr_error) 00697 00698 CALL timestop(handle) 00699 00700 END SUBROUTINE cp_dbcsr_complete_redistribute 00701 00702 SUBROUTINE cp_dbcsr_reserve_block2d_d(matrix, row, col, block,& 00703 transposed, existed) 00704 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00705 INTEGER, INTENT(IN) :: row, col 00706 REAL(kind=real_8), DIMENSION(:, :), 00707 POINTER :: block 00708 LOGICAL, INTENT(IN), OPTIONAL :: transposed 00709 LOGICAL, INTENT(OUT), OPTIONAL :: existed 00710 00711 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_reserve_block2d_d', 00712 routineP = moduleN//':'//routineN 00713 00714 TYPE(cp_error_type) :: error 00715 00716 CALL cp_error_init (error) 00717 CALL dbcsr_reserve_block2d(matrix%matrix, row, col, block,& 00718 transposed, existed) 00719 00720 END SUBROUTINE cp_dbcsr_reserve_block2d_d 00721 00722 SUBROUTINE cp_dbcsr_reserve_block2d_s(matrix, row, col, block,& 00723 transposed, existed) 00724 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00725 INTEGER, INTENT(IN) :: row, col 00726 REAL(kind=real_4), DIMENSION(:, :), 00727 POINTER :: block 00728 LOGICAL, INTENT(IN), OPTIONAL :: transposed 00729 LOGICAL, INTENT(OUT), OPTIONAL :: existed 00730 00731 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_reserve_block2d_s', 00732 routineP = moduleN//':'//routineN 00733 00734 TYPE(cp_error_type) :: error 00735 00736 CALL cp_error_init (error) 00737 CALL dbcsr_reserve_block2d(matrix%matrix, row, col, block,& 00738 transposed, existed) 00739 00740 END SUBROUTINE cp_dbcsr_reserve_block2d_s 00741 00742 SUBROUTINE cp_dbcsr_reserve_block2d_z(matrix, row, col, block,& 00743 transposed, existed) 00744 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00745 INTEGER, INTENT(IN) :: row, col 00746 COMPLEX(kind=real_8), DIMENSION(:, :), 00747 POINTER :: block 00748 LOGICAL, INTENT(IN), OPTIONAL :: transposed 00749 LOGICAL, INTENT(OUT), OPTIONAL :: existed 00750 00751 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_reserve_block2d_z', 00752 routineP = moduleN//':'//routineN 00753 00754 TYPE(cp_error_type) :: error 00755 00756 CALL cp_error_init (error) 00757 CALL dbcsr_reserve_block2d(matrix%matrix, row, col, block,& 00758 transposed, existed) 00759 00760 END SUBROUTINE cp_dbcsr_reserve_block2d_z 00761 00762 SUBROUTINE cp_dbcsr_reserve_block2d_c(matrix, row, col, block,& 00763 transposed, existed) 00764 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00765 INTEGER, INTENT(IN) :: row, col 00766 COMPLEX(kind=real_4), DIMENSION(:, :), 00767 POINTER :: block 00768 LOGICAL, INTENT(IN), OPTIONAL :: transposed 00769 LOGICAL, INTENT(OUT), OPTIONAL :: existed 00770 00771 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_reserve_block2d_c', 00772 routineP = moduleN//':'//routineN 00773 00774 TYPE(cp_error_type) :: error 00775 00776 CALL cp_error_init (error) 00777 CALL dbcsr_reserve_block2d(matrix%matrix, row, col, block,& 00778 transposed, existed) 00779 00780 END SUBROUTINE cp_dbcsr_reserve_block2d_c 00781 00782 SUBROUTINE cp_dbcsr_reserve_blocks(matrix, rows, cols, blk_pointers, error) 00783 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 00784 INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols 00785 INTEGER, DIMENSION(:), INTENT(IN), 00786 OPTIONAL :: blk_pointers 00787 TYPE(cp_error_type) :: error 00788 00789 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_reserve_blocks', 00790 routineP = moduleN//':'//routineN 00791 00792 TYPE(dbcsr_error_type) :: dbcsr_error 00793 00794 CALL dbcsr_reserve_blocks(matrix%matrix, rows, cols, blk_pointers,& 00795 dbcsr_error) 00796 END SUBROUTINE cp_dbcsr_reserve_blocks 00797 00798 00799 PURE FUNCTION cp_dbcsr_get_data_type (matrix) RESULT (data_type) 00800 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00801 INTEGER :: data_type 00802 00803 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_data_type', 00804 routineP = moduleN//':'//routineN 00805 00806 data_type = dbcsr_get_data_type (matrix%matrix) 00807 00808 END FUNCTION cp_dbcsr_get_data_type 00809 00810 PURE FUNCTION cp_dbcsr_valid_index (matrix) RESULT (valid_index) 00811 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00812 LOGICAL :: valid_index 00813 00814 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_valid_index', 00815 routineP = moduleN//':'//routineN 00816 00817 valid_index = dbcsr_valid_index(matrix%matrix) 00818 00819 END FUNCTION cp_dbcsr_valid_index 00820 00821 SUBROUTINE cp_dbcsr_get_stored_coordinates(matrix, row, column, transpose, processor) 00822 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00823 INTEGER, INTENT(INOUT) :: row, column 00824 LOGICAL, INTENT(INOUT) :: transpose 00825 INTEGER, INTENT(OUT), OPTIONAL :: processor 00826 00827 CHARACTER(len=*), PARAMETER :: 00828 routineN = 'cp_dbcsr_get_stored_coordinates', 00829 routineP = moduleN//':'//routineN 00830 00831 CALL dbcsr_get_stored_coordinates(matrix%matrix, row, column, transpose, processor) 00832 00833 END SUBROUTINE cp_dbcsr_get_stored_coordinates 00834 00835 PURE FUNCTION cp_dbcsr_get_num_blocks (matrix) RESULT (num_blocks) 00836 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00837 INTEGER :: num_blocks 00838 00839 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_num_blocks', 00840 routineP = moduleN//':'//routineN 00841 00842 num_blocks = dbcsr_get_num_blocks (matrix%matrix) 00843 00844 END FUNCTION cp_dbcsr_get_num_blocks 00845 00846 FUNCTION cp_dbcsr_get_data_size (matrix) RESULT (data_size) 00847 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00848 INTEGER :: data_size 00849 00850 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_data_size', 00851 routineP = moduleN//':'//routineN 00852 00853 INTEGER :: handle 00854 00855 CALL timeset(routineN,handle) 00856 00857 data_size = dbcsr_get_data_size(matrix%matrix) 00858 00859 CALL timestop(handle) 00860 00861 END FUNCTION cp_dbcsr_get_data_size 00862 00863 PURE FUNCTION cp_dbcsr_get_matrix_type (matrix) RESULT (matrix_type) 00864 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00865 CHARACTER :: matrix_type 00866 00867 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_matrix_type', 00868 routineP = moduleN//':'//routineN 00869 00870 matrix_type = dbcsr_get_matrix_type (matrix%matrix) 00871 00872 END FUNCTION cp_dbcsr_get_matrix_type 00873 00874 FUNCTION cp_dbcsr_get_occupation (matrix) RESULT (occupation) 00875 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00876 REAL(KIND=real_8) :: occupation 00877 00878 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_occupation', 00879 routineP = moduleN//':'//routineN 00880 00881 INTEGER :: handle 00882 00883 CALL timeset(routineN,handle) 00884 00885 occupation = dbcsr_get_occupation (matrix%matrix) 00886 00887 CALL timestop(handle) 00888 00889 END FUNCTION cp_dbcsr_get_occupation 00890 00891 00892 FUNCTION cp_dbcsr_nblkrows_total(matrix) RESULT (nblkrows_total) 00893 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00894 INTEGER :: nblkrows_total 00895 00896 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nblkrows_total', 00897 routineP = moduleN//':'//routineN 00898 00899 INTEGER :: handle 00900 00901 CALL timeset(routineN,handle) 00902 00903 nblkrows_total = dbcsr_nblkrows_total(matrix%matrix) 00904 00905 CALL timestop(handle) 00906 END FUNCTION cp_dbcsr_nblkrows_total 00907 00908 FUNCTION cp_dbcsr_nblkcols_total(matrix) RESULT (nblkcols_total) 00909 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00910 INTEGER :: nblkcols_total 00911 00912 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nblkcols_total', 00913 routineP = moduleN//':'//routineN 00914 00915 INTEGER :: handle 00916 00917 CALL timeset(routineN,handle) 00918 00919 nblkcols_total = dbcsr_nblkcols_total(matrix%matrix) 00920 CALL timestop(handle) 00921 END FUNCTION cp_dbcsr_nblkcols_total 00922 00923 FUNCTION cp_dbcsr_nfullrows_total(matrix) RESULT (nfullrows_total) 00924 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00925 INTEGER :: nfullrows_total 00926 00927 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nfullrows_total', 00928 routineP = moduleN//':'//routineN 00929 00930 INTEGER :: handle 00931 00932 CALL timeset(routineN,handle) 00933 00934 nfullrows_total = dbcsr_nfullrows_total(matrix%matrix) 00935 00936 CALL timestop(handle) 00937 END FUNCTION cp_dbcsr_nfullrows_total 00938 00939 FUNCTION cp_dbcsr_nfullcols_total(matrix) RESULT (nfullcols_total) 00940 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00941 INTEGER :: nfullcols_total 00942 00943 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nfullcols_total', 00944 routineP = moduleN//':'//routineN 00945 00946 INTEGER :: handle 00947 00948 CALL timeset(routineN,handle) 00949 00950 nfullcols_total = dbcsr_nfullcols_total(matrix%matrix) 00951 CALL timestop(handle) 00952 END FUNCTION cp_dbcsr_nfullcols_total 00953 00954 FUNCTION cp_dbcsr_nblkrows_local(matrix) RESULT (nblkrows_local) 00955 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00956 INTEGER :: nblkrows_local 00957 00958 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nblkrows_local', 00959 routineP = moduleN//':'//routineN 00960 00961 INTEGER :: handle 00962 00963 CALL timeset(routineN,handle) 00964 nblkrows_local = dbcsr_nblkrows_local(matrix%matrix) 00965 CALL timestop(handle) 00966 END FUNCTION cp_dbcsr_nblkrows_local 00967 00968 FUNCTION cp_dbcsr_nblkcols_local(matrix) RESULT (nblkcols_local) 00969 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00970 INTEGER :: nblkcols_local 00971 00972 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nblkcols_local', 00973 routineP = moduleN//':'//routineN 00974 00975 INTEGER :: handle 00976 00977 CALL timeset(routineN,handle) 00978 nblkcols_local = dbcsr_nblkcols_local(matrix%matrix) 00979 CALL timestop(handle) 00980 END FUNCTION cp_dbcsr_nblkcols_local 00981 00982 FUNCTION cp_dbcsr_nfullrows_local(matrix) RESULT (nfullrows_local) 00983 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 00984 INTEGER :: nfullrows_local 00985 00986 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nfullrows_local', 00987 routineP = moduleN//':'//routineN 00988 00989 INTEGER :: handle 00990 00991 CALL timeset(routineN,handle) 00992 nfullrows_local = dbcsr_nfullrows_local(matrix%matrix) 00993 00994 CALL timestop(handle) 00995 00996 END FUNCTION cp_dbcsr_nfullrows_local 00997 00998 FUNCTION cp_dbcsr_nfullcols_local(matrix) RESULT (nfullcols_local) 00999 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01000 INTEGER :: nfullcols_local 01001 01002 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_nfullcols_local', 01003 routineP = moduleN//':'//routineN 01004 01005 INTEGER :: handle 01006 01007 CALL timeset(routineN,handle) 01008 01009 nfullcols_local = dbcsr_nfullcols_local(matrix%matrix) 01010 01011 CALL timestop(handle) 01012 01013 END FUNCTION cp_dbcsr_nfullcols_local 01014 01015 FUNCTION cp_dbcsr_max_row_size(matrix) RESULT (max_row_size) 01016 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01017 INTEGER :: max_row_size 01018 01019 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_max_row_size', 01020 routineP = moduleN//':'//routineN 01021 01022 INTEGER :: handle 01023 01024 CALL timeset(routineN,handle) 01025 max_row_size = dbcsr_max_row_size(matrix%matrix) 01026 01027 CALL timestop(handle) 01028 END FUNCTION cp_dbcsr_max_row_size 01029 01030 FUNCTION cp_dbcsr_max_col_size(matrix) RESULT (max_col_size) 01031 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01032 INTEGER :: max_col_size 01033 01034 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_max_col_size', 01035 routineP = moduleN//':'//routineN 01036 01037 INTEGER :: handle 01038 01039 CALL timeset(routineN,handle) 01040 max_col_size = dbcsr_max_col_size(matrix%matrix) 01041 CALL timestop(handle) 01042 01043 END FUNCTION cp_dbcsr_max_col_size 01044 01045 FUNCTION cp_dbcsr_distribution (matrix) RESULT (distribution) 01046 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01047 TYPE(dbcsr_distribution_obj) :: distribution 01048 01049 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_distribution', 01050 routineP = moduleN//':'//routineN 01051 01052 INTEGER :: handle 01053 01054 CALL timeset(routineN,handle) 01055 distribution = dbcsr_distribution (matrix%matrix) 01056 CALL timestop(handle) 01057 01058 END FUNCTION cp_dbcsr_distribution 01059 01060 SUBROUTINE cp_create_bl_distribution (block_distribution,& 01061 block_size, nelements, nbins) 01062 TYPE(array_i1d_obj), INTENT(OUT) :: block_distribution, block_size 01063 INTEGER, INTENT(IN) :: nelements, nbins 01064 01065 CHARACTER(len=*), PARAMETER :: routineN = 'cp_create_bl_distribution', 01066 routineP = moduleN//':'//routineN 01067 01068 INTEGER :: handle 01069 01070 CALL timeset(routineN,handle) 01071 CALL create_bl_distribution (block_distribution,& 01072 block_size, nelements, nbins) 01073 01074 CALL timestop(handle) 01075 01076 END SUBROUTINE cp_create_bl_distribution 01077 01078 SUBROUTINE cp_dbcsr_distribution_release(dist) 01079 TYPE(dbcsr_distribution_obj), 01080 INTENT(INOUT) :: dist 01081 01082 CHARACTER(len=*), PARAMETER :: 01083 routineN = 'cp_dbcsr_distribution_release', 01084 routineP = moduleN//':'//routineN 01085 01086 INTEGER :: handle 01087 01088 CALL timeset(routineN,handle) 01089 CALL dbcsr_distribution_release(dist) 01090 CALL timestop(handle) 01091 01092 END SUBROUTINE cp_dbcsr_distribution_release 01093 01094 PURE FUNCTION cp_dbcsr_iterator_blocks_left (iterator) RESULT (blocks_left) 01095 TYPE(cp_dbcsr_iterator), INTENT(IN) :: iterator 01096 LOGICAL :: blocks_left 01097 01098 CHARACTER(len=*), PARAMETER :: 01099 routineN = 'cp_dbcsr_iterator_blocks_left', 01100 routineP = moduleN//':'//routineN 01101 01102 blocks_left = dbcsr_iterator_blocks_left (iterator) 01103 01104 END FUNCTION cp_dbcsr_iterator_blocks_left 01105 01106 SUBROUTINE cp_dbcsr_mp_release(mp_env) 01107 TYPE(dbcsr_mp_obj), INTENT(INOUT) :: mp_env 01108 01109 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_mp_release', 01110 routineP = moduleN//':'//routineN 01111 01112 INTEGER :: handle 01113 01114 CALL timeset(routineN,handle) 01115 CALL dbcsr_mp_release(mp_env) 01116 CALL timestop(handle) 01117 01118 END SUBROUTINE cp_dbcsr_mp_release 01119 01120 SUBROUTINE cp_dbcsr_mp_new(mp_env, pgrid, mp_group, mynode, numnodes, myprow,& 01121 mypcol) 01122 TYPE(dbcsr_mp_obj), INTENT(OUT) :: mp_env 01123 INTEGER, DIMENSION(0:, 0:), INTENT(IN) :: pgrid 01124 INTEGER, INTENT(IN) :: mp_group, mynode 01125 INTEGER, INTENT(IN), OPTIONAL :: numnodes, myprow, mypcol 01126 01127 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_mp_new', 01128 routineP = moduleN//':'//routineN 01129 01130 INTEGER :: handle 01131 01132 CALL timeset(routineN,handle) 01133 CALL dbcsr_mp_new(mp_env, pgrid, mp_group, mynode, numnodes, myprow,& 01134 mypcol) 01135 01136 CALL timestop(handle) 01137 01138 END SUBROUTINE cp_dbcsr_mp_new 01139 01140 SUBROUTINE cp_iterator_next_block_index (iterator, row, column, blk,& 01141 blk_p, row_size, col_size, row_offset, col_offset) 01142 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01143 INTEGER, INTENT(OUT) :: row, column, blk 01144 INTEGER, INTENT(OUT), OPTIONAL :: blk_p, row_size, col_size, 01145 row_offset, col_offset 01146 01147 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_block_index', 01148 routineP = moduleN//':'//routineN 01149 01150 LOGICAL :: transposed 01151 01152 CALL dbcsr_iterator_next_block (iterator, row, column, blk,& 01153 transposed, blk_p, row_size, col_size, row_offset, col_offset) 01154 01155 END SUBROUTINE cp_iterator_next_block_index 01156 01157 SUBROUTINE cp_iterator_next_2d_block_d (iterator, row, column,& 01158 block,& 01159 block_number, row_size, col_size, row_offset, col_offset) 01160 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01161 INTEGER, INTENT(OUT) :: row, column 01162 REAL(kind=real_8), DIMENSION(:, :), 01163 POINTER :: block 01164 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01165 col_size, row_offset, 01166 col_offset 01167 01168 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_2d_block_d', 01169 routineP = moduleN//':'//routineN 01170 01171 LOGICAL :: transposed 01172 01173 CALL dbcsr_iterator_next_block (iterator, row, column,& 01174 block, transposed,& 01175 block_number, row_size, col_size, row_offset, col_offset) 01176 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01177 routineN, "CP2K does not handle transposed blocks.") 01178 01179 END SUBROUTINE cp_iterator_next_2d_block_d 01180 01181 SUBROUTINE cp_iterator_next_1d_block_d (iterator, row, column, block,& 01182 block_number, row_size, col_size, row_offset, col_offset) 01183 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01184 INTEGER, INTENT(OUT) :: row, column 01185 REAL(kind=real_8), DIMENSION(:), POINTER :: block 01186 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01187 col_size, row_offset, 01188 col_offset 01189 01190 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_1d_block_d', 01191 routineP = moduleN//':'//routineN 01192 01193 LOGICAL :: transposed 01194 01195 CALL dbcsr_iterator_next_block (iterator, row, column, block,& 01196 transposed, block_number, row_size, col_size, row_offset, col_offset) 01197 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01198 routineN, "CP2K does not handle transposed blocks.") 01199 01200 END SUBROUTINE cp_iterator_next_1d_block_d 01201 01202 SUBROUTINE cp_iterator_next_2d_block_s (iterator, row, column,& 01203 block,& 01204 block_number, row_size, col_size, row_offset, col_offset) 01205 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01206 INTEGER, INTENT(OUT) :: row, column 01207 REAL(kind=real_4), DIMENSION(:, :), 01208 POINTER :: block 01209 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01210 col_size, row_offset, 01211 col_offset 01212 01213 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_2d_block_s', 01214 routineP = moduleN//':'//routineN 01215 01216 LOGICAL :: transposed 01217 01218 CALL dbcsr_iterator_next_block (iterator, row, column,& 01219 block, transposed,& 01220 block_number, row_size, col_size, row_offset, col_offset) 01221 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01222 routineN, "CP2K does not handle transposed blocks.") 01223 01224 END SUBROUTINE cp_iterator_next_2d_block_s 01225 01226 SUBROUTINE cp_iterator_next_1d_block_s (iterator, row, column, block,& 01227 block_number, row_size, col_size, row_offset, col_offset) 01228 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01229 INTEGER, INTENT(OUT) :: row, column 01230 REAL(kind=real_4), DIMENSION(:), POINTER :: block 01231 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01232 col_size, row_offset, 01233 col_offset 01234 01235 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_1d_block_s', 01236 routineP = moduleN//':'//routineN 01237 01238 LOGICAL :: transposed 01239 01240 CALL dbcsr_iterator_next_block (iterator, row, column, block,& 01241 transposed, block_number, row_size, col_size, row_offset, col_offset) 01242 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01243 routineN, "CP2K does not handle transposed blocks.") 01244 01245 END SUBROUTINE cp_iterator_next_1d_block_s 01246 01247 SUBROUTINE cp_iterator_next_2d_block_z (iterator, row, column,& 01248 block,& 01249 block_number, row_size, col_size, row_offset, col_offset) 01250 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01251 INTEGER, INTENT(OUT) :: row, column 01252 COMPLEX(kind=real_8), DIMENSION(:, :), 01253 POINTER :: block 01254 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01255 col_size, row_offset, 01256 col_offset 01257 01258 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_2d_block_z', 01259 routineP = moduleN//':'//routineN 01260 01261 LOGICAL :: transposed 01262 01263 CALL dbcsr_iterator_next_block (iterator, row, column,& 01264 block, transposed,& 01265 block_number, row_size, col_size, row_offset, col_offset) 01266 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01267 routineN, "CP2K does not handle transposed blocks.") 01268 01269 END SUBROUTINE cp_iterator_next_2d_block_z 01270 01271 SUBROUTINE cp_iterator_next_1d_block_z (iterator, row, column, block,& 01272 block_number, row_size, col_size, row_offset, col_offset) 01273 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01274 INTEGER, INTENT(OUT) :: row, column 01275 COMPLEX(kind=real_8), DIMENSION(:), 01276 POINTER :: block 01277 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01278 col_size, row_offset, 01279 col_offset 01280 01281 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_1d_block_z', 01282 routineP = moduleN//':'//routineN 01283 01284 LOGICAL :: transposed 01285 01286 CALL dbcsr_iterator_next_block (iterator, row, column, block,& 01287 transposed, block_number, row_size, col_size, row_offset, col_offset) 01288 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01289 routineN, "CP2K does not handle transposed blocks.") 01290 01291 END SUBROUTINE cp_iterator_next_1d_block_z 01292 01293 SUBROUTINE cp_iterator_next_2d_block_c (iterator, row, column,& 01294 block,& 01295 block_number, row_size, col_size, row_offset, col_offset) 01296 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01297 INTEGER, INTENT(OUT) :: row, column 01298 COMPLEX(kind=real_4), DIMENSION(:, :), 01299 POINTER :: block 01300 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01301 col_size, row_offset, 01302 col_offset 01303 01304 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_2d_block_c', 01305 routineP = moduleN//':'//routineN 01306 01307 LOGICAL :: transposed 01308 01309 CALL dbcsr_iterator_next_block (iterator, row, column,& 01310 block, transposed,& 01311 block_number, row_size, col_size, row_offset, col_offset) 01312 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01313 routineN, "CP2K does not handle transposed blocks.") 01314 01315 END SUBROUTINE cp_iterator_next_2d_block_c 01316 01317 SUBROUTINE cp_iterator_next_1d_block_c (iterator, row, column, block,& 01318 block_number, row_size, col_size, row_offset, col_offset) 01319 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01320 INTEGER, INTENT(OUT) :: row, column 01321 COMPLEX(kind=real_4), DIMENSION(:), 01322 POINTER :: block 01323 INTEGER, INTENT(OUT), OPTIONAL :: block_number, row_size, 01324 col_size, row_offset, 01325 col_offset 01326 01327 CHARACTER(len=*), PARAMETER :: routineN = 'cp_iterator_next_1d_block_c', 01328 routineP = moduleN//':'//routineN 01329 01330 LOGICAL :: transposed 01331 01332 CALL dbcsr_iterator_next_block (iterator, row, column, block,& 01333 transposed, block_number, row_size, col_size, row_offset, col_offset) 01334 CALL cp_assert(.NOT. transposed, cp_fatal_level, cp_internal_error,& 01335 routineN, "CP2K does not handle transposed blocks.") 01336 01337 END SUBROUTINE cp_iterator_next_1d_block_c 01338 01339 SUBROUTINE cp_dbcsr_iterator_stop (iterator) 01340 TYPE(cp_dbcsr_iterator), INTENT(INOUT) :: iterator 01341 01342 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_iterator_stop', 01343 routineP = moduleN//':'//routineN 01344 01345 INTEGER :: handle 01346 01347 CALL timeset(routineN,handle) 01348 CALL dbcsr_iterator_stop (iterator) 01349 CALL timestop(handle) 01350 01351 END SUBROUTINE cp_dbcsr_iterator_stop 01352 01353 SUBROUTINE cp_dbcsr_iterator_start (iterator, matrix, shared, dynamic,& 01354 dynamic_byrows, contiguous_pointers, read_only) 01355 TYPE(cp_dbcsr_iterator), INTENT(OUT) :: iterator 01356 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01357 LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, 01358 dynamic_byrows, 01359 contiguous_pointers, read_only 01360 01361 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_iterator_start', 01362 routineP = moduleN//':'//routineN 01363 01364 INTEGER :: handle 01365 TYPE(cp_error_type) :: error 01366 01367 CALL timeset(routineN,handle) 01368 CALL cp_error_init (error) 01369 CALL dbcsr_iterator_start (iterator, matrix%matrix, shared, dynamic,& 01370 dynamic_byrows, contiguous_pointers, read_only) 01371 CALL timestop(handle) 01372 01373 END SUBROUTINE cp_dbcsr_iterator_start 01374 01375 SUBROUTINE cp_dbcsr_put_block2d_d(matrix, row, col, block,& 01376 summation, scale) 01377 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01378 INTEGER, INTENT(IN) :: row, col 01379 REAL(kind=real_8), DIMENSION(:, :), 01380 INTENT(IN) :: block 01381 LOGICAL, INTENT(IN), OPTIONAL :: summation 01382 REAL(kind=real_8), INTENT(IN), OPTIONAL :: scale 01383 01384 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block2d_d', 01385 routineP = moduleN//':'//routineN 01386 01387 TYPE(cp_error_type) :: error 01388 01389 CALL cp_error_init (error) 01390 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01391 summation=summation, scale=scale) 01392 01393 END SUBROUTINE cp_dbcsr_put_block2d_d 01394 01395 SUBROUTINE cp_dbcsr_put_block2d_s(matrix, row, col, block,& 01396 summation, scale) 01397 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01398 INTEGER, INTENT(IN) :: row, col 01399 REAL(kind=real_4), DIMENSION(:, :), 01400 INTENT(IN) :: block 01401 LOGICAL, INTENT(IN), OPTIONAL :: summation 01402 REAL(kind=real_4), INTENT(IN), OPTIONAL :: scale 01403 01404 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block2d_s', 01405 routineP = moduleN//':'//routineN 01406 01407 TYPE(cp_error_type) :: error 01408 01409 CALL cp_error_init (error) 01410 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01411 summation=summation, scale=scale) 01412 01413 END SUBROUTINE cp_dbcsr_put_block2d_s 01414 01415 SUBROUTINE cp_dbcsr_put_block2d_z(matrix, row, col, block,& 01416 summation, scale) 01417 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01418 INTEGER, INTENT(IN) :: row, col 01419 COMPLEX(kind=real_8), DIMENSION(:, :), 01420 INTENT(IN) :: block 01421 LOGICAL, INTENT(IN), OPTIONAL :: summation 01422 COMPLEX(kind=real_8), INTENT(IN), 01423 OPTIONAL :: scale 01424 01425 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block2d_z', 01426 routineP = moduleN//':'//routineN 01427 01428 TYPE(cp_error_type) :: error 01429 01430 CALL cp_error_init (error) 01431 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01432 summation=summation, scale=scale) 01433 01434 END SUBROUTINE cp_dbcsr_put_block2d_z 01435 01436 SUBROUTINE cp_dbcsr_put_block2d_c(matrix, row, col, block,& 01437 summation, scale) 01438 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01439 INTEGER, INTENT(IN) :: row, col 01440 COMPLEX(kind=real_4), DIMENSION(:, :), 01441 INTENT(IN) :: block 01442 LOGICAL, INTENT(IN), OPTIONAL :: summation 01443 COMPLEX(kind=real_4), INTENT(IN), 01444 OPTIONAL :: scale 01445 01446 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block2d_c', 01447 routineP = moduleN//':'//routineN 01448 01449 TYPE(cp_error_type) :: error 01450 01451 CALL cp_error_init (error) 01452 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01453 summation=summation, scale=scale) 01454 01455 END SUBROUTINE cp_dbcsr_put_block2d_c 01456 01457 SUBROUTINE cp_dbcsr_put_block_d(matrix, row, col, block,& 01458 summation, scale) 01459 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01460 INTEGER, INTENT(IN) :: row, col 01461 REAL(kind=real_8), DIMENSION(:), 01462 INTENT(IN) :: block 01463 LOGICAL, INTENT(IN), OPTIONAL :: summation 01464 REAL(kind=real_8), INTENT(IN), OPTIONAL :: scale 01465 01466 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block_d', 01467 routineP = moduleN//':'//routineN 01468 01469 TYPE(cp_error_type) :: error 01470 01471 CALL cp_error_init (error) 01472 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01473 summation=summation, scale=scale) 01474 01475 END SUBROUTINE cp_dbcsr_put_block_d 01476 01477 SUBROUTINE cp_dbcsr_put_block_s(matrix, row, col, block,& 01478 summation, scale) 01479 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01480 INTEGER, INTENT(IN) :: row, col 01481 REAL(kind=real_4), DIMENSION(:), 01482 INTENT(IN) :: block 01483 LOGICAL, INTENT(IN), OPTIONAL :: summation 01484 REAL(kind=real_4), INTENT(IN), OPTIONAL :: scale 01485 01486 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block_s', 01487 routineP = moduleN//':'//routineN 01488 01489 TYPE(cp_error_type) :: error 01490 01491 CALL cp_error_init (error) 01492 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01493 summation=summation, scale=scale) 01494 01495 END SUBROUTINE cp_dbcsr_put_block_s 01496 01497 SUBROUTINE cp_dbcsr_put_block_z(matrix, row, col, block,& 01498 summation, scale) 01499 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01500 INTEGER, INTENT(IN) :: row, col 01501 COMPLEX(kind=real_8), DIMENSION(:), 01502 INTENT(IN) :: block 01503 LOGICAL, INTENT(IN), OPTIONAL :: summation 01504 COMPLEX(kind=real_8), INTENT(IN), 01505 OPTIONAL :: scale 01506 01507 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block_z', 01508 routineP = moduleN//':'//routineN 01509 01510 TYPE(cp_error_type) :: error 01511 01512 CALL cp_error_init (error) 01513 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01514 summation=summation, scale=scale) 01515 01516 END SUBROUTINE cp_dbcsr_put_block_z 01517 01518 SUBROUTINE cp_dbcsr_put_block_c(matrix, row, col, block,& 01519 summation, scale) 01520 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01521 INTEGER, INTENT(IN) :: row, col 01522 COMPLEX(kind=real_4), DIMENSION(:), 01523 INTENT(IN) :: block 01524 LOGICAL, INTENT(IN), OPTIONAL :: summation 01525 COMPLEX(kind=real_4), INTENT(IN), 01526 OPTIONAL :: scale 01527 01528 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_put_block_c', 01529 routineP = moduleN//':'//routineN 01530 01531 TYPE(cp_error_type) :: error 01532 01533 CALL cp_error_init (error) 01534 CALL dbcsr_put_block(matrix%matrix, row, col, block,& 01535 summation=summation, scale=scale) 01536 01537 END SUBROUTINE cp_dbcsr_put_block_c 01538 01539 SUBROUTINE cp_dbcsr_get_block_d(matrix,row,col,block,found,& 01540 row_size, col_size) 01541 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01542 INTEGER, INTENT(IN) :: row, col 01543 REAL(kind=real_8), DIMENSION(:), 01544 INTENT(OUT) :: block 01545 LOGICAL, INTENT(OUT) :: found 01546 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01547 01548 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_d', 01549 routineP = moduleN//':'//routineN 01550 01551 LOGICAL :: tr 01552 TYPE(cp_error_type) :: error 01553 01554 CALL cp_error_init (error) 01555 tr=.FALSE. 01556 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01557 row_size, col_size) 01558 01559 END SUBROUTINE cp_dbcsr_get_block_d 01560 01561 SUBROUTINE cp_dbcsr_get_block_s(matrix,row,col,block,found,& 01562 row_size, col_size) 01563 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01564 INTEGER, INTENT(IN) :: row, col 01565 REAL(kind=real_4), DIMENSION(:), 01566 INTENT(OUT) :: block 01567 LOGICAL, INTENT(OUT) :: found 01568 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01569 01570 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_s', 01571 routineP = moduleN//':'//routineN 01572 01573 LOGICAL :: tr 01574 TYPE(cp_error_type) :: error 01575 01576 CALL cp_error_init (error) 01577 tr=.FALSE. 01578 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01579 row_size, col_size) 01580 01581 END SUBROUTINE cp_dbcsr_get_block_s 01582 01583 SUBROUTINE cp_dbcsr_get_block_c(matrix,row,col,block,found,& 01584 row_size, col_size) 01585 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01586 INTEGER, INTENT(IN) :: row, col 01587 COMPLEX(kind=real_4), DIMENSION(:), 01588 INTENT(OUT) :: block 01589 LOGICAL, INTENT(OUT) :: found 01590 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01591 01592 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_c', 01593 routineP = moduleN//':'//routineN 01594 01595 LOGICAL :: tr 01596 TYPE(cp_error_type) :: error 01597 01598 CALL cp_error_init (error) 01599 tr=.FALSE. 01600 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01601 row_size, col_size) 01602 01603 END SUBROUTINE cp_dbcsr_get_block_c 01604 01605 SUBROUTINE cp_dbcsr_get_block_z(matrix,row,col,block,found,& 01606 row_size, col_size) 01607 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01608 INTEGER, INTENT(IN) :: row, col 01609 COMPLEX(kind=real_8), DIMENSION(:), 01610 INTENT(OUT) :: block 01611 LOGICAL, INTENT(OUT) :: found 01612 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01613 01614 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_z', 01615 routineP = moduleN//':'//routineN 01616 01617 LOGICAL :: tr 01618 TYPE(cp_error_type) :: error 01619 01620 CALL cp_error_init (error) 01621 tr=.FALSE. 01622 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01623 row_size, col_size) 01624 01625 END SUBROUTINE cp_dbcsr_get_block_z 01626 01627 SUBROUTINE cp_dbcsr_get_2d_block_d(matrix,row,col,block,found,& 01628 row_size, col_size) 01629 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01630 INTEGER, INTENT(IN) :: row, col 01631 REAL(kind=real_8), DIMENSION(:, :), 01632 INTENT(OUT) :: block 01633 LOGICAL, INTENT(OUT) :: found 01634 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01635 01636 LOGICAL :: tr 01637 TYPE(cp_error_type) :: error 01638 01639 CALL cp_error_init (error) 01640 tr=.FALSE. 01641 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01642 row_size, col_size) 01643 01644 END SUBROUTINE cp_dbcsr_get_2d_block_d 01645 01646 SUBROUTINE cp_dbcsr_get_2d_block_s(matrix,row,col,block,found,& 01647 row_size, col_size) 01648 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01649 INTEGER, INTENT(IN) :: row, col 01650 REAL(kind=real_4), DIMENSION(:, :), 01651 INTENT(OUT) :: block 01652 LOGICAL, INTENT(OUT) :: found 01653 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01654 01655 LOGICAL :: tr 01656 TYPE(cp_error_type) :: error 01657 01658 CALL cp_error_init (error) 01659 tr=.FALSE. 01660 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01661 row_size, col_size) 01662 01663 END SUBROUTINE cp_dbcsr_get_2d_block_s 01664 01665 SUBROUTINE cp_dbcsr_get_2d_block_c(matrix,row,col,block,found,& 01666 row_size, col_size) 01667 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01668 INTEGER, INTENT(IN) :: row, col 01669 COMPLEX(kind=real_4), DIMENSION(:, :), 01670 INTENT(OUT) :: block 01671 LOGICAL, INTENT(OUT) :: found 01672 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01673 01674 LOGICAL :: tr 01675 TYPE(cp_error_type) :: error 01676 01677 CALL cp_error_init (error) 01678 tr=.FALSE. 01679 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01680 row_size, col_size) 01681 01682 END SUBROUTINE cp_dbcsr_get_2d_block_c 01683 01684 SUBROUTINE cp_dbcsr_get_2d_block_z(matrix,row,col,block,found,& 01685 row_size, col_size) 01686 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01687 INTEGER, INTENT(IN) :: row, col 01688 COMPLEX(kind=real_8), DIMENSION(:, :), 01689 INTENT(OUT) :: block 01690 LOGICAL, INTENT(OUT) :: found 01691 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01692 01693 LOGICAL :: tr 01694 TYPE(cp_error_type) :: error 01695 01696 CALL cp_error_init (error) 01697 tr=.FALSE. 01698 CALL dbcsr_get_block(matrix%matrix,row,col,block,tr,found,& 01699 row_size, col_size) 01700 01701 END SUBROUTINE cp_dbcsr_get_2d_block_z 01702 01703 SUBROUTINE cp_dbcsr_get_2d_block_p_d(matrix,row,col,block,found,& 01704 row_size, col_size) 01705 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01706 INTEGER, INTENT(IN) :: row, col 01707 REAL(kind=real_8), DIMENSION(:, :), 01708 POINTER :: block 01709 LOGICAL, INTENT(OUT) :: found 01710 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01711 01712 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_2d_block_p_d', 01713 routineP = moduleN//':'//routineN 01714 01715 LOGICAL :: tr 01716 01717 ! Direct 01718 01719 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01720 row_size, col_size) 01721 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01722 routineN, "CP2K does not handle transposed blocks.") 01723 END SUBROUTINE cp_dbcsr_get_2d_block_p_d 01724 01725 SUBROUTINE cp_dbcsr_get_2d_block_p_s(matrix,row,col,block,found,& 01726 row_size, col_size) 01727 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01728 INTEGER, INTENT(IN) :: row, col 01729 REAL(kind=real_4), DIMENSION(:, :), 01730 POINTER :: block 01731 LOGICAL, INTENT(OUT) :: found 01732 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01733 01734 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_2d_block_p_s', 01735 routineP = moduleN//':'//routineN 01736 01737 LOGICAL :: tr 01738 TYPE(cp_error_type) :: error 01739 01740 CALL cp_error_init (error) 01741 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01742 row_size, col_size) 01743 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01744 routineN, "CP2K does not handle transposed blocks.") 01745 01746 END SUBROUTINE cp_dbcsr_get_2d_block_p_s 01747 01748 SUBROUTINE cp_dbcsr_get_2d_block_p_c(matrix,row,col,block,found,& 01749 row_size, col_size) 01750 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01751 INTEGER, INTENT(IN) :: row, col 01752 COMPLEX(kind=real_4), DIMENSION(:, :), 01753 POINTER :: block 01754 LOGICAL, INTENT(OUT) :: found 01755 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01756 01757 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_2d_block_p_c', 01758 routineP = moduleN//':'//routineN 01759 01760 LOGICAL :: tr 01761 TYPE(cp_error_type) :: error 01762 01763 CALL cp_error_init (error) 01764 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01765 row_size, col_size) 01766 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01767 routineN, "CP2K does not handle transposed blocks.") 01768 01769 END SUBROUTINE cp_dbcsr_get_2d_block_p_c 01770 01771 SUBROUTINE cp_dbcsr_get_2d_block_p_z(matrix,row,col,block,found,& 01772 row_size, col_size) 01773 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01774 INTEGER, INTENT(IN) :: row, col 01775 COMPLEX(kind=real_8), DIMENSION(:, :), 01776 POINTER :: block 01777 LOGICAL, INTENT(OUT) :: found 01778 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01779 01780 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_2d_block_p_z', 01781 routineP = moduleN//':'//routineN 01782 01783 LOGICAL :: tr 01784 TYPE(cp_error_type) :: error 01785 01786 CALL cp_error_init (error) 01787 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01788 row_size, col_size) 01789 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01790 routineN, "CP2K does not handle transposed blocks.") 01791 01792 END SUBROUTINE cp_dbcsr_get_2d_block_p_z 01793 01794 01795 SUBROUTINE cp_dbcsr_get_block_p_d(matrix,row,col,block,found,& 01796 row_size, col_size) 01797 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01798 INTEGER, INTENT(IN) :: row, col 01799 REAL(kind=real_8), DIMENSION(:), POINTER :: block 01800 LOGICAL, INTENT(OUT) :: found 01801 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01802 01803 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_p_d', 01804 routineP = moduleN//':'//routineN 01805 01806 LOGICAL :: tr 01807 TYPE(cp_error_type) :: error 01808 01809 CALL cp_error_init (error) 01810 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01811 row_size, col_size) 01812 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01813 routineN, "CP2K does not handle transposed blocks.") 01814 01815 END SUBROUTINE cp_dbcsr_get_block_p_d 01816 01817 SUBROUTINE cp_dbcsr_get_block_p_s(matrix,row,col,block,found,& 01818 row_size, col_size) 01819 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01820 INTEGER, INTENT(IN) :: row, col 01821 REAL(kind=real_4), DIMENSION(:), POINTER :: block 01822 LOGICAL, INTENT(OUT) :: found 01823 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01824 01825 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_p_s', 01826 routineP = moduleN//':'//routineN 01827 01828 LOGICAL :: tr 01829 TYPE(cp_error_type) :: error 01830 01831 CALL cp_error_init (error) 01832 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01833 row_size, col_size) 01834 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01835 routineN, "CP2K does not handle transposed blocks.") 01836 01837 END SUBROUTINE cp_dbcsr_get_block_p_s 01838 01839 SUBROUTINE cp_dbcsr_get_block_p_c(matrix,row,col,block,found,& 01840 row_size, col_size) 01841 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01842 INTEGER, INTENT(IN) :: row, col 01843 COMPLEX(kind=real_4), DIMENSION(:), 01844 POINTER :: block 01845 LOGICAL, INTENT(OUT) :: found 01846 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01847 01848 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_p_c', 01849 routineP = moduleN//':'//routineN 01850 01851 LOGICAL :: tr 01852 TYPE(cp_error_type) :: error 01853 01854 CALL cp_error_init (error) 01855 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01856 row_size, col_size) 01857 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01858 routineN, "CP2K does not handle transposed blocks.") 01859 01860 END SUBROUTINE cp_dbcsr_get_block_p_c 01861 01862 SUBROUTINE cp_dbcsr_get_block_p_z(matrix,row,col,block,found,& 01863 row_size, col_size) 01864 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01865 INTEGER, INTENT(IN) :: row, col 01866 COMPLEX(kind=real_8), DIMENSION(:), 01867 POINTER :: block 01868 LOGICAL, INTENT(OUT) :: found 01869 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size 01870 01871 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_p_z', 01872 routineP = moduleN//':'//routineN 01873 01874 LOGICAL :: tr 01875 TYPE(cp_error_type) :: error 01876 01877 CALL cp_error_init (error) 01878 CALL dbcsr_get_block_p(matrix%matrix,row,col,block,tr,found,& 01879 row_size, col_size) 01880 CALL cp_assert(.NOT. tr, cp_fatal_level, cp_internal_error,& 01881 routineN, "CP2K does not handle transposed blocks.") 01882 01883 END SUBROUTINE cp_dbcsr_get_block_p_z 01884 01885 01886 SUBROUTINE cp_dbcsr_get_info(matrix, nblkrows_total, nblkcols_total,& 01887 nfullrows_total, nfullcols_total,& 01888 nblkrows_local, nblkcols_local,& 01889 nfullrows_local, nfullcols_local,& 01890 my_prow, my_pcol,& 01891 local_rows, local_cols, proc_row_dist, proc_col_dist,& 01892 row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, data_area,& 01893 matrix_type, data_type) 01894 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 01895 INTEGER, INTENT(OUT), OPTIONAL :: nblkrows_total, nblkcols_total, 01896 nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, 01897 nfullrows_local, nfullcols_local, my_prow, my_pcol 01898 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_rows, local_cols, 01899 proc_row_dist, proc_col_dist 01900 TYPE(array_i1d_obj), INTENT(OUT), 01901 OPTIONAL :: row_blk_size, col_blk_size, 01902 row_blk_offset, col_blk_offset 01903 TYPE(dbcsr_distribution_obj), 01904 INTENT(OUT), OPTIONAL :: distribution 01905 CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name 01906 TYPE(dbcsr_data_obj), INTENT(OUT), 01907 OPTIONAL :: data_area 01908 CHARACTER, OPTIONAL :: matrix_type 01909 INTEGER, OPTIONAL :: data_type 01910 01911 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_info', 01912 routineP = moduleN//':'//routineN 01913 01914 INTEGER :: handle 01915 01916 CALL timeset(routineN,handle) 01917 01918 CALL dbcsr_get_info(matrix%matrix, nblkrows_total, nblkcols_total,& 01919 nfullrows_total, nfullcols_total,& 01920 nblkrows_local, nblkcols_local,& 01921 nfullrows_local, nfullcols_local,& 01922 my_prow, my_pcol,& 01923 local_rows, local_cols, proc_row_dist, proc_col_dist,& 01924 row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, data_area,& 01925 matrix_type, data_type) 01926 01927 CALL timestop(handle) 01928 01929 END SUBROUTINE cp_dbcsr_get_info 01930 01931 SUBROUTINE cp_dbcsr_norm(matrix, which_norm, norm_scalar, norm_vector, error) 01932 01933 TYPE(cp_dbcsr_type), INTENT(INOUT), 01934 TARGET :: matrix 01935 INTEGER, INTENT(IN) :: which_norm 01936 REAL(dp), INTENT(OUT), OPTIONAL :: norm_scalar 01937 REAL(dp), DIMENSION(:), INTENT(OUT), 01938 OPTIONAL :: norm_vector 01939 TYPE(cp_error_type), INTENT(INOUT) :: error 01940 01941 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_norm', 01942 routineP = moduleN//':'//routineN 01943 01944 INTEGER :: handle 01945 TYPE(dbcsr_error_type) :: dbcsr_error 01946 01947 CALL timeset(routineN,handle) 01948 01949 IF (PRESENT (norm_scalar)) THEN 01950 CALL dbcsr_norm(matrix%matrix, which_norm, norm_scalar=norm_scalar,& 01951 error=dbcsr_error) 01952 ELSEIF (PRESENT (norm_vector)) THEN 01953 CALL dbcsr_norm (matrix%matrix, which_norm, norm_vector=norm_vector,& 01954 error=dbcsr_error) 01955 ELSE 01956 CALL cp_assert (.FALSE., cp_wrong_args_error, cp_internal_error,& 01957 routineN, "Must pass either scalar or vector norm.", error=error) 01958 ENDIF 01959 CALL timestop(handle) 01960 01961 END SUBROUTINE cp_dbcsr_norm 01962 01963 SUBROUTINE cp_dbcsr_replicate_all(matrix, error) 01964 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01965 TYPE(cp_error_type), INTENT(inout) :: error 01966 01967 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_replicate_all', 01968 routineP = moduleN//':'//routineN 01969 01970 INTEGER :: handle 01971 TYPE(dbcsr_error_type) :: dbcsr_error 01972 01973 CALL timeset(routineN,handle) 01974 CALL dbcsr_replicate_all(matrix%matrix, dbcsr_error) 01975 CALL timestop(handle) 01976 END SUBROUTINE cp_dbcsr_replicate_all 01977 01978 SUBROUTINE cp_dbcsr_replicate(matrix, replicate_rows, replicate_columns,& 01979 restrict_source, error) 01980 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 01981 LOGICAL, INTENT(IN) :: replicate_rows, 01982 replicate_columns 01983 INTEGER, INTENT(IN), OPTIONAL :: restrict_source 01984 TYPE(cp_error_type), INTENT(INOUT) :: error 01985 01986 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_replicate', 01987 routineP = moduleN//':'//routineN 01988 01989 INTEGER :: handle 01990 TYPE(dbcsr_error_type) :: dbcsr_error 01991 01992 CALL timeset(routineN,handle) 01993 CALL dbcsr_replicate(matrix%matrix, replicate_rows, replicate_columns,& 01994 restrict_source, dbcsr_error) 01995 CALL timestop(handle) 01996 END SUBROUTINE cp_dbcsr_replicate 01997 01998 SUBROUTINE cp_dbcsr_distribute(matrix, fast, error) 01999 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02000 LOGICAL, INTENT(in), OPTIONAL :: fast 02001 TYPE(cp_error_type), INTENT(inout) :: error 02002 02003 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_distribute', 02004 routineP = moduleN//':'//routineN 02005 02006 INTEGER :: handle 02007 TYPE(dbcsr_error_type) :: dbcsr_error 02008 02009 CALL timeset(routineN,handle) 02010 CALL dbcsr_distribute(matrix%matrix, fast, dbcsr_error) 02011 CALL timestop(handle) 02012 02013 END SUBROUTINE cp_dbcsr_distribute 02014 02015 SUBROUTINE cp_dbcsr_release_p (matrix, error) 02016 TYPE(cp_dbcsr_type), POINTER :: matrix 02017 TYPE(cp_error_type), INTENT(INOUT) :: error 02018 02019 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_release_p', 02020 routineP = moduleN//':'//routineN 02021 02022 INTEGER :: handle 02023 02024 CALL timeset(routineN,handle) 02025 IF(ASSOCIATED(matrix)) THEN 02026 CALL cp_dbcsr_release (matrix, error) 02027 DEALLOCATE(matrix) 02028 ENDIF 02029 CALL timestop(handle) 02030 02031 02032 END SUBROUTINE cp_dbcsr_release_p 02033 02034 SUBROUTINE cp_dbcsr_release (matrix, error) 02035 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02036 TYPE(cp_error_type), INTENT(INOUT) :: error 02037 02038 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_release', 02039 routineP = moduleN//':'//routineN 02040 02041 INTEGER :: handle 02042 02043 CALL timeset(routineN,handle) 02044 02045 CALL dbcsr_release (matrix%matrix) 02046 02047 CALL timestop(handle) 02048 02049 END SUBROUTINE cp_dbcsr_release 02050 02051 SUBROUTINE cp_dbcsr_init (matrix, error) 02052 TYPE(cp_dbcsr_type), INTENT(OUT) :: matrix 02053 TYPE(cp_error_type), INTENT(INOUT) :: error 02054 02055 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_init', 02056 routineP = moduleN//':'//routineN 02057 02058 INTEGER :: handle 02059 02060 CALL timeset(routineN,handle) 02061 02062 CALL dbcsr_init(matrix%matrix) 02063 matrix%ref_count = 0 02064 02065 CALL timestop(handle) 02066 02067 END SUBROUTINE cp_dbcsr_init 02068 02069 SUBROUTINE cp_dbcsr_init_p (matrix, error) 02070 TYPE(cp_dbcsr_type), POINTER :: matrix 02071 TYPE(cp_error_type), INTENT(INOUT) :: error 02072 02073 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_init_p', 02074 routineP = moduleN//':'//routineN 02075 02076 INTEGER :: handle 02077 02078 CALL timeset(routineN,handle) 02079 02080 IF(ASSOCIATED(matrix)) THEN 02081 CALL cp_dbcsr_release(matrix, error) 02082 DEALLOCATE(matrix) 02083 ENDIF 02084 02085 ALLOCATE(matrix) 02086 CALL cp_dbcsr_init (matrix, error) 02087 02088 CALL timestop(handle) 02089 02090 END SUBROUTINE cp_dbcsr_init_p 02091 02092 SUBROUTINE cp_dbcsr_print(matrix, nodata, matlab_format, variable_name, unit_nr, error) 02093 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 02094 LOGICAL, INTENT(IN), OPTIONAL :: nodata, matlab_format 02095 CHARACTER(*), INTENT(in), OPTIONAL :: variable_name 02096 INTEGER, OPTIONAL :: unit_nr 02097 TYPE(cp_error_type), INTENT(INOUT) :: error 02098 02099 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_print', 02100 routineP = moduleN//':'//routineN 02101 02102 INTEGER :: handle 02103 TYPE(dbcsr_error_type) :: dbcsr_error 02104 02105 CALL timeset(routineN,handle) 02106 02107 CALL dbcsr_print(matrix%matrix, nodata, matlab_format, variable_name, unit_nr, dbcsr_error) 02108 CALL timestop(handle) 02109 02110 END SUBROUTINE cp_dbcsr_print 02111 02112 SUBROUTINE cp_dbcsr_trace_a_d(matrix_a, trace, error) 02113 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02114 REAL(kind=real_8), INTENT(OUT) :: trace 02115 TYPE(cp_error_type), INTENT(INOUT) :: error 02116 02117 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_trace_a_d', 02118 routineP = moduleN//':'//routineN 02119 02120 INTEGER :: timing_handle 02121 TYPE(dbcsr_error_type) :: dbcsr_error 02122 TYPE(dbcsr_scalar_type) :: trace_scalar 02123 02124 CALL timeset(routineN, timing_handle) 02125 trace_scalar = dbcsr_scalar_zero (cp_dbcsr_get_data_type(matrix_a)) 02126 CALL dbcsr_trace(matrix_a%matrix, trace_scalar, dbcsr_error) 02127 CALL dbcsr_scalar_fill_all (trace_scalar) 02128 CALL dbcsr_scalar_get_value (trace_scalar, trace) 02129 CALL timestop(timing_handle) 02130 END SUBROUTINE cp_dbcsr_trace_a_d 02131 02132 SUBROUTINE cp_dbcsr_trace_a_s(matrix_a, trace, error) 02133 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02134 REAL(kind=real_4), INTENT(INOUT) :: trace 02135 TYPE(cp_error_type), INTENT(INOUT) :: error 02136 02137 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_trace_a_s', 02138 routineP = moduleN//':'//routineN 02139 02140 INTEGER :: timing_handle 02141 TYPE(dbcsr_error_type) :: dbcsr_error 02142 02143 CALL timeset(routineN, timing_handle) 02144 CALL dbcsr_trace(matrix_a%matrix, trace, dbcsr_error) 02145 CALL timestop(timing_handle) 02146 END SUBROUTINE cp_dbcsr_trace_a_s 02147 02148 SUBROUTINE cp_dbcsr_trace_ab_d(matrix_a, matrix_b, trace, trans_a, trans_b, local_sum, error) 02149 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a, matrix_b 02150 REAL(kind=real_8), INTENT(INOUT) :: trace 02151 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: trans_a, trans_b 02152 LOGICAL, INTENT(IN), OPTIONAL :: local_sum 02153 TYPE(cp_error_type), INTENT(INOUT) :: error 02154 02155 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_trace_ab_d', 02156 routineP = moduleN//':'//routineN 02157 02158 INTEGER :: timing_handle 02159 TYPE(dbcsr_error_type) :: dbcsr_error 02160 02161 CALL timeset(routineN, timing_handle) 02162 CALL dbcsr_trace(matrix_a%matrix, matrix_b%matrix, trace, trans_a, trans_b, local_sum, dbcsr_error) 02163 CALL timestop(timing_handle) 02164 END SUBROUTINE cp_dbcsr_trace_ab_d 02165 02166 SUBROUTINE cp_dbcsr_trace_ab_s(matrix_a, matrix_b, trace, trans_a, trans_b, local_sum, error) 02167 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a, matrix_b 02168 REAL(kind=real_4), INTENT(INOUT) :: trace 02169 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: trans_a, trans_b 02170 LOGICAL, INTENT(IN), OPTIONAL :: local_sum 02171 TYPE(cp_error_type), INTENT(INOUT) :: error 02172 02173 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_trace_ab_s', 02174 routineP = moduleN//':'//routineN 02175 02176 INTEGER :: timing_handle 02177 TYPE(dbcsr_error_type) :: dbcsr_error 02178 02179 CALL timeset(routineN, timing_handle) 02180 CALL dbcsr_trace(matrix_a%matrix, matrix_b%matrix, trace, trans_a, trans_b, local_sum, dbcsr_error) 02181 CALL timestop(timing_handle) 02182 END SUBROUTINE cp_dbcsr_trace_ab_s 02183 02184 FUNCTION cp_dbcsr_checksum(matrix, local, pos, error) RESULT(checksum) 02185 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 02186 LOGICAL, INTENT(IN), OPTIONAL :: local, pos 02187 TYPE(cp_error_type), INTENT(INOUT) :: error 02188 REAL(KIND=dp) :: checksum 02189 02190 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_checksum', 02191 routineP = moduleN//':'//routineN 02192 02193 INTEGER :: handle 02194 TYPE(dbcsr_error_type) :: dbcsr_error 02195 02196 CALL timeset(routineN,handle) 02197 checksum = dbcsr_checksum(matrix%matrix,& 02198 local=local, pos=pos, error=dbcsr_error) 02199 CALL timestop(handle) 02200 END FUNCTION cp_dbcsr_checksum 02201 02202 SUBROUTINE cp_dbcsr_sum_replicated (matrix, error) 02203 TYPE(cp_dbcsr_type), INTENT(inout) :: matrix 02204 TYPE(cp_error_type), INTENT(inout) :: error 02205 02206 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_sum_replicated', 02207 routineP = moduleN//':'//routineN 02208 02209 INTEGER :: handle 02210 TYPE(dbcsr_error_type) :: dbcsr_error 02211 02212 CALL timeset(routineN,handle) 02213 CALL dbcsr_sum_replicated (matrix%matrix, dbcsr_error) 02214 CALL timestop(handle) 02215 END SUBROUTINE cp_dbcsr_sum_replicated 02216 02217 SUBROUTINE cp_dbcsr_btriu(matrix_b, matrix_a, error) 02218 02219 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_b 02220 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a 02221 TYPE(cp_error_type), INTENT(INOUT) :: error 02222 02223 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_btriu', 02224 routineP = moduleN//':'//routineN 02225 02226 INTEGER :: timing_handle 02227 TYPE(dbcsr_error_type) :: dbcsr_error 02228 02229 CALL timeset(routineN, timing_handle) 02230 CALL cp_dbcsr_create (matrix_b, name="BTRIU of"//cp_dbcsr_name (matrix_a),& 02231 template=matrix_a, error=error) 02232 CALL dbcsr_btriu(matrix_b%matrix, matrix_a%matrix, dbcsr_error) 02233 CALL timestop(timing_handle) 02234 END SUBROUTINE cp_dbcsr_btriu 02235 02236 SUBROUTINE cp_dbcsr_verify_matrix(m, error, verbosity, local) 02237 TYPE(cp_dbcsr_type), INTENT(IN) :: m 02238 TYPE(cp_error_type), INTENT(INOUT) :: error 02239 INTEGER, INTENT(IN), OPTIONAL :: verbosity 02240 LOGICAL, INTENT(IN), OPTIONAL :: local 02241 02242 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_verify_matrix', 02243 r = moduleN//':'//routineN 02244 02245 INTEGER :: handle 02246 TYPE(dbcsr_error_type) :: dbcsr_error 02247 02248 CALL timeset(routineN,handle) 02249 CALL dbcsr_verify_matrix(m%matrix, verbosity, local, dbcsr_error) 02250 02251 CALL timestop(handle) 02252 02253 END SUBROUTINE cp_dbcsr_verify_matrix 02254 02255 SUBROUTINE cp_dbcsr_finalize(matrix, resort, reshuffle, error) 02256 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02257 LOGICAL, INTENT(IN), OPTIONAL :: resort, reshuffle 02258 TYPE(cp_error_type), INTENT(INOUT) :: error 02259 02260 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_finalize', 02261 routineP = moduleN//':'//routineN 02262 02263 INTEGER :: timing_handle 02264 TYPE(dbcsr_error_type) :: dbcsr_error 02265 02266 CALL timeset(routineN, timing_handle) 02267 CALL dbcsr_finalize(matrix%matrix, resort, reshuffle, error=dbcsr_error) 02268 CALL timestop(timing_handle) 02269 END SUBROUTINE cp_dbcsr_finalize 02270 02271 SUBROUTINE cp_dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n,& 02272 error, work_mutable) 02273 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02274 INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n 02275 TYPE(cp_error_type), INTENT(INOUT) :: error 02276 LOGICAL, INTENT(in), OPTIONAL :: work_mutable 02277 02278 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_work_create', 02279 routineP = moduleN//':'//routineN 02280 02281 INTEGER :: handle 02282 TYPE(dbcsr_error_type) :: dbcsr_error 02283 02284 CALL timeset(routineN,handle) 02285 02286 CALL dbcsr_work_create(matrix%matrix, nblks_guess, sizedata_guess, n,& 02287 work_mutable, dbcsr_error) 02288 CALL timestop(handle) 02289 END SUBROUTINE cp_dbcsr_work_create 02290 02291 SUBROUTINE cp_dbcsr_create_new(matrix, name, dist, matrix_type,& 02292 row_blk_size, col_blk_size, nblks, nze, data_type, reuse,& 02293 mutable_work, replication_type, error) 02294 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02295 CHARACTER(len=*), INTENT(IN) :: name 02296 TYPE(dbcsr_distribution_obj), INTENT(IN) :: dist 02297 CHARACTER, INTENT(IN) :: matrix_type 02298 TYPE(array_i1d_obj), INTENT(IN) :: row_blk_size, col_blk_size 02299 INTEGER, INTENT(IN), OPTIONAL :: nblks, nze, data_type 02300 LOGICAL, INTENT(IN), OPTIONAL :: reuse, mutable_work 02301 CHARACTER, INTENT(IN), OPTIONAL :: replication_type 02302 TYPE(cp_error_type), INTENT(INOUT) :: error 02303 02304 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_create_new', 02305 routineP = moduleN//':'//routineN 02306 02307 INTEGER :: handle 02308 TYPE(dbcsr_error_type) :: dbcsr_error 02309 02310 CALL timeset (routineN, handle) 02311 02312 CALL dbcsr_create(matrix%matrix, name, dist,& 02313 matrix_type,& 02314 row_blk_size, col_blk_size, nblks, nze, data_type, reuse=reuse,& 02315 mutable_work=mutable_work, replication_type=replication_type,& 02316 error=dbcsr_error) 02317 02318 matrix%ref_count = 1 02319 02320 CALL timestop (handle) 02321 END SUBROUTINE cp_dbcsr_create_new 02322 02323 SUBROUTINE cp_dbcsr_create_template(matrix, name, template,& 02324 dist, matrix_type,& 02325 row_blk_size, col_blk_size, nblks, nze, data_type, reuse,& 02326 mutable_work, replication_type, error) 02327 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02328 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name 02329 TYPE(cp_dbcsr_type), INTENT(IN) :: template 02330 TYPE(dbcsr_distribution_obj), 02331 INTENT(IN), OPTIONAL :: dist 02332 CHARACTER, INTENT(IN), OPTIONAL :: matrix_type 02333 TYPE(array_i1d_obj), INTENT(IN), 02334 OPTIONAL :: row_blk_size, col_blk_size 02335 INTEGER, INTENT(IN), OPTIONAL :: nblks, nze, data_type 02336 LOGICAL, INTENT(IN), OPTIONAL :: reuse, mutable_work 02337 CHARACTER, INTENT(IN), OPTIONAL :: replication_type 02338 TYPE(cp_error_type), INTENT(INOUT) :: error 02339 02340 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_create_template', 02341 routineP = moduleN//':'//routineN 02342 02343 INTEGER :: handle 02344 TYPE(dbcsr_error_type) :: dbcsr_error 02345 02346 CALL timeset (routineN, handle) 02347 CALL dbcsr_create(matrix%matrix, template%matrix,& 02348 name=name, dist=dist, matrix_type=matrix_type,& 02349 row_blk_size=row_blk_size, col_blk_size=col_blk_size,& 02350 nblks=nblks, nze=nze, data_type=data_type,& 02351 reuse=reuse, mutable_work=mutable_work,& 02352 replication_type=replication_type,& 02353 error=dbcsr_error) 02354 ! 02355 matrix%ref_count = 1 02356 CALL timestop (handle) 02357 END SUBROUTINE cp_dbcsr_create_template 02358 02359 02360 SUBROUTINE cp_dbcsr_filter(matrix, eps, method, use_absolute, filter_diag, & 02361 thorough, error) 02362 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02363 REAL(dp), INTENT(IN) :: eps 02364 INTEGER, INTENT(IN), OPTIONAL :: method 02365 LOGICAL, INTENT(in), OPTIONAL :: use_absolute, filter_diag, 02366 thorough 02367 TYPE(cp_error_type), INTENT(INOUT) :: error 02368 02369 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_filter', 02370 routineP = moduleN//':'//routineN 02371 02372 INTEGER :: timing_handle 02373 LOGICAL :: quick 02374 TYPE(dbcsr_error_type) :: dbcsr_error 02375 02376 CALL timeset(routineN, timing_handle) 02377 IF (PRESENT (thorough)) THEN 02378 quick = .NOT. thorough 02379 ELSE 02380 quick = .FALSE. 02381 ENDIF 02382 CALL dbcsr_filter(matrix%matrix, cp_dbcsr_conform_scalar (eps, matrix, error),& 02383 method, use_absolute, filter_diag,& 02384 quick=quick, error=dbcsr_error) 02385 CALL timestop(timing_handle) 02386 END SUBROUTINE cp_dbcsr_filter 02387 02388 SUBROUTINE cp_dbcsr_set_diag(matrix, diag, error) 02389 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02390 REAL(dp), DIMENSION(:), INTENT(IN) :: diag 02391 TYPE(cp_error_type), INTENT(INOUT) :: error 02392 02393 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_set_diag', 02394 routineP = moduleN//':'//routineN 02395 02396 INTEGER :: timing_handle 02397 TYPE(dbcsr_error_type) :: dbcsr_error 02398 02399 CALL timeset(routineN, timing_handle) 02400 CALL dbcsr_set_diag(matrix%matrix, diag, dbcsr_error) 02401 CALL timestop(timing_handle) 02402 END SUBROUTINE cp_dbcsr_set_diag 02403 02404 SUBROUTINE cp_dbcsr_get_diag(matrix, diag, error) 02405 02406 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 02407 REAL(dp), DIMENSION(:), INTENT(INOUT) :: diag 02408 TYPE(cp_error_type), INTENT(INOUT) :: error 02409 02410 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_diag', 02411 routineP = moduleN//':'//routineN 02412 02413 INTEGER :: timing_handle 02414 TYPE(dbcsr_error_type) :: dbcsr_error 02415 02416 CALL timeset(routineN, timing_handle) 02417 CALL dbcsr_get_diag(matrix%matrix, diag, dbcsr_error) 02418 CALL timestop(timing_handle) 02419 END SUBROUTINE cp_dbcsr_get_diag 02420 02421 SUBROUTINE cp_dbcsr_get_block_diag(matrix, diag, error) 02422 02423 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix 02424 TYPE(cp_dbcsr_type), INTENT(INOUT) :: diag 02425 TYPE(cp_error_type), INTENT(INOUT) :: error 02426 02427 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_get_block_diag', 02428 routineP = moduleN//':'//routineN 02429 02430 INTEGER :: timing_handle 02431 TYPE(dbcsr_error_type) :: dbcsr_error 02432 02433 CALL timeset(routineN, timing_handle) 02434 CALL cp_dbcsr_create (diag, "Diagonal of "//TRIM(cp_dbcsr_name (matrix)),& 02435 template=matrix,& 02436 error=error) 02437 CALL dbcsr_get_block_diag(matrix%matrix, diag%matrix, dbcsr_error) 02438 CALL timestop(timing_handle) 02439 END SUBROUTINE cp_dbcsr_get_block_diag 02440 02441 SUBROUTINE cp_dbcsr_add_on_diag(matrix, alpha_scalar, first_row, last_row, error) 02442 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02443 REAL(KIND=dp), INTENT(IN) :: alpha_scalar 02444 INTEGER, INTENT(in), OPTIONAL :: first_row, last_row 02445 TYPE(cp_error_type), INTENT(INOUT) :: error 02446 02447 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_add_on_diag', 02448 routineP = moduleN//':'//routineN 02449 02450 INTEGER :: timing_handle 02451 TYPE(dbcsr_error_type) :: dbcsr_error 02452 02453 CALL timeset(routineN, timing_handle) 02454 CALL dbcsr_add_on_diag(matrix%matrix,& 02455 cp_dbcsr_conform_scalar (alpha_scalar, matrix, error),& 02456 first_row, last_row, dbcsr_error) 02457 CALL timestop(timing_handle) 02458 END SUBROUTINE cp_dbcsr_add_on_diag 02459 02460 SUBROUTINE cp_dbcsr_binary_write(matrix, filepath, error) 02461 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 02462 CHARACTER(LEN=*), INTENT(IN) :: filepath 02463 TYPE(cp_error_type), INTENT(INOUT) :: error 02464 02465 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_binary_write', 02466 routineP = moduleN//':'//routineN 02467 02468 INTEGER :: timing_handle 02469 TYPE(dbcsr_error_type) :: dbcsr_error 02470 02471 CALL timeset(routineN, timing_handle) 02472 CALL dbcsr_binary_write(matrix%matrix, filepath, dbcsr_error) 02473 CALL timestop(timing_handle) 02474 02475 END SUBROUTINE cp_dbcsr_binary_write 02476 02477 SUBROUTINE cp_dbcsr_binary_read(filepath, distribution, groupid, matrix_new, error) 02478 CHARACTER(len=*), INTENT(IN) :: filepath 02479 TYPE(dbcsr_distribution_obj), INTENT(IN) :: distribution 02480 INTEGER, INTENT(IN), OPTIONAL :: groupid 02481 TYPE(cp_dbcsr_type), INTENT(OUT) :: matrix_new 02482 TYPE(cp_error_type), INTENT(INOUT) :: error 02483 02484 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_binary_read', 02485 routineP = moduleN//':'//routineN 02486 02487 INTEGER :: timing_handle 02488 TYPE(dbcsr_error_type) :: dbcsr_error 02489 02490 CALL timeset(routineN, timing_handle) 02491 CALL dbcsr_binary_read(filepath, distribution, groupid, matrix_new%matrix, dbcsr_error) 02492 CALL timestop(timing_handle) 02493 02494 END SUBROUTINE cp_dbcsr_binary_read 02495 02496 SUBROUTINE cp_dbcsr_copy(matrix_b, matrix_a, name, error, keep_sparsity,& 02497 shallow_data, keep_imaginary, matrix_type) 02498 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_b 02499 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a 02500 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name 02501 TYPE(cp_error_type), INTENT(INOUT) :: error 02502 LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, shallow_data, 02503 keep_imaginary 02504 CHARACTER, INTENT(IN), OPTIONAL :: matrix_type 02505 02506 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_copy', 02507 routineP = moduleN//':'//routineN 02508 02509 INTEGER :: timing_handle 02510 TYPE(dbcsr_error_type) :: dbcsr_error 02511 02512 CALL timeset(routineN, timing_handle) 02513 !call cp_assert (matrix_b%ref_count .gt. 0,& 02514 ! cp_warning_level, cp_caller_error, routineN,& 02515 ! "Matrix not created.", error=error) 02516 IF (matrix_b%ref_count .EQ. 0) THEN 02517 CALL cp_dbcsr_create (matrix_b, template=matrix_a,& 02518 error=error) 02519 ENDIF 02520 CALL dbcsr_copy(matrix_b%matrix, matrix_a%matrix, name, keep_sparsity,& 02521 shallow_data, keep_imaginary, matrix_type, dbcsr_error) 02522 CALL timestop(timing_handle) 02523 END SUBROUTINE cp_dbcsr_copy 02524 02525 SUBROUTINE cp_dbcsr_copy_into_existing(matrix_b, matrix_a, error) 02526 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_b 02527 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a 02528 TYPE(cp_error_type), INTENT(INOUT) :: error 02529 02530 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_copy_into_existing', 02531 routineP = moduleN//':'//routineN 02532 02533 INTEGER :: timing_handle 02534 TYPE(dbcsr_error_type) :: dbcsr_error 02535 02536 CALL timeset(routineN, timing_handle) 02537 IF (matrix_b%ref_count .EQ. 0) THEN 02538 CALL cp_dbcsr_create (matrix_b, template=matrix_a,& 02539 error=error) 02540 ENDIF 02541 CALL dbcsr_copy_into_existing(matrix_b%matrix, matrix_a%matrix, dbcsr_error) 02542 CALL timestop(timing_handle) 02543 END SUBROUTINE cp_dbcsr_copy_into_existing 02544 02545 02546 SUBROUTINE cp_dbcsr_desymmetrize(matrix_a, matrix_b, error) 02547 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a 02548 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_b 02549 TYPE(cp_error_type), INTENT(INOUT) :: error 02550 02551 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_desymmetrize', 02552 routineP = moduleN//':'//routineN 02553 02554 INTEGER :: timing_handle 02555 TYPE(dbcsr_error_type) :: dbcsr_error 02556 02557 CALL timeset(routineN, timing_handle) 02558 !call cp_assert (matrix_b%ref_count .gt. 0,& 02559 ! cp_warning_level, cp_caller_error, routineN,& 02560 ! "Matrix not created.", error=error) 02561 IF (matrix_b%ref_count .EQ. 0) THEN 02562 CALL cp_dbcsr_create (matrix_b, template=matrix_a,& 02563 error=error) 02564 ENDIF 02565 CALL dbcsr_desymmetrize_deep(matrix_a%matrix, matrix_b%matrix,& 02566 untransposed_data = .TRUE., error=dbcsr_error) 02567 CALL timestop(timing_handle) 02568 END SUBROUTINE cp_dbcsr_desymmetrize 02569 02570 02571 SUBROUTINE cp_dbcsr_multiply_s(transa, transb,& 02572 alpha, matrix_a, matrix_b, beta, matrix_c,& 02573 first_row, last_row, first_column, last_column, first_k, last_k,& 02574 retain_sparsity, left_set, right_set, & 02575 filter_eps, error, flop) 02576 CHARACTER(LEN=1), INTENT(IN) :: transa, transb 02577 REAL(real_4), INTENT(IN) :: alpha 02578 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a, matrix_b 02579 REAL(real_4), INTENT(IN) :: beta 02580 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_c 02581 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, 02582 first_column, last_column, 02583 first_k, last_k 02584 LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity 02585 TYPE(dbcsr_2d_array_type), OPTIONAL, 02586 POINTER :: left_set, right_set 02587 REAL(KIND=real_8), INTENT(IN), OPTIONAL :: filter_eps 02588 TYPE(cp_error_type), INTENT(INOUT) :: error 02589 INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop 02590 02591 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_multiply_s', 02592 routineP = moduleN//':'//routineN 02593 02594 CHARACTER(LEN=1) :: shape_a, shape_b, trans_a, 02595 trans_b 02596 INTEGER :: timing_handle, 02597 timing_handle_detail 02598 TYPE(dbcsr_error_type) :: dbcsr_error 02599 02600 CALL timeset(routineN, timing_handle) 02601 trans_a = transa 02602 trans_b = transb 02603 CALL uppercase(trans_a) 02604 CALL uppercase(trans_b) 02605 shape_a='R' 02606 IF(cp_dbcsr_nfullcols_total(matrix_a).EQ.cp_dbcsr_nfullrows_total(matrix_a)) shape_a='S' 02607 shape_b='R' 02608 IF(cp_dbcsr_nfullcols_total(matrix_b).EQ.cp_dbcsr_nfullrows_total(matrix_b)) shape_b='S' 02609 CALL timeset('cp_dbcsr_mult_'//trans_a//shape_a//'_'& 02610 //trans_b//shape_b, timing_handle_detail) 02611 CALL dbcsr_multiply(transa, transb,& 02612 alpha, matrix_a%matrix, matrix_b%matrix, beta, matrix_c%matrix,& 02613 first_row, last_row, first_column, last_column, first_k, last_k,& 02614 retain_sparsity, left_set=left_set, right_set=right_set,& 02615 filter_eps=filter_eps,& 02616 error=dbcsr_error, flop=flop) 02617 CALL timestop(timing_handle_detail) 02618 02619 CALL timestop(timing_handle) 02620 END SUBROUTINE cp_dbcsr_multiply_s 02621 02622 SUBROUTINE cp_dbcsr_multiply_d(transa, transb,& 02623 alpha, matrix_a, matrix_b, beta, matrix_c,& 02624 first_row, last_row, first_column, last_column, first_k, last_k,& 02625 retain_sparsity, left_set, right_set, filter_eps,& 02626 error, flop) 02627 CHARACTER(LEN=1), INTENT(IN) :: transa, transb 02628 REAL(real_8), INTENT(IN) :: alpha 02629 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a, matrix_b 02630 REAL(real_8), INTENT(IN) :: beta 02631 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_c 02632 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, 02633 first_column, last_column, 02634 first_k, last_k 02635 LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity 02636 TYPE(dbcsr_2d_array_type), OPTIONAL, 02637 POINTER :: left_set, right_set 02638 REAL(KIND=real_8), INTENT(IN), OPTIONAL :: filter_eps 02639 TYPE(cp_error_type), INTENT(INOUT) :: error 02640 INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop 02641 02642 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_multiply_d', 02643 routineP = moduleN//':'//routineN 02644 LOGICAL, PARAMETER :: prnt = .FALSE., 02645 verify = .FALSE. 02646 02647 CHARACTER(LEN=1) :: shape_a, shape_b, trans_a, 02648 trans_b 02649 INTEGER :: timing_handle, 02650 timing_handle_detail 02651 LOGICAL :: new_a_is_new, new_b_is_new 02652 REAL(kind=dp) :: cs_b, cs_c 02653 TYPE(cp_dbcsr_type) :: new_a, new_b 02654 TYPE(dbcsr_error_type) :: dbcsr_error 02655 02656 CALL timeset(routineN, timing_handle) 02657 ! 02658 trans_a = transa 02659 trans_b = transb 02660 CALL uppercase(trans_a) 02661 CALL uppercase(trans_b) 02662 shape_a='R' 02663 IF(cp_dbcsr_nfullcols_total(matrix_a).EQ.cp_dbcsr_nfullrows_total(matrix_a)) shape_a='S' 02664 shape_b='R' 02665 IF(cp_dbcsr_nfullcols_total(matrix_b).EQ.cp_dbcsr_nfullrows_total(matrix_b)) shape_b='S' 02666 CALL matrix_match_sizes (matrix_c, matrix_a, transa, matrix_b, transb,& 02667 new_a, new_b, new_a_is_new, new_b_is_new, error) 02668 CALL timeset('cp_dbcsr_mult_'//trans_a//shape_a//'_'& 02669 //trans_b//shape_b, timing_handle_detail) 02670 CALL dbcsr_multiply(transa, transb,& 02671 alpha, new_a%matrix, new_b%matrix, beta, matrix_c%matrix,& 02672 first_row, last_row, first_column, last_column, first_k, last_k,& 02673 retain_sparsity, left_set, right_set,& 02674 filter_eps=filter_eps,& 02675 error=dbcsr_error, flop=flop) 02676 IF (new_a_is_new) THEN 02677 CALL cp_dbcsr_release (new_a, error=error) 02678 ENDIF 02679 IF (new_b_is_new) THEN 02680 CALL cp_dbcsr_release (new_b, error=error) 02681 ENDIF 02682 IF (prnt) THEN 02683 CALL cp_dbcsr_print (matrix_c, matlab_format=.TRUE.,& 02684 variable_name="mpo", error=error) 02685 ENDIF 02686 IF (verify) cs_b = cp_dbcsr_checksum (matrix_c, error=error) 02687 CALL timestop(timing_handle_detail) 02688 02689 CALL timestop(timing_handle) 02690 IF (verify) THEN 02691 WRITE(*,'(A,4(1X,E9.3))')routineN//" checksums", cs_c, cs_b,& 02692 cs_c-cs_b, ABS(cs_c-cs_b)/cs_b 02693 WRITE(*,*)routineN//" multiply type",& 02694 trans_a//shape_a//'_'& 02695 //trans_b//shape_b 02696 02697 IF (ABS(cs_c-cs_b) .GT. 0.00001) STOP "Bad multiply" 02698 ENDIF 02699 END SUBROUTINE cp_dbcsr_multiply_d 02700 02701 SUBROUTINE cp_dbcsr_multiply_c(transa, transb,& 02702 alpha, matrix_a, matrix_b, beta, matrix_c,& 02703 first_row, last_row, first_column, last_column, first_k, last_k,& 02704 retain_sparsity, left_set, right_set, error,& 02705 filter_eps, flop) 02706 02707 CHARACTER(LEN=1), INTENT(IN) :: transa, transb 02708 COMPLEX(real_4), INTENT(IN) :: alpha 02709 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a, matrix_b 02710 COMPLEX(real_4), INTENT(IN) :: beta 02711 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_c 02712 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, 02713 first_column, last_column, 02714 first_k, last_k 02715 LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity 02716 TYPE(dbcsr_2d_array_type), OPTIONAL, 02717 POINTER :: left_set, right_set 02718 TYPE(cp_error_type), INTENT(INOUT) :: error 02719 REAL(KIND=real_8), INTENT(IN), OPTIONAL :: filter_eps 02720 INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop 02721 02722 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_multiply_c', 02723 routineP = moduleN//':'//routineN 02724 02725 CHARACTER(LEN=1) :: shape_a, shape_b, trans_a, 02726 trans_b 02727 INTEGER :: timing_handle, 02728 timing_handle_detail 02729 TYPE(dbcsr_error_type) :: dbcsr_error 02730 02731 CALL timeset(routineN, timing_handle) 02732 trans_a = transa 02733 trans_b = transb 02734 CALL uppercase(trans_a) 02735 CALL uppercase(trans_b) 02736 shape_a='R' 02737 IF(cp_dbcsr_nfullcols_total(matrix_a).EQ.cp_dbcsr_nfullrows_total(matrix_a)) shape_a='S' 02738 shape_b='R' 02739 IF(cp_dbcsr_nfullcols_total(matrix_b).EQ.cp_dbcsr_nfullrows_total(matrix_b)) shape_b='S' 02740 CALL timeset('cp_dbcsr_mult_'//trans_a//shape_a//'_'& 02741 //trans_b//shape_b, timing_handle_detail) 02742 CALL dbcsr_multiply(transa, transb,& 02743 alpha, matrix_a%matrix, matrix_b%matrix, beta, matrix_c%matrix,& 02744 first_row, last_row, first_column, last_column, first_k, last_k,& 02745 retain_sparsity, left_set=left_set, right_set=right_set,& 02746 filter_eps=filter_eps,& 02747 error=dbcsr_error, flop=flop) 02748 CALL timestop(timing_handle_detail) 02749 CALL timestop(timing_handle) 02750 END SUBROUTINE cp_dbcsr_multiply_c 02751 02752 SUBROUTINE cp_dbcsr_multiply_z(transa, transb,& 02753 alpha, matrix_a, matrix_b, beta, matrix_c,& 02754 first_row, last_row, first_column, last_column, first_k, last_k,& 02755 retain_sparsity, left_set, right_set,& 02756 filter_eps,& 02757 error, flop) 02758 CHARACTER(LEN=1), INTENT(IN) :: transa, transb 02759 COMPLEX(real_8), INTENT(IN) :: alpha 02760 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a, matrix_b 02761 COMPLEX(real_8), INTENT(IN) :: beta 02762 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_c 02763 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, 02764 first_column, last_column, 02765 first_k, last_k 02766 LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity 02767 TYPE(dbcsr_2d_array_type), OPTIONAL, 02768 POINTER :: left_set, right_set 02769 REAL(KIND=real_8), INTENT(IN), OPTIONAL :: filter_eps 02770 TYPE(cp_error_type), INTENT(INOUT) :: error 02771 INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop 02772 02773 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_multiply_z', 02774 routineP = moduleN//':'//routineN 02775 02776 CHARACTER(LEN=1) :: shape_a, shape_b, trans_a, 02777 trans_b 02778 INTEGER :: timing_handle, 02779 timing_handle_detail 02780 LOGICAL :: new_a_is_new, new_b_is_new 02781 TYPE(cp_dbcsr_type) :: new_a, new_b 02782 TYPE(dbcsr_error_type) :: dbcsr_error 02783 02784 CALL timeset(routineN, timing_handle) 02785 trans_a = transa 02786 trans_b = transb 02787 CALL uppercase(trans_a) 02788 CALL uppercase(trans_b) 02789 shape_a='R' 02790 IF(cp_dbcsr_nfullcols_total(matrix_a).EQ.cp_dbcsr_nfullrows_total(matrix_a)) shape_a='S' 02791 shape_b='R' 02792 IF(cp_dbcsr_nfullcols_total(matrix_b).EQ.cp_dbcsr_nfullrows_total(matrix_b)) shape_b='S' 02793 CALL matrix_match_sizes (matrix_c, matrix_a, transa, matrix_b, transb,& 02794 new_a, new_b, new_a_is_new, new_b_is_new, error) 02795 CALL timeset('cp_dbcsr_mult_'//trans_a//shape_a//'_'& 02796 //trans_b//shape_b, timing_handle_detail) 02797 CALL dbcsr_multiply(transa, transb,& 02798 alpha, new_a%matrix, new_b%matrix, beta, matrix_c%matrix,& 02799 first_row, last_row, first_column, last_column, first_k, last_k,& 02800 retain_sparsity, left_set=left_set, right_set=right_set,& 02801 filter_eps=filter_eps,& 02802 error=dbcsr_error, flop=flop) 02803 IF (new_a_is_new) THEN 02804 CALL cp_dbcsr_release (new_a, error=error) 02805 ENDIF 02806 IF (new_b_is_new) THEN 02807 CALL cp_dbcsr_release (new_b, error=error) 02808 ENDIF 02809 CALL timestop(timing_handle_detail) 02810 CALL timestop(timing_handle) 02811 END SUBROUTINE cp_dbcsr_multiply_z 02812 SUBROUTINE cp_dbcsr_transposed (transposed, normal, shallow_data_copy,& 02813 transpose_data, transpose_distribution, use_distribution, error) 02814 02815 TYPE(cp_dbcsr_type), INTENT(INOUT) :: transposed 02816 TYPE(cp_dbcsr_type), INTENT(IN) :: normal 02817 LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, 02818 transpose_data, 02819 transpose_distribution 02820 TYPE(dbcsr_distribution_obj), 02821 INTENT(IN), OPTIONAL :: use_distribution 02822 TYPE(cp_error_type), INTENT(INOUT) :: error 02823 02824 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_transposed', 02825 routineP = moduleN//':'//routineN 02826 02827 INTEGER :: timing_handle 02828 LOGICAL :: myshallow_data_copy, 02829 mytranspose_distribution 02830 TYPE(dbcsr_distribution_obj) :: myuse_distribution 02831 TYPE(dbcsr_error_type) :: dbcsr_error 02832 02833 CALL timeset(routineN, timing_handle) 02834 ! set some defaults to make usage a bit less painful (fschiff) 02835 myshallow_data_copy=.FALSE. 02836 myuse_distribution=cp_dbcsr_distribution(normal) 02837 mytranspose_distribution=.FALSE. 02838 IF(PRESENT(shallow_data_copy)) myshallow_data_copy=shallow_data_copy 02839 IF(PRESENT(use_distribution))myuse_distribution=use_distribution 02840 IF(PRESENT(transpose_distribution))mytranspose_distribution=transpose_distribution 02841 02842 CALL dbcsr_new_transposed(transposed%matrix, normal%matrix, myshallow_data_copy,& 02843 transpose_data, mytranspose_distribution,& 02844 use_distribution=myuse_distribution, error=dbcsr_error) 02845 CALL timestop(timing_handle) 02846 END SUBROUTINE cp_dbcsr_transposed 02847 02848 SUBROUTINE cp_dbcsr_hadamard_product(matrix_a, matrix_b, matrix_c, error) 02849 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_a, matrix_b 02850 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_c 02851 TYPE(cp_error_type), INTENT(INOUT) :: error 02852 02853 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_hadamard_product', 02854 routineP = moduleN//':'//routineN 02855 02856 INTEGER :: timing_handle 02857 TYPE(dbcsr_error_type) :: dbcsr_error 02858 02859 CALL timeset(routineN, timing_handle) 02860 CALL dbcsr_hadamard_product(matrix_a%matrix, matrix_b%matrix, matrix_c%matrix, dbcsr_error) 02861 CALL timestop(timing_handle) 02862 END SUBROUTINE cp_dbcsr_hadamard_product 02863 02864 02865 SUBROUTINE cp_dbcsr_scale_by_vector_d(matrix_a, alpha, side, error) 02866 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02867 REAL(real_8), DIMENSION(:), INTENT(IN), 02868 TARGET :: alpha 02869 CHARACTER(LEN=*), INTENT(IN) :: side 02870 TYPE(cp_error_type), INTENT(INOUT) :: error 02871 02872 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_by_vector_d', 02873 routineP = moduleN//':'//routineN 02874 02875 INTEGER :: timing_handle 02876 TYPE(dbcsr_error_type) :: dbcsr_error 02877 02878 CALL timeset(routineN, timing_handle) 02879 CALL dbcsr_scale_by_vector(matrix_a%matrix, alpha, side, dbcsr_error) 02880 CALL timestop(timing_handle) 02881 END SUBROUTINE cp_dbcsr_scale_by_vector_d 02882 02883 SUBROUTINE cp_dbcsr_scale_by_vector_s(matrix_a, alpha, side, error) 02884 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02885 REAL(real_4), DIMENSION(:), INTENT(IN), 02886 TARGET :: alpha 02887 CHARACTER(LEN=*), INTENT(IN) :: side 02888 TYPE(cp_error_type), INTENT(INOUT) :: error 02889 02890 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_by_vector_s', 02891 routineP = moduleN//':'//routineN 02892 02893 INTEGER :: timing_handle 02894 TYPE(dbcsr_error_type) :: dbcsr_error 02895 02896 CALL timeset(routineN, timing_handle) 02897 CALL dbcsr_scale_by_vector(matrix_a%matrix, alpha, side, dbcsr_error) 02898 CALL timestop(timing_handle) 02899 END SUBROUTINE cp_dbcsr_scale_by_vector_s 02900 02901 SUBROUTINE cp_dbcsr_scale_by_vector_z(matrix_a, alpha, side, error) 02902 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02903 COMPLEX(real_8), DIMENSION(:), 02904 INTENT(IN), TARGET :: alpha 02905 CHARACTER(LEN=*), INTENT(IN) :: side 02906 TYPE(cp_error_type), INTENT(INOUT) :: error 02907 02908 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_by_vector_z', 02909 routineP = moduleN//':'//routineN 02910 02911 INTEGER :: timing_handle 02912 TYPE(dbcsr_error_type) :: dbcsr_error 02913 02914 CALL timeset(routineN, timing_handle) 02915 CALL dbcsr_scale_by_vector(matrix_a%matrix, alpha, side, dbcsr_error) 02916 CALL timestop(timing_handle) 02917 END SUBROUTINE cp_dbcsr_scale_by_vector_z 02918 02919 SUBROUTINE cp_dbcsr_scale_by_vector_c(matrix_a, alpha, side, error) 02920 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02921 COMPLEX(real_4), DIMENSION(:), 02922 INTENT(IN), TARGET :: alpha 02923 CHARACTER(LEN=*), INTENT(IN) :: side 02924 TYPE(cp_error_type), INTENT(INOUT) :: error 02925 02926 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_by_vector_c', 02927 routineP = moduleN//':'//routineN 02928 02929 INTEGER :: timing_handle 02930 TYPE(dbcsr_error_type) :: dbcsr_error 02931 02932 CALL timeset(routineN, timing_handle) 02933 CALL dbcsr_scale_by_vector(matrix_a%matrix, alpha, side, dbcsr_error) 02934 CALL timestop(timing_handle) 02935 END SUBROUTINE cp_dbcsr_scale_by_vector_c 02936 02937 SUBROUTINE cp_dbcsr_scale_d(matrix_a, alpha_scalar, last_column, error) 02938 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02939 REAL(real_8), INTENT(IN) :: alpha_scalar 02940 INTEGER, INTENT(IN), OPTIONAL :: last_column 02941 TYPE(cp_error_type), INTENT(INOUT) :: error 02942 02943 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_d', 02944 routineP = moduleN//':'//routineN 02945 02946 INTEGER :: timing_handle 02947 TYPE(dbcsr_error_type) :: dbcsr_error 02948 02949 CALL timeset(routineN, timing_handle) 02950 CALL dbcsr_scale(matrix_a%matrix, alpha_scalar, last_column, dbcsr_error) 02951 CALL timestop(timing_handle) 02952 END SUBROUTINE cp_dbcsr_scale_d 02953 02954 SUBROUTINE cp_dbcsr_scale_s(matrix_a, alpha_scalar, last_column, error) 02955 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02956 REAL(real_4), INTENT(IN) :: alpha_scalar 02957 INTEGER, INTENT(IN), OPTIONAL :: last_column 02958 TYPE(cp_error_type), INTENT(INOUT) :: error 02959 02960 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_s', 02961 routineP = moduleN//':'//routineN 02962 02963 INTEGER :: timing_handle 02964 TYPE(dbcsr_error_type) :: dbcsr_error 02965 02966 CALL timeset(routineN, timing_handle) 02967 CALL dbcsr_scale(matrix_a%matrix, alpha_scalar, last_column, dbcsr_error) 02968 CALL timestop(timing_handle) 02969 END SUBROUTINE cp_dbcsr_scale_s 02970 02971 SUBROUTINE cp_dbcsr_scale_z(matrix_a, alpha_scalar, last_column, error) 02972 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02973 COMPLEX(real_8), INTENT(IN) :: alpha_scalar 02974 INTEGER, INTENT(IN), OPTIONAL :: last_column 02975 TYPE(cp_error_type), INTENT(INOUT) :: error 02976 02977 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_z', 02978 routineP = moduleN//':'//routineN 02979 02980 INTEGER :: timing_handle 02981 TYPE(dbcsr_error_type) :: dbcsr_error 02982 02983 CALL timeset(routineN, timing_handle) 02984 CALL dbcsr_scale(matrix_a%matrix, alpha_scalar, last_column, dbcsr_error) 02985 CALL timestop(timing_handle) 02986 END SUBROUTINE cp_dbcsr_scale_z 02987 02988 SUBROUTINE cp_dbcsr_scale_c(matrix_a, alpha_scalar, last_column, error) 02989 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 02990 COMPLEX(real_4), INTENT(IN) :: alpha_scalar 02991 INTEGER, INTENT(IN), OPTIONAL :: last_column 02992 TYPE(cp_error_type), INTENT(INOUT) :: error 02993 02994 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_c', 02995 routineP = moduleN//':'//routineN 02996 02997 INTEGER :: timing_handle 02998 TYPE(dbcsr_error_type) :: dbcsr_error 02999 03000 CALL timeset(routineN, timing_handle) 03001 CALL dbcsr_scale(matrix_a%matrix, alpha_scalar, last_column, dbcsr_error) 03002 CALL timestop(timing_handle) 03003 END SUBROUTINE cp_dbcsr_scale_c 03004 03005 03006 SUBROUTINE cp_dbcsr_scale_d_m(matrix_a, alpha_matrix, side, error) 03007 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03008 REAL(kind=real_8), DIMENSION(:), 03009 INTENT(IN), TARGET :: alpha_matrix 03010 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: side 03011 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 03012 03013 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_d_m', 03014 routineP = moduleN//':'//routineN 03015 03016 INTEGER :: timing_handle 03017 TYPE(cp_error_type) :: cp_error 03018 TYPE(dbcsr_error_type) :: dbcsr_error 03019 03020 CALL timeset(routineN, timing_handle) 03021 CALL cp_error_init (cp_error) 03022 dbcsr_error = error 03023 CALL dbcsr_scale_mat(matrix_a%matrix, alpha_matrix, side, error=dbcsr_error) 03024 error = dbcsr_error 03025 CALL timestop(timing_handle) 03026 END SUBROUTINE cp_dbcsr_scale_d_m 03027 03028 SUBROUTINE cp_dbcsr_scale_s_m(matrix_a, alpha_matrix, side, error) 03029 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03030 REAL(kind=real_4), DIMENSION(:), 03031 INTENT(IN), TARGET :: alpha_matrix 03032 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: side 03033 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 03034 03035 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_s_m', 03036 routineP = moduleN//':'//routineN 03037 03038 INTEGER :: timing_handle 03039 TYPE(cp_error_type) :: cp_error 03040 TYPE(dbcsr_error_type) :: dbcsr_error 03041 03042 CALL timeset(routineN, timing_handle) 03043 CALL cp_error_init (cp_error) 03044 dbcsr_error = error 03045 CALL dbcsr_scale_mat(matrix_a%matrix, alpha_matrix, side, error=dbcsr_error) 03046 error = dbcsr_error 03047 CALL timestop(timing_handle) 03048 END SUBROUTINE cp_dbcsr_scale_s_m 03049 03050 SUBROUTINE cp_dbcsr_scale_z_m(matrix_a, alpha_matrix, side, error) 03051 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03052 COMPLEX(kind=real_8), DIMENSION(:), 03053 INTENT(IN), TARGET :: alpha_matrix 03054 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: side 03055 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 03056 03057 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_z_m', 03058 routineP = moduleN//':'//routineN 03059 03060 INTEGER :: timing_handle 03061 TYPE(cp_error_type) :: cp_error 03062 TYPE(dbcsr_error_type) :: dbcsr_error 03063 03064 CALL timeset(routineN, timing_handle) 03065 dbcsr_error = error 03066 CALL cp_error_init (cp_error) 03067 CALL dbcsr_scale_mat(matrix_a%matrix, alpha_matrix, side, error=dbcsr_error) 03068 error = dbcsr_error 03069 CALL timestop(timing_handle) 03070 END SUBROUTINE cp_dbcsr_scale_z_m 03071 03072 SUBROUTINE cp_dbcsr_scale_c_m(matrix_a, alpha_matrix, side, error) 03073 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03074 COMPLEX(kind=real_4), DIMENSION(:), 03075 INTENT(IN), TARGET :: alpha_matrix 03076 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: side 03077 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 03078 03079 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_scale_c_m', 03080 routineP = moduleN//':'//routineN 03081 03082 INTEGER :: timing_handle 03083 TYPE(cp_error_type) :: cp_error 03084 TYPE(dbcsr_error_type) :: dbcsr_error 03085 03086 CALL timeset(routineN, timing_handle) 03087 CALL cp_error_init (cp_error) 03088 dbcsr_error = error 03089 CALL dbcsr_scale_mat(matrix_a%matrix, alpha_matrix, side, error=dbcsr_error) 03090 error = dbcsr_error 03091 CALL timestop(timing_handle) 03092 END SUBROUTINE cp_dbcsr_scale_c_m 03093 03094 03095 SUBROUTINE cp_dbcsr_set_d(matrix, alpha, error) 03096 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 03097 REAL(real_8), INTENT(IN) :: alpha 03098 TYPE(cp_error_type), INTENT(INOUT) :: error 03099 03100 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_set_d', 03101 routineP = moduleN//':'//routineN 03102 03103 INTEGER :: timing_handle 03104 TYPE(dbcsr_error_type) :: dbcsr_error 03105 03106 CALL timeset(routineN, timing_handle) 03107 CALL dbcsr_set(matrix%matrix, cp_dbcsr_conform_scalar (alpha, matrix, error), dbcsr_error) 03108 CALL timestop(timing_handle) 03109 END SUBROUTINE cp_dbcsr_set_d 03110 03111 SUBROUTINE cp_dbcsr_set_s(matrix, alpha, error) 03112 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 03113 REAL(real_4), INTENT(IN) :: alpha 03114 TYPE(cp_error_type), INTENT(INOUT) :: error 03115 03116 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_set_s', 03117 routineP = moduleN//':'//routineN 03118 03119 INTEGER :: timing_handle 03120 TYPE(dbcsr_error_type) :: dbcsr_error 03121 03122 CALL timeset(routineN, timing_handle) 03123 CALL dbcsr_set(matrix%matrix, cp_dbcsr_conform_scalar (alpha, matrix, error), dbcsr_error) 03124 CALL timestop(timing_handle) 03125 END SUBROUTINE cp_dbcsr_set_s 03126 03127 SUBROUTINE cp_dbcsr_set_z(matrix, alpha, error) 03128 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 03129 COMPLEX(real_8), INTENT(IN) :: alpha 03130 TYPE(cp_error_type), INTENT(INOUT) :: error 03131 03132 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_set_z', 03133 routineP = moduleN//':'//routineN 03134 03135 INTEGER :: timing_handle 03136 TYPE(dbcsr_error_type) :: dbcsr_error 03137 03138 CALL timeset(routineN, timing_handle) 03139 CALL dbcsr_set(matrix%matrix, cp_dbcsr_conform_scalar (alpha, matrix, error), dbcsr_error) 03140 CALL timestop(timing_handle) 03141 END SUBROUTINE cp_dbcsr_set_z 03142 03143 SUBROUTINE cp_dbcsr_set_c(matrix, alpha, error) 03144 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 03145 COMPLEX(real_4), INTENT(IN) :: alpha 03146 TYPE(cp_error_type), INTENT(INOUT) :: error 03147 03148 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_set_c', 03149 routineP = moduleN//':'//routineN 03150 03151 INTEGER :: timing_handle 03152 TYPE(dbcsr_error_type) :: dbcsr_error 03153 03154 CALL timeset(routineN, timing_handle) 03155 CALL dbcsr_set(matrix%matrix, cp_dbcsr_conform_scalar (alpha, matrix, error), dbcsr_error) 03156 CALL timestop(timing_handle) 03157 END SUBROUTINE cp_dbcsr_set_c 03158 03159 SUBROUTINE cp_dbcsr_add_d(matrix_a, matrix_b, alpha_scalar, beta_scalar, error) 03160 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03161 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_b 03162 REAL(real_8), INTENT(IN) :: alpha_scalar, beta_scalar 03163 TYPE(cp_error_type), INTENT(INOUT) :: error 03164 03165 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_add_d', 03166 routineP = moduleN//':'//routineN 03167 03168 INTEGER :: timing_handle 03169 TYPE(dbcsr_error_type) :: dbcsr_error 03170 03171 CALL timeset(routineN, timing_handle) 03172 CALL dbcsr_add(matrix_a%matrix, matrix_b%matrix, alpha_scalar, beta_scalar, dbcsr_error) 03173 CALL timestop(timing_handle) 03174 END SUBROUTINE cp_dbcsr_add_d 03175 03176 SUBROUTINE cp_dbcsr_add_s(matrix_a, matrix_b, alpha_scalar, beta_scalar, error) 03177 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03178 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_b 03179 REAL(real_4), INTENT(IN) :: alpha_scalar, beta_scalar 03180 TYPE(cp_error_type), INTENT(INOUT) :: error 03181 03182 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_add_s', 03183 routineP = moduleN//':'//routineN 03184 03185 INTEGER :: timing_handle 03186 TYPE(dbcsr_error_type) :: dbcsr_error 03187 03188 CALL timeset(routineN, timing_handle) 03189 CALL dbcsr_add(matrix_a%matrix, matrix_b%matrix, alpha_scalar, beta_scalar, dbcsr_error) 03190 CALL timestop(timing_handle) 03191 END SUBROUTINE cp_dbcsr_add_s 03192 03193 SUBROUTINE cp_dbcsr_add_z(matrix_a, matrix_b, alpha_scalar, beta_scalar, error) 03194 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03195 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_b 03196 COMPLEX(real_8), INTENT(IN) :: alpha_scalar, beta_scalar 03197 TYPE(cp_error_type), INTENT(INOUT) :: error 03198 03199 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_add_z', 03200 routineP = moduleN//':'//routineN 03201 03202 INTEGER :: timing_handle 03203 TYPE(dbcsr_error_type) :: dbcsr_error 03204 03205 CALL timeset(routineN, timing_handle) 03206 CALL dbcsr_add(matrix_a%matrix, matrix_b%matrix, alpha_scalar, beta_scalar, dbcsr_error) 03207 CALL timestop(timing_handle) 03208 END SUBROUTINE cp_dbcsr_add_z 03209 03210 SUBROUTINE cp_dbcsr_add_c(matrix_a, matrix_b, alpha_scalar, beta_scalar, error) 03211 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix_a 03212 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_b 03213 COMPLEX(real_4), INTENT(IN) :: alpha_scalar, beta_scalar 03214 TYPE(cp_error_type), INTENT(INOUT) :: error 03215 03216 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_add_c', 03217 routineP = moduleN//':'//routineN 03218 03219 INTEGER :: timing_handle 03220 TYPE(dbcsr_error_type) :: dbcsr_error 03221 03222 CALL timeset(routineN, timing_handle) 03223 CALL dbcsr_add(matrix_a%matrix, matrix_b%matrix, alpha_scalar, beta_scalar, dbcsr_error) 03224 CALL timestop(timing_handle) 03225 END SUBROUTINE cp_dbcsr_add_c 03226 03227 ! ultimately this routine should not be needed 03228 SUBROUTINE cp_dbcsr_untranspose_blocks(matrix, error) 03229 TYPE(cp_dbcsr_type), INTENT(INOUT) :: matrix 03230 TYPE(cp_error_type), INTENT(INOUT) :: error 03231 03232 CHARACTER(len=*), PARAMETER :: routineN = 'cp_dbcsr_untranspose_blocks', 03233 routineP = moduleN//':'//routineN 03234 03235 INTEGER :: timing_handle 03236 TYPE(dbcsr_error_type) :: dbcsr_error 03237 03238 CALL timeset(routineN, timing_handle) 03239 CALL dbcsr_make_untransposed_blocks(matrix%matrix,dbcsr_error) 03240 CALL timestop(timing_handle) 03241 03242 END SUBROUTINE cp_dbcsr_untranspose_blocks 03243 03244 03245 SUBROUTINE fill_sizes (matrix, row, col,& 03246 row_size, col_size, row_offset, col_offset) 03247 TYPE(cp_dbcsr_type), INTENT(in) :: matrix 03248 INTEGER, INTENT(in) :: row, col 03249 INTEGER, INTENT(out), OPTIONAL :: row_size, col_size, 03250 row_offset, col_offset 03251 03252 IF (PRESENT (row_size)) THEN 03253 row_size = dbcsr_blk_row_size (matrix%matrix, row) 03254 ENDIF 03255 IF (PRESENT (col_size)) THEN 03256 col_size = dbcsr_blk_column_size (matrix%matrix, col) 03257 ENDIF 03258 IF (PRESENT (row_offset)) THEN 03259 row_offset = dbcsr_blk_row_offset (matrix%matrix, row) 03260 ENDIF 03261 IF (PRESENT (col_offset)) THEN 03262 col_offset = dbcsr_blk_col_offset (matrix%matrix, col) 03263 ENDIF 03264 END SUBROUTINE fill_sizes 03265 03266 03267 ! ***************************************************************************** 03283 SUBROUTINE matrix_match_sizes (matrix_c, matrix_a, tr_a, matrix_b, tr_b,& 03284 new_a, new_b, new_a_is_new, new_b_is_new,& 03285 error) 03286 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_c, matrix_a 03287 CHARACTER, INTENT(IN) :: tr_a 03288 TYPE(cp_dbcsr_type), INTENT(IN) :: matrix_b 03289 CHARACTER, INTENT(IN) :: tr_b 03290 TYPE(cp_dbcsr_type), INTENT(OUT) :: new_a, new_b 03291 LOGICAL, INTENT(OUT) :: new_a_is_new, new_b_is_new 03292 TYPE(cp_error_type), INTENT(INOUT) :: error 03293 03294 CHARACTER(LEN=*), PARAMETER :: routineN = 'matrix_match_sizes', 03295 routineP = moduleN//':'//routineN 03296 03297 CHARACTER :: tr_a_l, tr_b_l 03298 INTEGER :: a_cols_total, a_rows_total, b_cols_total, b_rows_total, 03299 c_cols_total, c_rows_total, handle 03300 LOGICAL :: atr, btr, new_a_rows, 03301 new_b_cols, new_b_rows 03302 TYPE(array_i1d_obj) :: new_col_dist, new_col_size, 03303 new_row_dist, new_row_size 03304 TYPE(dbcsr_distribution_obj) :: a_dist, b_dist, c_dist, 03305 new_dist 03306 03307 !type(dbcsr_imagedistribution_obj) :: b_imgdist 03308 ! --------------------------------------------------------------------------- 03309 03310 CALL timeset (routineN, handle) 03311 tr_a_l = tr_a 03312 CALL uppercase (tr_a_l) 03313 tr_b_l = tr_b 03314 CALL uppercase (tr_b_l) 03315 btr = tr_b_l .NE. dbcsr_no_transpose 03316 atr = tr_a_l .NE. dbcsr_no_transpose 03317 ! 03318 c_rows_total = cp_dbcsr_nfullrows_total (matrix_c) 03319 c_cols_total = cp_dbcsr_nfullcols_total (matrix_c) 03320 b_rows_total = cp_dbcsr_nfullrows_total (matrix_b) 03321 b_cols_total = cp_dbcsr_nfullcols_total (matrix_b) 03322 a_rows_total = cp_dbcsr_nfullrows_total (matrix_a) 03323 a_cols_total = cp_dbcsr_nfullcols_total (matrix_a) 03324 IF (atr) CALL swap (a_cols_total, a_rows_total) 03325 IF (btr) CALL swap (b_cols_total, b_rows_total) 03326 ! 03327 ! Process matrix B. 03328 ! 03329 ! This check is faster than explicity comparing blocked row and 03330 ! column sizes. 03331 new_b_cols = c_cols_total .NE. b_cols_total 03332 new_b_rows = a_cols_total .NE. b_rows_total 03333 a_dist = cp_dbcsr_distribution (matrix_a) 03334 b_dist = cp_dbcsr_distribution (matrix_b) 03335 c_dist = cp_dbcsr_distribution (matrix_c) 03336 IF (new_b_rows .OR. new_b_cols) THEN 03337 new_b_is_new = .TRUE. 03338 CALL cp_dbcsr_init (new_b, error=error) 03339 IF (.NOT. btr) THEN 03340 IF (new_b_cols) THEN 03341 CALL match_1_dist (new_col_dist,& 03342 dbcsr_distribution_col_dist (b_dist),& 03343 dbcsr_distribution_col_dist (c_dist)) 03344 ELSE 03345 new_col_dist = dbcsr_distribution_col_dist (b_dist) 03346 CALL array_hold (new_col_dist) 03347 ENDIF 03348 new_col_size = cp_dbcsr_col_block_sizes (matrix_c) 03349 IF (new_b_rows) THEN 03350 IF (.NOT. atr) THEN 03351 CALL match_1_dist (new_row_dist,& 03352 dbcsr_distribution_row_dist(b_dist),& 03353 dbcsr_distribution_col_dist(a_dist)) 03354 new_row_size = cp_dbcsr_col_block_sizes(matrix_a) 03355 ELSE 03356 CALL match_1_dist (new_row_dist,& 03357 dbcsr_distribution_row_dist(b_dist),& 03358 dbcsr_distribution_row_dist(a_dist)) 03359 new_row_size = cp_dbcsr_row_block_sizes(matrix_a) 03360 ENDIF 03361 ELSE 03362 new_row_dist = dbcsr_distribution_row_dist(b_dist) 03363 CALL array_hold (new_row_dist) 03364 new_row_size = cp_dbcsr_row_block_sizes (matrix_b) 03365 ENDIF 03366 ELSE 03367 IF (new_b_cols) THEN 03368 CALL match_1_dist (new_row_dist,& 03369 dbcsr_distribution_row_dist (b_dist),& 03370 dbcsr_distribution_col_dist (c_dist)) 03371 ELSE 03372 new_row_dist = dbcsr_distribution_row_dist (b_dist) 03373 CALL array_hold (new_row_dist) 03374 ENDIF 03375 new_row_size = cp_dbcsr_col_block_sizes (matrix_c) 03376 IF (new_b_rows) THEN 03377 IF (.not.atr) THEN 03378 CALL match_1_dist (new_col_dist,& 03379 dbcsr_distribution_col_dist (b_dist),& 03380 dbcsr_distribution_col_dist (a_dist)) 03381 new_col_size = cp_dbcsr_col_block_sizes (matrix_a) 03382 ELSE 03383 CALL match_1_dist (new_col_dist,& 03384 dbcsr_distribution_col_dist (b_dist),& 03385 dbcsr_distribution_row_dist (a_dist)) 03386 new_col_size = cp_dbcsr_row_block_sizes (matrix_a) 03387 ENDIF 03388 ELSE 03389 new_col_dist = dbcsr_distribution_col_dist(b_dist) 03390 CALL array_hold (new_col_dist) 03391 new_col_size = cp_dbcsr_col_block_sizes (matrix_b) 03392 ENDIF 03393 ENDIF 03394 CALL dbcsr_distribution_new (new_dist, dbcsr_distribution_mp (c_dist),& 03395 row_dist=new_row_dist,& 03396 col_dist=new_col_dist) 03397 CALL array_release (new_row_dist) 03398 CALL array_release (new_col_dist) 03399 CALL cp_dbcsr_create (new_b, template=matrix_b,& 03400 dist = new_dist,& 03401 row_blk_size = new_row_size,& 03402 col_blk_size = new_col_size,& 03403 error=error) 03404 CALL dbcsr_distribution_release (new_dist) 03405 CALL cp_dbcsr_complete_redistribute (matrix_b, new_b, error=error) 03406 ELSE 03407 !new_b_is_new = .FALSE. 03408 !new_b = matrix_b 03409 new_b_is_new = .TRUE. 03410 CALL cp_dbcsr_init (new_b, error=error) 03411 CALL cp_dbcsr_copy (new_b, matrix_b, shallow_data=.TRUE., error=error) 03412 ENDIF 03413 ! 03414 ! Process matrix A 03415 new_a_rows = a_rows_total .NE. c_rows_total 03416 IF (new_a_rows) THEN 03417 CALL cp_dbcsr_init (new_a, error=error) 03418 IF (atr) THEN 03419 new_row_dist = dbcsr_distribution_row_dist (a_dist) 03420 CALL array_hold (new_row_dist) 03421 new_row_size = cp_dbcsr_row_block_sizes (matrix_a) 03422 CALL match_1_dist (new_col_dist,& 03423 dbcsr_distribution_col_dist (a_dist),& 03424 dbcsr_distribution_row_dist (c_dist)) 03425 new_col_size = cp_dbcsr_row_block_sizes (matrix_c) 03426 ELSE 03427 CALL match_1_dist (new_row_dist,& 03428 dbcsr_distribution_row_dist (a_dist),& 03429 dbcsr_distribution_row_dist (c_dist)) 03430 new_row_size = cp_dbcsr_row_block_sizes (matrix_c) 03431 new_col_dist = dbcsr_distribution_col_dist (a_dist) 03432 CALL array_hold (new_col_dist) 03433 new_col_size = cp_dbcsr_col_block_sizes (matrix_a) 03434 ENDIF 03435 CALL dbcsr_distribution_new (new_dist, dbcsr_distribution_mp (a_dist),& 03436 row_dist = new_row_dist,& 03437 col_dist = new_col_dist) 03438 CALL array_release (new_row_dist) 03439 CALL array_release (new_col_dist) 03440 CALL cp_dbcsr_create (new_a, template=matrix_a,& 03441 dist=new_dist,& 03442 row_blk_size = new_row_size,& 03443 col_blk_size = new_col_size,& 03444 error=error) 03445 CALL dbcsr_distribution_release (new_dist) 03446 CALL cp_dbcsr_complete_redistribute (matrix_a, new_a, error=error) 03447 ELSE 03448 !new_a_is_new = .FALSE. 03449 !new_a = matrix_a 03450 new_a_is_new = .TRUE. 03451 CALL cp_dbcsr_init (new_a, error=error) 03452 CALL cp_dbcsr_copy (new_a, matrix_a, shallow_data=.TRUE., error=error) 03453 ENDIF 03454 CALL timestop (handle) 03455 END SUBROUTINE matrix_match_sizes 03456 03457 ! ***************************************************************************** 03463 SUBROUTINE match_1_dist (new_dist, old_dist, template_dist) 03464 TYPE(array_i1d_obj), INTENT(out) :: new_dist 03465 TYPE(array_i1d_obj), INTENT(in) :: old_dist, template_dist 03466 03467 INTEGER :: i, max_bin, new_size, 03468 old_size, sz 03469 INTEGER, DIMENSION(:), POINTER :: new_data, old_data 03470 03471 old_size = array_size (old_dist) 03472 new_size = array_size (template_dist) 03473 sz = MIN(old_size, new_size) 03474 old_data => array_data (old_dist) 03475 CALL array_new (new_dist, array_data (template_dist), lb=1) 03476 new_data => array_data (new_dist) 03477 new_data(1:sz) = old_data(1:sz) 03478 max_bin = MAXVAL (old_data) 03479 IF (max_bin .GT. 0) THEN 03480 FORALL (i = sz+1 : new_size) 03481 new_data(i) = MOD (i, max_bin) 03482 END FORALL 03483 ELSE 03484 new_data(sz+1:new_size) = 0 03485 ENDIF 03486 END SUBROUTINE match_1_dist 03487 03488 END MODULE cp_dbcsr_interface
1.7.3