diff --git a/src/hfx_ace_methods.F b/src/hfx_ace_methods.F index ee2ca95a65..501997a8ef 100644 --- a/src/hfx_ace_methods.F +++ b/src/hfx_ace_methods.F @@ -57,8 +57,7 @@ MODULE hfx_ace_methods dbcsr_type USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& cp_dbcsr_plus_fm_fm_t - USE cp_fm_basic_linalg, ONLY: cp_fm_gemm,& - cp_fm_scale,& + USE cp_fm_basic_linalg, ONLY: cp_fm_scale,& cp_fm_trace,& cp_fm_triangular_multiply USE cp_fm_cholesky, ONLY: cp_fm_cholesky_decompose @@ -78,6 +77,7 @@ MODULE hfx_ace_methods USE input_section_types, ONLY: section_vals_type USE kinds, ONLY: dp USE message_passing, ONLY: mp_para_env_type + USE parallel_gemm_api, ONLY: parallel_gemm USE pw_types, ONLY: pw_r3d_rs_type USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& @@ -492,8 +492,8 @@ CONTAINS CALL cp_fm_to_fm(mo_coeff, C_occ_fm) ! Step 4: xi = K_AO * C_occ - CALL cp_fm_gemm('N', 'N', nao, nocc, nao, & - 1.0_dp, K_fm, C_occ_fm, 0.0_dp, xi_fm) + CALL parallel_gemm('N', 'N', nao, nocc, nao, & + 1.0_dp, K_fm, C_occ_fm, 0.0_dp, xi_fm) CALL cp_fm_release(K_fm) IF (DBG_BUILD .AND. iw > 0) THEN @@ -508,8 +508,8 @@ CONTAINS CALL cp_fm_create(M_fm, fmstruct, name="M") CALL cp_fm_struct_release(fmstruct) - CALL cp_fm_gemm('T', 'N', nocc, nocc, nao, & - 1.0_dp, C_occ_fm, xi_fm, 0.0_dp, M_fm) + CALL parallel_gemm('T', 'N', nocc, nocc, nao, & + 1.0_dp, C_occ_fm, xi_fm, 0.0_dp, M_fm) CALL cp_fm_release(C_occ_fm) IF (DBG_BUILD .AND. iw > 0) THEN @@ -583,8 +583,8 @@ CONTAINS CALL cp_fm_create(A_ref_fm, fmstruct, name="WtC_ref") CALL cp_fm_struct_release(fmstruct) - CALL cp_fm_gemm('T', 'N', nocc, nocc, nao, & - 1.0_dp, ace_W(1, ispin), C_occ_fm, 0.0_dp, A_ref_fm) + CALL parallel_gemm('T', 'N', nocc, nocc, nao, & + 1.0_dp, ace_W(1, ispin), C_occ_fm, 0.0_dp, A_ref_fm) CALL cp_fm_trace(A_ref_fm, A_ref_fm, frob) ace_W_ref_norm = ace_W_ref_norm + SQRT(MAX(frob, 0.0_dp)) @@ -727,8 +727,8 @@ CONTAINS CALL copy_dbcsr_to_fm(rho_ao(ispin, 1)%matrix, P_fm) CALL cp_fm_create(PW_fm, ace_W(1, ispin)%matrix_struct, name="PW") - CALL cp_fm_gemm('N', 'N', nao, nocc, nao, & - 1.0_dp, P_fm, ace_W(1, ispin), 0.0_dp, PW_fm) + CALL parallel_gemm('N', 'N', nao, nocc, nao, & + 1.0_dp, P_fm, ace_W(1, ispin), 0.0_dp, PW_fm) CALL cp_fm_trace(ace_W(1, ispin), PW_fm, trace_val) ehfx_ace = ehfx_ace - 0.5_dp*trace_val @@ -804,8 +804,8 @@ CONTAINS CALL cp_fm_create(A_diag_fm, fmstruct_diag, name="WtC_stale") CALL cp_fm_struct_release(fmstruct_diag) - CALL cp_fm_gemm('T', 'N', nocc_d, nocc_d, nao_d, & - 1.0_dp, ace_W(1, ispin), C_occ_diag, 0.0_dp, A_diag_fm) + CALL parallel_gemm('T', 'N', nocc_d, nocc_d, nao_d, & + 1.0_dp, ace_W(1, ispin), C_occ_diag, 0.0_dp, A_diag_fm) CALL cp_fm_trace(A_diag_fm, A_diag_fm, frob_A) stale_norm = stale_norm + SQRT(MAX(frob_A, 0.0_dp)) diff --git a/src/qs_wannier90.F b/src/qs_wannier90.F index 8540d62eb3..c13d3367a4 100644 --- a/src/qs_wannier90.F +++ b/src/qs_wannier90.F @@ -2464,61 +2464,63 @@ CONTAINS s_projected(:, :) = 0.5_dp*(s_projected + CONJG(TRANSPOSE(s_projected))) h_projected(:, :) = 0.5_dp*(h_projected + CONJG(TRANSPOSE(h_projected))) - CALL diag_complex(s_projected, metric_vectors, metric_values) - min_svalue = MINVAL(metric_values) - metric_deviation = MAXVAL(ABS(metric_values - 1.0_dp)) - IF (min_svalue < 1.0e-10_dp) THEN - WRITE (reason, "(A,ES9.2,A,ES9.2)") & - "singular expanded metric smin=", min_svalue, " dS=", metric_deviation - GOTO 100 - END IF - - DO ib = 1, nmo_source - metric_vectors(:, ib) = metric_vectors(:, ib)/SQRT(metric_values(ib)) - END DO - h_projected_work(:, :) = MATMUL(h_projected, metric_vectors) - h_projected(:, :) = MATMUL(CONJG(TRANSPOSE(metric_vectors)), h_projected_work) - h_projected(:, :) = 0.5_dp*(h_projected + CONJG(TRANSPOSE(h_projected))) - CALL diag_complex(h_projected, ritz_vectors, ritz_values) - h_projected_work(:, :) = MATMUL(metric_vectors, ritz_vectors) - ritz_vectors(:, :) = h_projected_work - stabilized(:, :) = MATMUL(source_coeff, ritz_vectors(:, 1:nmo_export)) - coeff_work(:, :) = MATMUL(h_coeff, ritz_vectors) - h_coeff(:, :) = coeff_work - coeff_work(:, :) = MATMUL(s_coeff, ritz_vectors) - s_coeff(:, :) = coeff_work - DO ib = 1, nmo_export - norm_value = SQRT(ABS(REAL(DOT_PRODUCT(stabilized(:, ib), s_coeff(:, ib)), KIND=dp))) - IF (norm_value > EPSILON(1.0_dp)) THEN - stabilized(:, ib) = stabilized(:, ib)/norm_value - h_coeff(:, ib) = h_coeff(:, ib)/norm_value - s_coeff(:, ib) = s_coeff(:, ib)/norm_value + reconstruct_window: BLOCK + CALL diag_complex(s_projected, metric_vectors, metric_values) + min_svalue = MINVAL(metric_values) + metric_deviation = MAXVAL(ABS(metric_values - 1.0_dp)) + IF (min_svalue < 1.0e-10_dp) THEN + WRITE (reason, "(A,ES9.2,A,ES9.2)") & + "singular expanded metric smin=", min_svalue, " dS=", metric_deviation + EXIT reconstruct_window END IF - END DO - residual_block(:, :) = h_coeff(:, 1:nmo_export) - DO ib = 1, nmo_export - residual_block(:, ib) = residual_block(:, ib) - ritz_values(ib)*s_coeff(:, ib) - END DO - max_residual = MAXVAL(ABS(residual_block)) - IF (max_residual > residual_tol) THEN - WRITE (reason, "(A,ES9.2)") & - "expanded dS=", metric_deviation - GOTO 100 - END IF - max_eigenvalue_shift = MAXVAL(ABS(ritz_values(1:nmo_export) - source_eigenvalues(1:nmo_export))) - IF (max_eigenvalue_shift > eigenvalue_tol) THEN - WRITE (reason, "(A,ES9.2)") & - "expanded dS=", metric_deviation - GOTO 100 - END IF - dst_r(:, :) = REAL(stabilized, KIND=dp) - dst_i(:, :) = AIMAG(stabilized) - CALL cp_fm_set_submatrix(dst_real, dst_r) - CALL cp_fm_set_submatrix(dst_imag, dst_i) - success = .TRUE. + DO ib = 1, nmo_source + metric_vectors(:, ib) = metric_vectors(:, ib)/SQRT(metric_values(ib)) + END DO + h_projected_work(:, :) = MATMUL(h_projected, metric_vectors) + h_projected(:, :) = MATMUL(CONJG(TRANSPOSE(metric_vectors)), h_projected_work) + h_projected(:, :) = 0.5_dp*(h_projected + CONJG(TRANSPOSE(h_projected))) + CALL diag_complex(h_projected, ritz_vectors, ritz_values) + h_projected_work(:, :) = MATMUL(metric_vectors, ritz_vectors) + ritz_vectors(:, :) = h_projected_work + stabilized(:, :) = MATMUL(source_coeff, ritz_vectors(:, 1:nmo_export)) + coeff_work(:, :) = MATMUL(h_coeff, ritz_vectors) + h_coeff(:, :) = coeff_work + coeff_work(:, :) = MATMUL(s_coeff, ritz_vectors) + s_coeff(:, :) = coeff_work + DO ib = 1, nmo_export + norm_value = SQRT(ABS(REAL(DOT_PRODUCT(stabilized(:, ib), s_coeff(:, ib)), KIND=dp))) + IF (norm_value > EPSILON(1.0_dp)) THEN + stabilized(:, ib) = stabilized(:, ib)/norm_value + h_coeff(:, ib) = h_coeff(:, ib)/norm_value + s_coeff(:, ib) = s_coeff(:, ib)/norm_value + END IF + END DO + residual_block(:, :) = h_coeff(:, 1:nmo_export) + DO ib = 1, nmo_export + residual_block(:, ib) = residual_block(:, ib) - ritz_values(ib)*s_coeff(:, ib) + END DO + max_residual = MAXVAL(ABS(residual_block)) + IF (max_residual > residual_tol) THEN + WRITE (reason, "(A,ES9.2)") & + "expanded dS=", metric_deviation + EXIT reconstruct_window + END IF + max_eigenvalue_shift = MAXVAL(ABS(ritz_values(1:nmo_export) - source_eigenvalues(1:nmo_export))) + IF (max_eigenvalue_shift > eigenvalue_tol) THEN + WRITE (reason, "(A,ES9.2)") & + "expanded dS=", metric_deviation + EXIT reconstruct_window + END IF + + dst_r(:, :) = REAL(stabilized, KIND=dp) + dst_i(:, :) = AIMAG(stabilized) + CALL cp_fm_set_submatrix(dst_real, dst_r) + CALL cp_fm_set_submatrix(dst_imag, dst_i) + success = .TRUE. + + END BLOCK reconstruct_window -100 CONTINUE DEALLOCATE (source_coeff, s_coeff, h_coeff, h_projected, h_projected_work, metric_vectors, & residual_block, ritz_vectors, s_projected, stabilized, coeff_work, metric_values, & ritz_values, source_eigenvalues) diff --git a/src/xc/xc_gauxc_interface.F b/src/xc/xc_gauxc_interface.F index 44d3772b2b..1bccb63bae 100644 --- a/src/xc/xc_gauxc_interface.F +++ b/src/xc/xc_gauxc_interface.F @@ -33,6 +33,8 @@ MODULE xc_gauxc_interface qs_kind_type USE cp_dbcsr_api, ONLY: & dbcsr_p_type + USE cp_log_handling, ONLY: & + cp_logger_get_default_io_unit #ifdef __GAUXC @@ -189,7 +191,7 @@ MODULE xc_gauxc_interface #endif TYPE cp_gauxc_xc_type - REAL(c_double) :: exc + REAL(c_double) :: exc = 0.0_c_double REAL(c_double), DIMENSION(:, :), ALLOCATABLE :: vxc_scalar, vxc_zeta END TYPE cp_gauxc_xc_type @@ -234,21 +236,24 @@ CONTAINS #ifdef __GAUXC CHARACTER(kind=c_char), POINTER :: s(:) - INTEGER :: i + INTEGER :: i, iw - WRITE (0, '(a,1x,i0)') "GauXC returned with status code", status%status%code - IF (c_associated(status%status%message)) THEN - WRITE (0, '(a)', ADVANCE='no') "GauXC status message: [" + iw = cp_logger_get_default_io_unit() + IF (iw > 0) THEN + WRITE (iw, '(a,1x,i0)') "GauXC returned with status code", status%status%code + IF (c_associated(status%status%message)) THEN + WRITE (iw, '(a)', ADVANCE='no') "GauXC status message: [" - CALL c_f_pointer(status%status%message, s, [default_string_length]) - DO i = 1, SIZE(s) - IF (s(i) == c_null_char) EXIT - WRITE (0, '(A)', advance='no') s(i) - END DO + CALL c_f_pointer(status%status%message, s, [default_string_length]) + DO i = 1, SIZE(s) + IF (s(i) == c_null_char) EXIT + WRITE (iw, '(A)', advance='no') s(i) + END DO - WRITE (0, '(a)') "]" - ELSE - WRITE (0, '(a)') "GauXC status message: [null]" + WRITE (iw, '(a)') "]" + ELSE + WRITE (iw, '(a)') "GauXC status message: [null]" + END IF END IF #else MARK_USED(status) diff --git a/tools/conventions/conventions.supp b/tools/conventions/conventions.supp index cb4d2fb670..ef97e5c5e5 100644 --- a/tools/conventions/conventions.supp +++ b/tools/conventions/conventions.supp @@ -236,6 +236,7 @@ swarm_mpi.F: Found CLOSE statement in procedure "logger_init_master" https://cp2 swarm_mpi.F: Found OPEN statement in procedure "logger_finalize" https://cp2k.org/conv#c203 task_list_methods.F: Found WRITE statement with hardcoded unit in "generate_qs_task_list" https://cp2k.org/conv#c012 tblite_interface.F: Found CALL EXECUTE_COMMAND_LINE in procedure "tb_reference_cli_compare" https://cp2k.org/conv#c106 +tblite_interface.F: Found CALL EXECUTE_COMMAND_LINE in procedure "tb_reference_cli_execute" https://cp2k.org/conv#c106 tblite_interface.F: Found CLOSE statement in procedure "tb_add_stress" https://cp2k.org/conv#c204 tblite_interface.F: Found CLOSE statement in procedure "tb_delete_file" https://cp2k.org/conv#c204 tblite_interface.F: Found CLOSE statement in procedure "tb_dump_sigma_component" https://cp2k.org/conv#c204 @@ -252,6 +253,9 @@ tblite_interface.F: Found OPEN statement in procedure "tb_grad2force" https://cp tblite_interface.F: Found OPEN statement in procedure "tb_read_reference_grad" https://cp2k.org/conv#c203 tblite_interface.F: Found OPEN statement in procedure "tb_update_charges" https://cp2k.org/conv#c203 tblite_interface.F: Found OPEN statement in procedure "tb_write_reference_gen" https://cp2k.org/conv#c203 +tblite_scc_mixer.F: Found type cp2k_tblite_broyden_mixer_type without initializer https://cp2k.org/conv#c016 +tblite_scc_mixer.F: Module "mctc_env" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 +tblite_scc_mixer.F: Module "tblite_lapack" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 tblite_types.F: Found type tblite_type without initializer https://cp2k.org/conv#c016 tblite_types.F: Module "tblite_container" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 timings.F: Found WRITE statement with hardcoded unit in "timestop_handler" https://cp2k.org/conv#c012 @@ -274,6 +278,7 @@ topology_pdb.F: Found READ with unchecked STAT in "read_coordinate_pdb" https:// trexio.F: Found STOP statement in procedure "trexio_assert" https://cp2k.org/conv#c205 trexio.F: Found WRITE statement with hardcoded unit in "trexio_assert" https://cp2k.org/conv#c012 trexio_utils.F: Module "trexio" USEd without ONLY clause or not PRIVATE https://cp2k.org/conv#c002 +xc_gauxc_interface.F: Found type cp_gauxc_status_type without initializer https://cp2k.org/conv#c016 xyz2dcd.F: Found CLOSE statement in procedure "xyz2dcd" https://cp2k.org/conv#c204 xyz2dcd.F: Found OPEN statement in procedure "xyz2dcd" https://cp2k.org/conv#c203 xyz2dcd.F: Found STOP statement in procedure "abort_program" https://cp2k.org/conv#c205