Skip to content

Commit

Permalink
Specified INTENTs. Set pairs at once.
Browse files Browse the repository at this point in the history
  • Loading branch information
@hfp
hfp committed Jun 6, 2024
1 parent 09aa361 commit b4bdb02
Showing 1 changed file with 36 additions and 32 deletions.
68 changes: 36 additions & 32 deletions src/hfx_pair_list_methods.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -467,17 +467,20 @@ SUBROUTINE build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end
TYPE(pair_set_list_type), DIMENSION(:), &
INTENT(OUT) :: set_list
INTEGER, INTENT(IN) :: i_start, i_end, j_start, j_end
INTEGER :: kind_of(*)
TYPE(hfx_basis_type), DIMENSION(:), POINTER :: basis_parameter
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
INTEGER, INTENT(IN) :: kind_of(*)
TYPE(hfx_basis_type), DIMENSION(:), POINTER, &
INTENT(IN) :: basis_parameter
TYPE(particle_type), DIMENSION(:), POINTER, &
INTENT(IN) :: particle_set
LOGICAL, INTENT(IN) :: do_periodic
TYPE(hfx_screen_coeff_type), &
DIMENSION(:, :, :, :), POINTER :: coeffs_set
TYPE(hfx_screen_coeff_type), DIMENSION(:, :) :: coeffs_kind
DIMENSION(:, :, :, :), POINTER, INTENT(IN) :: coeffs_set
TYPE(hfx_screen_coeff_type), DIMENSION(:, :), &
INTENT(IN) :: coeffs_kind
REAL(KIND=dp), INTENT(IN) :: coeffs_kind_max0, log10_eps_schwarz
TYPE(cell_type), POINTER :: cell
REAL(dp) :: pmax_blocks
LOGICAL, DIMENSION(natom, natom) :: atomic_pair_list
REAL(dp), INTENT(IN) :: pmax_blocks
LOGICAL, DIMENSION(natom, natom), INTENT(IN) :: atomic_pair_list

INTEGER :: iatom, ikind, iset, jatom, jkind, jset, &
n_element, nset_ij, nseta, nsetb
Expand Down Expand Up @@ -513,10 +516,8 @@ SUBROUTINE build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end
coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE

n_element = n_element + 1
list%elements(n_element)%pair(1) = iatom
list%elements(n_element)%pair(2) = jatom
list%elements(n_element)%kind_pair(1) = ikind
list%elements(n_element)%kind_pair(2) = jkind
list%elements(n_element)%pair = (/iatom, jatom/)
list%elements(n_element)%kind_pair = (/ikind, jkind/)
list%elements(n_element)%r1 = ra
list%elements(n_element)%r2 = B11
list%elements(n_element)%dist2 = rab2
Expand All @@ -527,8 +528,7 @@ SUBROUTINE build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end
IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + coeffs_set(jset, iset, jkind, ikind)%x(2) + &
coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE
nset_ij = nset_ij + 1
set_list(nset_ij)%pair(1) = iset
set_list(nset_ij)%pair(2) = jset
set_list(nset_ij)%pair = (/iset, jset/)
END DO
END DO
list%elements(n_element)%set_bounds(2) = nset_ij
Expand Down Expand Up @@ -558,14 +558,18 @@ SUBROUTINE build_atomic_pair_list(natom, atomic_pair_list, kind_of, basis_parame
blocks)
INTEGER, INTENT(IN) :: natom
LOGICAL, DIMENSION(natom, natom) :: atomic_pair_list
INTEGER :: kind_of(*)
TYPE(hfx_basis_type), DIMENSION(:), POINTER :: basis_parameter
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
INTEGER, INTENT(IN) :: kind_of(*)
TYPE(hfx_basis_type), DIMENSION(:), POINTER, &
INTENT(IN) :: basis_parameter
TYPE(particle_type), DIMENSION(:), POINTER, &
INTENT(IN) :: particle_set
LOGICAL, INTENT(IN) :: do_periodic
TYPE(hfx_screen_coeff_type), DIMENSION(:, :) :: coeffs_kind
TYPE(hfx_screen_coeff_type), DIMENSION(:, :), &
INTENT(IN) :: coeffs_kind
REAL(KIND=dp), INTENT(IN) :: coeffs_kind_max0, log10_eps_schwarz
TYPE(cell_type), POINTER :: cell
TYPE(hfx_block_range_type), DIMENSION(:), POINTER :: blocks
TYPE(hfx_block_range_type), DIMENSION(:), &
POINTER, INTENT(IN) :: blocks

INTEGER :: iatom, iatom_end, iatom_start, iblock, &
ikind, jatom, jatom_end, jatom_start, &
Expand Down Expand Up @@ -644,18 +648,21 @@ SUBROUTINE build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j
TYPE(pair_set_list_type), DIMENSION(:), &
INTENT(OUT) :: set_list
INTEGER, INTENT(IN) :: i_start, i_end, j_start, j_end
INTEGER :: kind_of(*)
TYPE(hfx_basis_type), DIMENSION(:), POINTER :: basis_parameter
TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
INTEGER, INTENT(IN) :: kind_of(*)
TYPE(hfx_basis_type), DIMENSION(:), POINTER, &
INTENT(IN) :: basis_parameter
TYPE(particle_type), DIMENSION(:), POINTER, &
INTENT(IN) :: particle_set
LOGICAL, INTENT(IN) :: do_periodic
TYPE(hfx_screen_coeff_type), &
DIMENSION(:, :, :, :), POINTER :: coeffs_set
TYPE(hfx_screen_coeff_type), DIMENSION(:, :) :: coeffs_kind
DIMENSION(:, :, :, :), POINTER, INTENT(IN) :: coeffs_set
TYPE(hfx_screen_coeff_type), DIMENSION(:, :), &
INTENT(IN) :: coeffs_kind
REAL(KIND=dp), INTENT(IN) :: coeffs_kind_max0, log10_eps_schwarz
TYPE(cell_type), POINTER :: cell
REAL(dp) :: pmax_blocks
LOGICAL, DIMENSION(natom, natom) :: atomic_pair_list
LOGICAL, OPTIONAL :: skip_atom_symmetry
REAL(dp), INTENT(IN) :: pmax_blocks
LOGICAL, DIMENSION(natom, natom), INTENT(IN) :: atomic_pair_list
LOGICAL, OPTIONAL, INTENT(IN) :: skip_atom_symmetry

INTEGER :: iatom, ikind, iset, jatom, jkind, jset, &
n_element, nset_ij, nseta, nsetb
Expand Down Expand Up @@ -695,10 +702,8 @@ SUBROUTINE build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j
coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE

n_element = n_element + 1
list%elements(n_element)%pair(1) = iatom
list%elements(n_element)%pair(2) = jatom
list%elements(n_element)%kind_pair(1) = ikind
list%elements(n_element)%kind_pair(2) = jkind
list%elements(n_element)%pair = (/iatom, jatom/)
list%elements(n_element)%kind_pair = (/ikind, jkind/)
list%elements(n_element)%r1 = ra
list%elements(n_element)%r2 = B11
list%elements(n_element)%dist2 = rab2
Expand All @@ -709,8 +714,7 @@ SUBROUTINE build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j
IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + coeffs_set(jset, iset, jkind, ikind)%x(2) + &
coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE
nset_ij = nset_ij + 1
set_list(nset_ij)%pair(1) = iset
set_list(nset_ij)%pair(2) = jset
set_list(nset_ij)%pair = (/iset, jset/)
END DO
END DO
list%elements(n_element)%set_bounds(2) = nset_ij
Expand Down

0 comments on commit b4bdb02

Please sign in to comment.