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 Routines for reading and writing NEGF restart files.
10 : !> \author Dmitry Ryndyk (12.2025)
11 : ! **************************************************************************************************
12 : MODULE negf_io
13 :
14 : USE cp_files, ONLY: close_file,&
15 : open_file
16 : USE cp_log_handling, ONLY: cp_logger_generate_filename,&
17 : cp_logger_type
18 : USE cp_output_handling, ONLY: cp_iter_string
19 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
20 : section_vals_type,&
21 : section_vals_val_get
22 : USE kinds, ONLY: default_path_length,&
23 : default_string_length,&
24 : dp
25 : #include "./base/base_uses.f90"
26 :
27 : IMPLICIT NONE
28 :
29 : PRIVATE
30 :
31 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'negf_io'
32 :
33 : PUBLIC :: negf_restart_file_name, &
34 : negf_print_matrix_to_file, &
35 : negf_read_matrix_from_file
36 :
37 : CONTAINS
38 :
39 : ! **************************************************************************************************
40 : !> \brief Checks if the restart file exists and returns the filename.
41 : !> \param filename ...
42 : !> \param exist ...
43 : !> \param negf_section ...
44 : !> \param logger ...
45 : !> \param icontact ...
46 : !> \param ispin ...
47 : !> \param h00 ...
48 : !> \param h01 ...
49 : !> \param s00 ...
50 : !> \param s01 ...
51 : !> \param h ...
52 : !> \param s ...
53 : !> \param hc ...
54 : !> \param sc ...
55 : !> \param h_scf ...
56 : !> \par History
57 : !> * 12.2025 created [Dmitry Ryndyk]
58 : ! **************************************************************************************************
59 2 : SUBROUTINE negf_restart_file_name(filename, exist, negf_section, logger, icontact, ispin, h00, h01, &
60 : s00, s01, h, s, hc, sc, h_scf)
61 : CHARACTER(LEN=default_path_length), INTENT(OUT) :: filename
62 : LOGICAL, INTENT(OUT) :: exist
63 : TYPE(section_vals_type), POINTER :: negf_section
64 : TYPE(cp_logger_type), POINTER :: logger
65 : INTEGER, INTENT(IN), OPTIONAL :: icontact, ispin
66 : LOGICAL, INTENT(IN), OPTIONAL :: h00, h01, s00, s01, h, s, hc, sc, h_scf
67 :
68 : CHARACTER(len=default_string_length) :: middle_name, string1, string2
69 : LOGICAL :: my_h, my_h00, my_h01, my_h_scf, my_hc, &
70 : my_s, my_s00, my_s01, my_sc
71 : TYPE(section_vals_type), POINTER :: contact_section, print_key
72 :
73 2 : my_h00 = .FALSE.
74 2 : IF (PRESENT(h00)) my_h00 = h00
75 2 : my_h01 = .FALSE.
76 2 : IF (PRESENT(h01)) my_h01 = h01
77 2 : my_s00 = .FALSE.
78 2 : IF (PRESENT(s00)) my_s00 = s00
79 2 : my_s01 = .FALSE.
80 2 : IF (PRESENT(s01)) my_s01 = s01
81 2 : my_h = .FALSE.
82 2 : IF (PRESENT(h)) my_h = h
83 2 : my_s = .FALSE.
84 2 : IF (PRESENT(s)) my_s = s
85 2 : my_hc = .FALSE.
86 2 : IF (PRESENT(hc)) my_hc = hc
87 2 : my_sc = .FALSE.
88 2 : IF (PRESENT(sc)) my_sc = sc
89 2 : my_h_scf = .FALSE.
90 2 : IF (PRESENT(h_scf)) my_h_scf = h_scf
91 :
92 2 : exist = .FALSE.
93 :
94 2 : IF (my_h00 .OR. my_h01 .OR. my_s00 .OR. my_s01) THEN
95 0 : IF (.NOT. PRESENT(icontact)) THEN
96 0 : CPABORT("Missing contact index for NEGF restart filename")
97 : END IF
98 0 : WRITE (string1, *) icontact
99 :
100 0 : IF (my_h00 .OR. my_h01) THEN
101 0 : IF (.NOT. PRESENT(ispin)) THEN
102 0 : CPABORT("Missing spin index for NEGF restart filename")
103 : END IF
104 0 : WRITE (string2, *) ispin
105 : END IF
106 :
107 : ! Try to read from the filename that is generated automatically from the print key.
108 0 : contact_section => section_vals_get_subs_vals(negf_section, "CONTACT")
109 0 : print_key => section_vals_get_subs_vals(contact_section, "RESTART", i_rep_section=icontact)
110 :
111 0 : IF (my_h00) THEN
112 0 : IF (ispin == 0) THEN
113 0 : middle_name = "N"//TRIM(string1)//"-H00"
114 : ELSE
115 0 : middle_name = "N"//TRIM(string1)//"-H00-S"//TRIM(string2)
116 : END IF
117 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
118 0 : extension=".hs", my_local=.FALSE.)
119 : END IF
120 :
121 0 : IF (my_h01) THEN
122 0 : IF (ispin == 0) THEN
123 0 : middle_name = "N"//TRIM(string1)//"-H01"
124 : ELSE
125 0 : middle_name = "N"//TRIM(string1)//"-H01-S"//TRIM(string2)
126 : END IF
127 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
128 0 : extension=".hs", my_local=.FALSE.)
129 : END IF
130 :
131 0 : IF (my_s00) THEN
132 0 : middle_name = "N"//TRIM(string1)//"-S00"
133 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
134 0 : extension=".hs", my_local=.FALSE.)
135 : END IF
136 :
137 0 : IF (my_s01) THEN
138 0 : middle_name = "N"//TRIM(string1)//"-S01"
139 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
140 0 : extension=".hs", my_local=.FALSE.)
141 : END IF
142 : END IF
143 :
144 2 : IF (my_h .OR. my_s .OR. my_hc .OR. my_sc) THEN
145 0 : IF (my_h .OR. my_hc) THEN
146 0 : IF (.NOT. PRESENT(ispin)) THEN
147 0 : CPABORT("Missing spin index for NEGF restart filename")
148 : END IF
149 0 : WRITE (string2, *) ispin
150 : END IF
151 :
152 0 : IF (my_hc .OR. my_sc) THEN
153 0 : IF (.NOT. PRESENT(icontact)) THEN
154 0 : CPABORT("Missing contact index for NEGF restart filename")
155 : END IF
156 0 : WRITE (string1, *) icontact
157 : END IF
158 :
159 : ! Try to read from the filename that is generated automatically from the print key.
160 0 : print_key => section_vals_get_subs_vals(negf_section, "SCATTERING_REGION%RESTART")
161 :
162 0 : IF (my_h) THEN
163 0 : IF (ispin == 0) THEN
164 0 : middle_name = "Hs"
165 : ELSE
166 0 : middle_name = "Hs-S"//TRIM(string2)
167 : END IF
168 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
169 0 : extension=".hs", my_local=.FALSE.)
170 : END IF
171 :
172 0 : IF (my_s) THEN
173 0 : middle_name = "Ss"
174 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
175 0 : extension=".hs", my_local=.FALSE.)
176 : END IF
177 :
178 0 : IF (my_hc) THEN
179 0 : IF (ispin == 0) THEN
180 0 : middle_name = "Hsc-N"//TRIM(string1)
181 : ELSE
182 0 : middle_name = "Hsc-N"//TRIM(string1)//"-S"//TRIM(string2)
183 : END IF
184 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
185 0 : extension=".hs", my_local=.FALSE.)
186 : END IF
187 :
188 0 : IF (my_sc) THEN
189 0 : middle_name = "Ssc-N"//TRIM(string1)
190 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
191 0 : extension=".hs", my_local=.FALSE.)
192 : END IF
193 : END IF
194 :
195 2 : IF (my_h_scf) THEN
196 : ! Try to read from the filename that is generated automatically from the print key.
197 2 : print_key => section_vals_get_subs_vals(negf_section, "PRINT%RESTART")
198 : filename = negf_generate_filename(logger, print_key, &
199 2 : extension="", my_local=.FALSE., iter_string=.TRUE.)
200 : END IF
201 :
202 2 : INQUIRE (FILE=filename, exist=exist)
203 :
204 2 : END SUBROUTINE negf_restart_file_name
205 :
206 : ! **************************************************************************************************
207 : !> \brief ...
208 : !> \param logger the logger for the parallel environment, iteration info
209 : !> and filename generation
210 : !> \param print_key ...
211 : !> \param middle_name name to be added to the generated filename, useful when
212 : !> print_key activates different distinct outputs, to be able to
213 : !> distinguish them
214 : !> \param extension extension to be applied to the filename (including the ".")
215 : !> \param my_local if the unit should be local to this task, or global to the
216 : !> program (defaults to false).
217 : !> \param iter_string ...
218 : !> \return ...
219 : !> \par History
220 : !> * 12.2025 created [Dmitry Ryndyk]
221 : ! **************************************************************************************************
222 2 : FUNCTION negf_generate_filename(logger, print_key, middle_name, extension, &
223 : my_local, iter_string) RESULT(filename)
224 : TYPE(cp_logger_type), POINTER :: logger
225 : TYPE(section_vals_type), POINTER :: print_key
226 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
227 : CHARACTER(len=*), INTENT(IN) :: extension
228 : LOGICAL, INTENT(IN), OPTIONAL :: my_local, iter_string
229 : CHARACTER(len=default_path_length) :: filename
230 :
231 : CHARACTER(len=default_path_length) :: outName, outPath, postfix, root
232 : CHARACTER(len=default_string_length) :: my_middle_name
233 : INTEGER :: my_ind1, my_ind2
234 : LOGICAL :: has_root
235 :
236 2 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
237 2 : IF (outPath(1:1) == '=') THEN
238 : CPASSERT(LEN(outPath) - 1 <= LEN(filename))
239 0 : filename = outPath(2:)
240 0 : RETURN
241 : END IF
242 2 : IF (outPath == "__STD_OUT__") outPath = ""
243 2 : outName = outPath
244 2 : has_root = .FALSE.
245 2 : my_ind1 = INDEX(outPath, "/")
246 2 : my_ind2 = LEN_TRIM(outPath)
247 2 : IF (my_ind1 /= 0) THEN
248 0 : has_root = .TRUE.
249 0 : DO WHILE (INDEX(outPath(my_ind1 + 1:my_ind2), "/") /= 0)
250 0 : my_ind1 = INDEX(outPath(my_ind1 + 1:my_ind2), "/") + my_ind1
251 : END DO
252 0 : IF (my_ind1 == my_ind2) THEN
253 0 : outName = ""
254 : ELSE
255 0 : outName = outPath(my_ind1 + 1:my_ind2)
256 : END IF
257 : END IF
258 :
259 2 : IF (PRESENT(middle_name)) THEN
260 0 : IF (outName /= "") THEN
261 0 : my_middle_name = "-"//TRIM(outName)//"-"//middle_name
262 : ELSE
263 0 : my_middle_name = "-"//middle_name
264 : END IF
265 : ELSE
266 2 : IF (outName /= "") THEN
267 2 : my_middle_name = "-"//TRIM(outName)
268 : ELSE
269 0 : my_middle_name = ""
270 : END IF
271 : END IF
272 :
273 2 : IF (.NOT. has_root) THEN
274 2 : root = TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
275 0 : ELSE IF (outName == "") THEN
276 0 : root = outPath(1:my_ind1)//TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
277 : ELSE
278 0 : root = outPath(1:my_ind1)//my_middle_name(2:LEN_TRIM(my_middle_name))
279 : END IF
280 :
281 2 : postfix = extension
282 2 : IF (PRESENT(iter_string)) THEN
283 2 : IF (iter_string) THEN
284 : ! use the cp_iter_string as a postfix
285 2 : postfix = "-"//TRIM(cp_iter_string(logger%iter_info, print_key=print_key, for_file=.TRUE.))
286 2 : IF (TRIM(postfix) == "-") postfix = ""
287 : ! and add the extension
288 2 : postfix = TRIM(postfix)//extension
289 : END IF
290 : END IF
291 :
292 : ! and let the logger generate the filename
293 : CALL cp_logger_generate_filename(logger, res=filename, &
294 2 : root=root, postfix=postfix, local=my_local)
295 :
296 2 : END FUNCTION negf_generate_filename
297 :
298 : ! **************************************************************************************************
299 : !> \brief Prints full matrix to a file.
300 : !> \param filename ...
301 : !> \param matrix ...
302 : !> \par History
303 : !> * 12.2025 created [Dmitry Ryndyk]
304 : ! **************************************************************************************************
305 0 : SUBROUTINE negf_print_matrix_to_file(filename, matrix)
306 : CHARACTER(LEN=default_path_length), INTENT(IN) :: filename
307 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: matrix
308 :
309 : CHARACTER(len=100) :: sfmt
310 : INTEGER :: i, j, ncol, nrow, print_unit
311 :
312 : CALL open_file(file_name=filename, file_status="REPLACE", &
313 : file_form="FORMATTED", file_action="WRITE", &
314 0 : file_position="REWIND", unit_number=print_unit)
315 :
316 0 : nrow = SIZE(matrix, 1)
317 0 : ncol = SIZE(matrix, 2)
318 0 : WRITE (sfmt, "('(',i0,'(E15.5))')") ncol
319 0 : WRITE (print_unit, *) nrow, ncol
320 0 : DO i = 1, nrow
321 0 : WRITE (print_unit, sfmt) (matrix(i, j), j=1, ncol)
322 : END DO
323 :
324 0 : CALL close_file(print_unit)
325 :
326 0 : END SUBROUTINE negf_print_matrix_to_file
327 :
328 : ! **************************************************************************************************
329 : !> \brief Reads full matrix from a file.
330 : !> \param filename ...
331 : !> \param matrix ...
332 : !> \par History
333 : !> * 12.2025 created [Dmitry Ryndyk]
334 : ! **************************************************************************************************
335 0 : SUBROUTINE negf_read_matrix_from_file(filename, matrix)
336 : CHARACTER(LEN=default_path_length), INTENT(IN) :: filename
337 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: matrix
338 :
339 : INTEGER :: i, j, ncol, nrow, print_unit
340 :
341 : CALL open_file(file_name=filename, file_status="OLD", &
342 : file_form="FORMATTED", file_action="READ", &
343 0 : file_position="REWIND", unit_number=print_unit)
344 :
345 0 : READ (print_unit, *) nrow, ncol
346 0 : DO i = 1, nrow
347 0 : READ (print_unit, *) (matrix(i, j), j=1, ncol)
348 : END DO
349 :
350 0 : CALL close_file(print_unit)
351 :
352 0 : END SUBROUTINE negf_read_matrix_from_file
353 :
354 : END MODULE negf_io
|
