Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Test mesh-wide trial selection, repair and MO-gauge covariance.
10 : !> \author Thomas D. Kuehne, tkuehne@cp2k.org
11 : ! **************************************************************************************************
12 8 : PROGRAM wannier90_projections_unittest
13 : #if defined (__HAS_IEEE_EXCEPTIONS)
14 : USE ieee_exceptions, ONLY: IEEE_ALL, ieee_get_halting_mode, ieee_set_halting_mode
15 : #endif
16 2 : USE kinds, ONLY: dp
17 : USE message_passing, ONLY: mp_comm_type, mp_para_env_release, mp_para_env_type, mp_world_finalize, mp_world_init
18 : USE wannier90_projections, ONLY: wannier90_hybrid_candidates, wannier90_projection_rank, &
19 : wannier90_select_projections, wannier90_window_mask
20 : #include "./base/base_uses.f90"
21 :
22 : IMPLICIT NONE
23 :
24 2 : COMPLEX(KIND=dp), ALLOCATABLE :: candidates(:, :, :), hybrids(:, :, :)
25 : COMPLEX(KIND=dp) :: amn(2, 2, 2), reference(2, 2, 2), repaired(2, 2, 3), rotation(2, 2), quartet(2, 4)
26 : INTEGER, PARAMETER :: groups(4, 2) = RESHAPE([1, 2, 3, 4, 4, 1, 2, 3], [4, 2])
27 : INTEGER :: anchor, ik, nfail, pivots(2)
28 : LOGICAL :: allowed(4)
29 : REAL(KIND=dp) :: angle, min_svalue
30 : TYPE(mp_comm_type) :: comm
31 : TYPE(mp_para_env_type), POINTER :: para_env
32 : #if defined (__HAS_IEEE_EXCEPTIONS)
33 : COMPLEX(KIND=dp) :: rectangular(4, 3, 2)
34 : LOGICAL :: saved_halt(SIZE(IEEE_ALL)), actual_halt(SIZE(IEEE_ALL))
35 : #endif
36 :
37 2 : CALL mp_world_init(comm)
38 2 : ALLOCATE (para_env)
39 2 : CALL para_env%from_dup(comm)
40 2 : nfail = 0
41 : #if defined (__HAS_IEEE_EXCEPTIONS)
42 : CALL ieee_get_halting_mode(IEEE_ALL, saved_halt)
43 : #endif
44 2 : IF (para_env%is_source()) THEN
45 1 : ALLOCATE (candidates(2, 3, 2))
46 1 : candidates = CMPLX(0.0_dp, 0.0_dp, KIND=dp)
47 : ! The strongest stacked column vanishes at the second k-point.
48 1 : candidates(1, 1, 1) = 5.0_dp
49 3 : candidates(2, 2, :) = 2.0_dp
50 3 : candidates(1, 3, :) = 0.4_dp
51 : ELSE
52 1 : ALLOCATE (candidates(0, 0, 0))
53 : END IF
54 2 : CALL wannier90_select_projections(candidates, para_env, amn, pivots, min_svalue, anchor_kpoint=0)
55 2 : IF (.NOT. (min_svalue <= 1.0E-14_dp)) nfail = nfail + 1
56 2 : CALL wannier90_select_projections(candidates, para_env, amn, pivots, min_svalue)
57 6 : IF (.NOT. (ABS(min_svalue - 0.4_dp) <= 1.0E-14_dp) .OR. ANY(pivots /= [2, 3])) nfail = nfail + 1
58 2 : reference = amn
59 6 : DO ik = 1, 2
60 4 : angle = 0.31_dp*REAL(ik, KIND=dp)
61 28 : rotation = CMPLX(0.0_dp, SIN(angle), KIND=dp)
62 4 : rotation(1, 1) = COS(angle)
63 4 : rotation(2, 2) = COS(angle)
64 106 : IF (para_env%is_source()) candidates(:, :, ik) = MATMUL(rotation, candidates(:, :, ik))
65 110 : reference(:, :, ik) = MATMUL(rotation, reference(:, :, ik))
66 : END DO
67 2 : CALL wannier90_select_projections(candidates, para_env, amn, pivots, min_svalue)
68 2 : IF (.NOT. (ABS(min_svalue - 0.4_dp) <= 1.0E-14_dp)) nfail = nfail + 1
69 36 : IF (ANY(pivots /= [2, 3]) .OR. .NOT. ALL(ABS(amn - reference) <= 1.0E-14_dp)) nfail = nfail + 1
70 2 : IF (para_env%is_source()) candidates = CMPLX(0.0_dp, 0.0_dp, KIND=dp)
71 2 : CALL wannier90_select_projections(candidates, para_env, amn, pivots, min_svalue)
72 2 : IF (.NOT. (min_svalue == 0.0_dp)) nfail = nfail + 1
73 2 : IF (para_env%is_source()) THEN
74 : ! Numerically tied columns retain the reproducible original-index ordering.
75 3 : candidates(1, 1, :) = 1.0_dp
76 3 : candidates(1, 2, :) = 1.0_dp + 1.0E-14_dp
77 3 : candidates(2, 3, :) = 1.0_dp
78 : END IF
79 2 : CALL wannier90_select_projections(candidates, para_env, amn, pivots, min_svalue)
80 6 : IF (ANY(pivots /= [1, 3])) nfail = nfail + 1
81 2 : DEALLOCATE (candidates)
82 :
83 2 : IF (para_env%is_source()) THEN
84 1 : ALLOCATE (candidates(2, 4, 3))
85 1 : candidates = CMPLX(0.0_dp, 0.0_dp, KIND=dp)
86 1 : candidates(1, 1, 1) = 10.0_dp
87 1 : candidates(1, 1, 3) = 10.0_dp
88 1 : candidates(2, 2, 2) = 10.0_dp
89 1 : candidates(2, 2, 3) = 10.0_dp
90 4 : candidates(1, 3, :) = 1.0_dp
91 4 : candidates(2, 4, :) = 1.0_dp
92 : ELSE
93 1 : ALLOCATE (candidates(0, 0, 0))
94 : END IF
95 : ! Every fixed anchor is rank-deficient somewhere; automatic selection must repair it.
96 10 : DO anchor = 0, 3
97 8 : CALL wannier90_select_projections(candidates, para_env, repaired, pivots, min_svalue, anchor)
98 10 : IF (.NOT. (min_svalue <= 1.0E-14_dp)) nfail = nfail + 1
99 : END DO
100 2 : CALL wannier90_select_projections(candidates, para_env, repaired, pivots, min_svalue)
101 6 : IF (.NOT. (ABS(min_svalue - 1.0_dp) <= 1.0E-14_dp) .OR. ANY(pivots /= [3, 4])) nfail = nfail + 1
102 2 : CALL wannier90_hybrid_candidates(candidates, groups, hybrids)
103 2 : IF (para_env%is_source()) THEN
104 4 : CPASSERT(ALL(SHAPE(hybrids) == [2, 8, 3]))
105 4 : DO ik = 1, 3
106 10 : DO anchor = 1, SIZE(groups, 2)
107 78 : quartet = hybrids(:, 4*anchor - 3:4*anchor, ik)
108 66 : IF (.NOT. ALL(ABS(0.5_dp*SUM(quartet, DIM=2) - candidates(:, groups(1, anchor), ik)) &
109 0 : <= 1.0E-14_dp)) nfail = nfail + 1
110 42 : IF (.NOT. ALL(ABS(MATMUL(quartet, CONJG(TRANSPOSE(quartet))) - &
111 24 : MATMUL(candidates(:, :, ik), CONJG(TRANSPOSE(candidates(:, :, ik))))) &
112 423 : <= 1.0E-14_dp)) nfail = nfail + 1
113 : END DO
114 : END DO
115 : ELSE
116 4 : IF (SIZE(hybrids) /= 0) nfail = nfail + 1
117 : END IF
118 2 : DEALLOCATE (hybrids, candidates)
119 :
120 : CALL wannier90_window_mask([-2.0_dp, -1.0_dp, 1.0_dp, 2.0_dp], 2, [-1.5_dp, 1.5_dp, 0.0_dp, 0.0_dp], &
121 2 : [.TRUE., .TRUE., .FALSE., .FALSE.], allowed)
122 10 : IF (ANY(allowed .NEQV. [.FALSE., .TRUE., .TRUE., .FALSE.])) nfail = nfail + 1
123 : CALL wannier90_window_mask([-2.0_dp, -1.0_dp, 1.0_dp, 2.0_dp], 2, [-3.0_dp, 3.0_dp, 0.0_dp, 0.0_dp], &
124 2 : [.TRUE., .TRUE., .FALSE., .TRUE.], allowed)
125 10 : IF (ANY(allowed .NEQV. [.TRUE., .TRUE., .FALSE., .FALSE.])) nfail = nfail + 1
126 : #if defined (__HAS_IEEE_EXCEPTIONS)
127 : rectangular = CMPLX(0.0_dp, 0.0_dp, KIND=dp)
128 : DO ik = 1, 3
129 : rectangular(ik, ik, :) = REAL(ik, KIND=dp)
130 : rectangular(4, ik, :) = CMPLX(0.2_dp*ik, 0.1_dp, KIND=dp)
131 : END DO
132 : min_svalue = wannier90_projection_rank(rectangular)
133 : CALL ieee_get_halting_mode(IEEE_ALL, actual_halt)
134 : IF (ANY(actual_halt .NEQV. saved_halt)) nfail = nfail + 1
135 : CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.)
136 : IF (.NOT. (ABS(wannier90_projection_rank(rectangular) - min_svalue) <= 1.0E-14_dp)) nfail = nfail + 1
137 : CALL ieee_get_halting_mode(IEEE_ALL, actual_halt)
138 : IF (ANY(actual_halt)) nfail = nfail + 1
139 : CALL ieee_set_halting_mode(IEEE_ALL, saved_halt)
140 : #endif
141 2 : CALL comm%sum(nfail)
142 2 : CPASSERT(nfail == 0)
143 2 : CALL mp_para_env_release(para_env)
144 2 : CALL mp_world_finalize()
145 2 : END PROGRAM wannier90_projections_unittest
|
