comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-26 21:25:19 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix current coding conventions issues (#5305)

Browse source
This commit is contained in:
SY Wang 2026-05-28 05:07:30 +08:00 • committed by GitHub
parent d000247bb9
commit 0cecd9b435
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
4 changed files with 89 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

24
src/hfx_ace_methods.F
View file

@ -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))

106
src/qs_wannier90.F
View file

@ -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)

31
src/xc/xc_gauxc_interface.F
View file

@ -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)

5
tools/conventions/conventions.supp
View file

@ -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