scnc
/
phono3py
mirror of https://github.com/phonopy/phono3py.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fortran wrapper test of gridsys_get_bz_triplets_at_q

This commit is contained in:
Atsushi Togo 2023-02-01 12:43:45 +09:00
parent c52857468b
commit ac9c81e9cf
1 changed files with 72 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
ctest/fortran/gridsysf/test_gridsysf.f90
View File

@ -2,10 +2,12 @@ program test_gridsysf
use, intrinsic :: iso_c_binding
use gridsysf, only: &
gridsys_get_bz_grid_addresses, &
gridsys_get_triplets_at_q
gridsys_get_triplets_at_q, &
gridsys_get_bz_triplets_at_q
implicit none
integer(c_long) :: wurtzite_rec_rotations_without_time_reversal(3, 3, 12)
integer(c_long) :: wurtzite_tilde_rec_rotations_without_time_reversal(3, 3, 12)
wurtzite_rec_rotations_without_time_reversal(:, :, :) = &
reshape([1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, -1, 0, 0, 0, 0, 1, &
@ -15,13 +17,30 @@ program test_gridsysf
1, 0, 0, -1, -1, 0, 0, 0, 1, 0, -1, 0, -1, 0, 0, 0, 0, 1, &
-1, -1, 0, 0, 1, 0, 0, 0, 1, -1, 0, 0, 1, 1, 0, 0, 0, 1], [3, 3, 12])
write (*, '("[test_gridsys_get_bz_grid_addresses]")')
call test_gridsys_get_bz_grid_addresses()
write (*, '("[test_gridsys_get_triplets_at_q]")')
call test_gridsys_get_triplets_at_q()
wurtzite_tilde_rec_rotations_without_time_reversal(:, :, :) = &
reshape([1, 0, 0, 0, 1, 0, 0, 0, 1, &
1, -1, 0, -5, 0, -2, 0, 3, 1, &
6, -1, 2, -5, -1, -2, -15, 3, -5, &
11, 0, 4, 0, -1, 0, -30, 0, -11, &
11, 1, 4, 5, 0, 2, -30, -3, -11, &
6, 1, 2, 5, 1, 2, -15, -3, -5,&
6, -1, 2, 5, 0, 2, -15, 3, -5,&
1, -1, 0, 0, -1, 0, 0, 3, 1,&
1, 0, 0, -5, -1, -2, 0, 0, 1,&
6, 1, 2, -5, 0, -2, -15, -3, -5,&
11, 1, 4, 0, 1, 0, -30, -3, -11,&
11, 0, 4, 5, 1, 2, -30, 0, -11], [3, 3, 12])
write (*, '("[test_gridsys_get_bz_grid_addresses_wurtzite]")')
call test_gridsys_get_bz_grid_addresses_wurtzite()
write (*, '("[test_gridsys_get_triplets_at_q_wurtzite]")')
call test_gridsys_get_triplets_at_q_wurtzite()
write (*, '("[test_gridsys_get_bz_triplets_at_q_wurtzite_force_SNF]")')
call test_gridsys_get_bz_triplets_at_q_wurtzite_force_SNF()
contains
subroutine test_gridsys_get_bz_grid_addresses() bind(C)
subroutine test_gridsys_get_bz_grid_addresses_wurtzite() bind(C)
integer(c_long) :: bz_size
integer(c_long) :: PS(3), D_diag(3), Q(3, 3), bz_grid_addresses(3, 144)
integer(c_long) :: bz_map(76), bzg2grg(144)
@ -88,12 +107,11 @@ contains
write (*, '("check bzg2grg")', advance='no')
call assert_1D_array_c_long(bzg2grg, ref_bzg2grg, 93)
write (*, '(" OK")')
end subroutine test_gridsys_get_bz_grid_addresses
end subroutine test_gridsys_get_bz_grid_addresses_wurtzite
subroutine test_gridsys_get_triplets_at_q() bind(C)
subroutine test_gridsys_get_triplets_at_q_wurtzite() bind(C)
integer(c_long) :: D_diag(3)
integer(c_long) :: map_triplets(36), map_q(36)
integer(c_long) :: rec_rotations(3, 3, 12)
integer(c_long) :: grid_point, is_time_reversal, num_rot, swappable
integer :: i, j, k, n_ir_triplets
@ -152,7 +170,51 @@ contains
k = k + 1
end do
end do
end subroutine test_gridsys_get_triplets_at_q
end subroutine test_gridsys_get_triplets_at_q_wurtzite
subroutine test_gridsys_get_bz_triplets_at_q_wurtzite_force_SNF() bind(C)
integer(c_long) :: D_diag(3)
integer(c_long) :: PS(3)
integer(c_long) :: Q(3, 3)
integer(c_long) :: map_triplets(75), map_q(75)
real(c_double) :: rec_lattice(3, 3)
integer(c_long) :: grid_point, is_time_reversal, num_rot, num_gp, swappable
integer :: i, j, k, ll, num_triplets_1, num_triplets_2, bz_size
integer(c_long) :: triplets(3, 75)
integer(c_long) :: bz_grid_addresses(3, 108)
integer(c_long) :: bz_map(75)
integer(c_long) :: bzg2grg(108)
grid_point = 1
num_rot = 12
num_gp = 75
D_diag(:) = [1, 5, 15]
PS(:) = [0, 0, 0]
Q(:, :) = reshape([-1, 0, -6, 0, -1, 0, -1, 0, -5], [3, 3])
rec_lattice(:, :) = reshape([0.3214400514304082, 0.0, 0.0, &
0.1855835002216734, 0.3711670004433468, 0.0, &
0.0, 0.0, 0.20088388911209323], [3, 3])
bz_size = gridsys_get_bz_grid_addresses( &
bz_grid_addresses, bz_map, bzg2grg, &
D_diag, Q, PS, rec_lattice, int(2, c_long))
do j = 0, 1
swappable = 1 - j
do k = 0, 1
is_time_reversal = 1 - k
num_triplets_1 = gridsys_get_triplets_at_q( &
map_triplets, map_q, grid_point, D_diag, &
is_time_reversal, num_rot, &
wurtzite_tilde_rec_rotations_without_time_reversal, swappable)
num_triplets_2 = gridsys_get_bz_triplets_at_q( &
triplets, grid_point, bz_grid_addresses, bz_map, &
map_triplets, num_gp, D_diag, Q, int(2, c_long))
call assert_int(num_triplets_1, num_triplets_2)
end do
end do
end subroutine test_gridsys_get_bz_triplets_at_q_wurtzite_force_SNF
subroutine assert_int(val, ref_val)
integer, intent(in) :: val, ref_val