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 Read explicit Wannier90 overlap connections, including nonuniform closed loops.
10 : ! **************************************************************************************************
11 : MODULE wannier90_nnkpts
12 : USE cp_files, ONLY: close_file,&
13 : open_file
14 : USE ieee_arithmetic, ONLY: ieee_is_finite
15 : USE kinds, ONLY: dp
16 : USE string_utilities, ONLY: lowercase
17 : #include "./base/base_uses.f90"
18 :
19 : IMPLICIT NONE
20 : PRIVATE
21 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'wannier90_nnkpts'
22 : ! Absolute file-format tolerances: Angstrom and reciprocal Angstrom, respectively.
23 : REAL(KIND=dp), PARAMETER :: real_lattice_tol = 1.e-6_dp, recip_lattice_tol = 1.e-6_dp
24 : PUBLIC :: read_wannier90_nnkpts
25 : CONTAINS
26 :
27 : ! **************************************************************************************************
28 : !> \brief Read and validate the cell, points, and directed connections of an nnkp file.
29 : !> \param filename input file
30 : !> \param real_lattice direct lattice vectors as columns, in Angstrom
31 : !> \param recip_lattice reciprocal lattice vectors as columns, in inverse Angstrom (including 2*pi)
32 : !> \param kpt fractional k-points, without coordinate wrapping
33 : !> \param nnlist target point for each directed connection
34 : !> \param nncell reciprocal lattice translation for each connection
35 : ! **************************************************************************************************
36 2 : SUBROUTINE read_wannier90_nnkpts(filename, real_lattice, recip_lattice, kpt, nnlist, nncell)
37 : CHARACTER(len=*), INTENT(IN) :: filename
38 : REAL(KIND=dp), INTENT(IN) :: real_lattice(3, 3), recip_lattice(3, 3)
39 : REAL(KIND=dp), ALLOCATABLE, INTENT(OUT) :: kpt(:, :)
40 : INTEGER, ALLOCATABLE, INTENT(OUT) :: nnlist(:, :), nncell(:, :, :)
41 :
42 : CHARACTER(len=1024) :: line
43 : CHARACTER(len=64) :: block, marker
44 : INTEGER :: i, ios, j, n, nexclude, nneigh, origin, &
45 : shift(3), TARGET, unit
46 2 : INTEGER, ALLOCATABLE :: counts(:)
47 : LOGICAL :: have_real, have_recip
48 : REAL(KIND=dp) :: lattice(3, 3)
49 :
50 2 : have_real = .FALSE.
51 2 : have_recip = .FALSE.
52 2 : CALL open_file(filename, unit_number=unit, file_status="OLD", file_action="READ")
53 10 : DO
54 10 : CALL next_line(unit, line, ios)
55 10 : IF (ios < 0) EXIT
56 8 : IF (ios /= 0) CPABORT("NNKP_FILE: read error.")
57 8 : marker = ""
58 8 : block = ""
59 8 : READ (line, *, IOSTAT=ios) marker, block
60 8 : IF (ios /= 0) CYCLE
61 8 : CALL lowercase(marker)
62 8 : CALL lowercase(block)
63 8 : IF (marker /= "begin") CYCLE
64 2 : SELECT CASE (TRIM(block))
65 : CASE ("real_lattice", "recip_lattice")
66 16 : DO i = 1, 3
67 12 : CALL required_line(unit, line)
68 12 : READ (line, *, IOSTAT=ios) lattice(:, i)
69 16 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid lattice vector.")
70 : END DO
71 52 : IF (.NOT. ALL(ieee_is_finite(lattice))) CPABORT("NNKP_FILE: nonfinite lattice.")
72 4 : IF (block == "real_lattice") THEN
73 2 : IF (have_real) CPABORT("NNKP_FILE: duplicate real_lattice block.")
74 26 : IF (MAXVAL(ABS(lattice - real_lattice)) > real_lattice_tol) THEN
75 0 : CPABORT("NNKP_FILE: real lattice differs from the CP2K cell (Angstrom).")
76 : END IF
77 : have_real = .TRUE.
78 : ELSE
79 2 : IF (have_recip) CPABORT("NNKP_FILE: duplicate recip_lattice block.")
80 26 : IF (MAXVAL(ABS(lattice - recip_lattice)) > recip_lattice_tol) THEN
81 0 : CPABORT("NNKP_FILE: reciprocal lattice differs from the CP2K cell.")
82 : END IF
83 : have_recip = .TRUE.
84 : END IF
85 4 : CALL end_block(unit, block)
86 : CASE ("kpoints")
87 2 : IF (ALLOCATED(kpt)) CPABORT("NNKP_FILE: duplicate kpoints block.")
88 2 : CALL required_line(unit, line)
89 2 : READ (line, *, IOSTAT=ios) n
90 2 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid point count.")
91 2 : IF (n < 1) CPABORT("NNKP_FILE: point count must be positive.")
92 6 : ALLOCATE (kpt(3, n))
93 10 : DO i = 1, n
94 8 : CALL required_line(unit, line)
95 8 : READ (line, *, IOSTAT=ios) kpt(:, i)
96 10 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid k-point.")
97 : END DO
98 34 : IF (.NOT. ALL(ieee_is_finite(kpt))) CPABORT("NNKP_FILE: nonfinite k-point.")
99 2 : CALL end_block(unit, block)
100 : CASE ("nnkpts")
101 2 : IF (.NOT. ALLOCATED(kpt)) CPABORT("NNKP_FILE: kpoints must precede nnkpts.")
102 2 : IF (ALLOCATED(nnlist)) CPABORT("NNKP_FILE: duplicate nnkpts block.")
103 2 : CALL required_line(unit, line)
104 2 : READ (line, *, IOSTAT=ios) nneigh
105 2 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid neighbour count.")
106 2 : IF (nneigh < 1) CPABORT("NNKP_FILE: neighbour count must be positive.")
107 2 : n = SIZE(kpt, 2)
108 18 : ALLOCATE (nnlist(n, nneigh), nncell(3, n, nneigh), counts(n))
109 2 : counts = 0
110 10 : DO i = 1, n*nneigh
111 8 : CALL required_line(unit, line)
112 8 : READ (line, *, IOSTAT=ios) origin, TARGET, shift
113 8 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid connection.")
114 8 : IF (MIN(origin, TARGET) < 1 .OR. MAX(origin, TARGET) > n) THEN
115 0 : CPABORT("NNKP_FILE: connection point index out of range.")
116 : END IF
117 8 : IF (counts(origin) == nneigh) CPABORT("NNKP_FILE: too many neighbours for a point.")
118 8 : DO j = 1, counts(origin)
119 8 : IF (nnlist(origin, j) == TARGET .AND. ALL(nncell(:, origin, j) == shift)) THEN
120 0 : CPABORT("NNKP_FILE: duplicate connection.")
121 : END IF
122 : END DO
123 8 : counts(origin) = counts(origin) + 1
124 8 : nnlist(origin, counts(origin)) = TARGET
125 34 : nncell(:, origin, counts(origin)) = shift
126 : END DO
127 10 : IF (ANY(counts /= nneigh)) CPABORT("NNKP_FILE: missing connections.")
128 2 : DEALLOCATE (counts)
129 2 : CALL end_block(unit, block)
130 : CASE ("exclude_bands")
131 0 : CALL required_line(unit, line)
132 0 : READ (line, *, IOSTAT=ios) nexclude
133 0 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid exclude_bands count.")
134 0 : IF (nexclude /= 0) CPABORT("NNKP_FILE: specify band exclusions using CP2K EXCLUDE_BANDS.")
135 0 : CALL end_block(unit, block)
136 : CASE DEFAULT
137 : ! Skip projections and other Wannier90 blocks not required for overlaps.
138 8 : DO
139 0 : CALL required_line(unit, line)
140 0 : marker = ""
141 0 : READ (line, *, IOSTAT=ios) marker
142 0 : IF (ios /= 0) CPABORT("NNKP_FILE: invalid line in unused block.")
143 0 : CALL lowercase(marker)
144 0 : IF (marker == "end") EXIT
145 : END DO
146 : END SELECT
147 : END DO
148 2 : CALL close_file(unit)
149 2 : IF (.NOT. have_real .OR. .NOT. have_recip) CPABORT("NNKP_FILE: missing lattice blocks.")
150 2 : IF (.NOT. ALLOCATED(kpt) .OR. .NOT. ALLOCATED(nnlist)) THEN
151 0 : CPABORT("NNKP_FILE: missing kpoints or nnkpts block.")
152 : END IF
153 2 : END SUBROUTINE read_wannier90_nnkpts
154 :
155 : ! **************************************************************************************************
156 : !> \brief Read a nonempty line, removing comments.
157 : !> \param unit input unit
158 : !> \param line resulting line
159 : !> \param ios IO status
160 : ! **************************************************************************************************
161 50 : SUBROUTINE next_line(unit, line, ios)
162 : INTEGER, INTENT(IN) :: unit
163 : CHARACTER(len=*), INTENT(OUT) :: line
164 : INTEGER, INTENT(OUT) :: ios
165 :
166 : INTEGER :: i
167 :
168 : DO
169 50 : READ (unit, '(A)', IOSTAT=ios) line
170 50 : IF (ios /= 0) RETURN
171 48 : i = SCAN(line, "!#")
172 48 : IF (i > 0) line(i:) = ""
173 48 : line = ADJUSTL(line)
174 48 : IF (LEN_TRIM(line) > 0) RETURN
175 : END DO
176 50 : END SUBROUTINE next_line
177 :
178 : ! **************************************************************************************************
179 : !> \brief Read a required nonempty line.
180 : !> \param unit input unit
181 : !> \param line resulting line
182 : ! **************************************************************************************************
183 40 : SUBROUTINE required_line(unit, line)
184 : INTEGER, INTENT(IN) :: unit
185 : CHARACTER(len=*), INTENT(OUT) :: line
186 :
187 : INTEGER :: ios
188 :
189 40 : CALL next_line(unit, line, ios)
190 40 : IF (ios /= 0) CPABORT("NNKP_FILE: unexpected end of file or read error.")
191 40 : END SUBROUTINE required_line
192 :
193 : ! **************************************************************************************************
194 : !> \brief Check a block terminator.
195 : !> \param unit input unit
196 : !> \param block expected block name
197 : ! **************************************************************************************************
198 8 : SUBROUTINE end_block(unit, block)
199 : INTEGER, INTENT(IN) :: unit
200 : CHARACTER(len=*), INTENT(IN) :: block
201 :
202 : CHARACTER(len=1024) :: line
203 : CHARACTER(len=64) :: marker, name
204 : INTEGER :: ios
205 :
206 8 : CALL required_line(unit, line)
207 8 : READ (line, *, IOSTAT=ios) marker, name
208 8 : IF (ios /= 0) CPABORT("NNKP_FILE: missing block terminator.")
209 8 : CALL lowercase(marker)
210 8 : CALL lowercase(name)
211 8 : IF (marker /= "end" .OR. name /= block) CPABORT("NNKP_FILE: incorrect block terminator.")
212 8 : END SUBROUTINE end_block
213 :
214 : END MODULE wannier90_nnkpts
|
