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 : WRITE (string1, *) icontact
95 2 : WRITE (string2, *) ispin
96 :
97 : ! try to read from the filename that is generated automatically from the printkey
98 2 : contact_section => section_vals_get_subs_vals(negf_section, "CONTACT")
99 2 : print_key => section_vals_get_subs_vals(contact_section, "RESTART", i_rep_section=icontact)
100 :
101 2 : IF (my_h00) THEN
102 0 : IF (ispin == 0) THEN
103 0 : middle_name = "N"//TRIM(string1)//"-H00"
104 : ELSE
105 0 : middle_name = "N"//TRIM(string1)//"-H00-S"//TRIM(string2)
106 : END IF
107 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
108 0 : extension=".hs", my_local=.FALSE.)
109 : END IF
110 :
111 2 : IF (my_h01) THEN
112 0 : IF (ispin == 0) THEN
113 0 : middle_name = "N"//TRIM(string1)//"-H01"
114 : ELSE
115 0 : middle_name = "N"//TRIM(string1)//"-H01-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 2 : IF (my_s00) THEN
122 0 : middle_name = "N"//TRIM(string1)//"-S00"
123 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
124 0 : extension=".hs", my_local=.FALSE.)
125 : END IF
126 :
127 2 : IF (my_s01) THEN
128 0 : middle_name = "N"//TRIM(string1)//"-S01"
129 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
130 0 : extension=".hs", my_local=.FALSE.)
131 : END IF
132 :
133 : ! try to read from the filename that is generated automatically from the printkey
134 2 : print_key => section_vals_get_subs_vals(negf_section, "SCATTERING_REGION%RESTART")
135 :
136 2 : IF (my_h) THEN
137 0 : IF (ispin == 0) THEN
138 0 : middle_name = "Hs"
139 : ELSE
140 0 : middle_name = "Hs-S"//TRIM(string2)
141 : END IF
142 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
143 0 : extension=".hs", my_local=.FALSE.)
144 : END IF
145 :
146 2 : IF (my_s) THEN
147 0 : middle_name = "Ss"
148 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
149 0 : extension=".hs", my_local=.FALSE.)
150 : END IF
151 :
152 2 : IF (my_hc) THEN
153 0 : IF (ispin == 0) THEN
154 0 : middle_name = "Hsc-N"//TRIM(string1)
155 : ELSE
156 0 : middle_name = "Hsc-N"//TRIM(string1)//"-S"//TRIM(string2)
157 : END IF
158 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
159 0 : extension=".hs", my_local=.FALSE.)
160 : END IF
161 :
162 2 : IF (my_sc) THEN
163 0 : middle_name = "Ssc-N"//TRIM(string1)
164 : filename = negf_generate_filename(logger, print_key, middle_name=middle_name, &
165 0 : extension=".hs", my_local=.FALSE.)
166 : END IF
167 :
168 : ! try to read from the filename that is generated automatically from the printkey
169 2 : print_key => section_vals_get_subs_vals(negf_section, "PRINT%RESTART")
170 :
171 2 : IF (my_h_scf) THEN
172 : filename = negf_generate_filename(logger, print_key, &
173 2 : extension="", my_local=.FALSE., iter_string=.TRUE.)
174 : END IF
175 :
176 2 : INQUIRE (FILE=filename, exist=exist)
177 :
178 2 : END SUBROUTINE negf_restart_file_name
179 :
180 : ! **************************************************************************************************
181 : !> \brief ...
182 : !> \param logger the logger for the parallel environment, iteration info
183 : !> and filename generation
184 : !> \param print_key ...
185 : !> \param middle_name name to be added to the generated filename, useful when
186 : !> print_key activates different distinct outputs, to be able to
187 : !> distinguish them
188 : !> \param extension extension to be applied to the filename (including the ".")
189 : !> \param my_local if the unit should be local to this task, or global to the
190 : !> program (defaults to false).
191 : !> \param iter_string ...
192 : !> \return ...
193 : !> \par History
194 : !> * 12.2025 created [Dmitry Ryndyk]
195 : ! **************************************************************************************************
196 2 : FUNCTION negf_generate_filename(logger, print_key, middle_name, extension, &
197 : my_local, iter_string) RESULT(filename)
198 : TYPE(cp_logger_type), POINTER :: logger
199 : TYPE(section_vals_type), POINTER :: print_key
200 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
201 : CHARACTER(len=*), INTENT(IN) :: extension
202 : LOGICAL, INTENT(IN), OPTIONAL :: my_local, iter_string
203 : CHARACTER(len=default_path_length) :: filename
204 :
205 : CHARACTER(len=default_path_length) :: outName, outPath, postfix, root
206 : CHARACTER(len=default_string_length) :: my_middle_name
207 : INTEGER :: my_ind1, my_ind2
208 : LOGICAL :: has_root
209 :
210 2 : CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath)
211 2 : IF (outPath(1:1) == '=') THEN
212 : CPASSERT(LEN(outPath) - 1 <= LEN(filename))
213 0 : filename = outPath(2:)
214 0 : RETURN
215 : END IF
216 2 : IF (outPath == "__STD_OUT__") outPath = ""
217 2 : outName = outPath
218 2 : has_root = .FALSE.
219 2 : my_ind1 = INDEX(outPath, "/")
220 2 : my_ind2 = LEN_TRIM(outPath)
221 2 : IF (my_ind1 /= 0) THEN
222 0 : has_root = .TRUE.
223 0 : DO WHILE (INDEX(outPath(my_ind1 + 1:my_ind2), "/") /= 0)
224 0 : my_ind1 = INDEX(outPath(my_ind1 + 1:my_ind2), "/") + my_ind1
225 : END DO
226 0 : IF (my_ind1 == my_ind2) THEN
227 0 : outName = ""
228 : ELSE
229 0 : outName = outPath(my_ind1 + 1:my_ind2)
230 : END IF
231 : END IF
232 :
233 2 : IF (PRESENT(middle_name)) THEN
234 0 : IF (outName /= "") THEN
235 0 : my_middle_name = "-"//TRIM(outName)//"-"//middle_name
236 : ELSE
237 0 : my_middle_name = "-"//middle_name
238 : END IF
239 : ELSE
240 2 : IF (outName /= "") THEN
241 2 : my_middle_name = "-"//TRIM(outName)
242 : ELSE
243 0 : my_middle_name = ""
244 : END IF
245 : END IF
246 :
247 2 : IF (.NOT. has_root) THEN
248 2 : root = TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
249 0 : ELSE IF (outName == "") THEN
250 0 : root = outPath(1:my_ind1)//TRIM(logger%iter_info%project_name)//TRIM(my_middle_name)
251 : ELSE
252 0 : root = outPath(1:my_ind1)//my_middle_name(2:LEN_TRIM(my_middle_name))
253 : END IF
254 :
255 2 : IF (PRESENT(iter_string) .AND. iter_string) THEN
256 : ! use the cp_iter_string as a postfix
257 2 : postfix = "-"//TRIM(cp_iter_string(logger%iter_info, print_key=print_key, for_file=.TRUE.))
258 2 : IF (TRIM(postfix) == "-") postfix = ""
259 : ! and add the extension
260 2 : postfix = TRIM(postfix)//extension
261 : ELSE
262 0 : postfix = extension
263 : END IF
264 :
265 : ! and let the logger generate the filename
266 : CALL cp_logger_generate_filename(logger, res=filename, &
267 2 : root=root, postfix=postfix, local=my_local)
268 :
269 2 : END FUNCTION negf_generate_filename
270 :
271 : ! **************************************************************************************************
272 : !> \brief Prints full matrix to a file.
273 : !> \param filename ...
274 : !> \param matrix ...
275 : !> \par History
276 : !> * 12.2025 created [Dmitry Ryndyk]
277 : ! **************************************************************************************************
278 0 : SUBROUTINE negf_print_matrix_to_file(filename, matrix)
279 : CHARACTER(LEN=default_path_length), INTENT(IN) :: filename
280 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: matrix
281 :
282 : CHARACTER(len=100) :: sfmt
283 : INTEGER :: i, j, ncol, nrow, print_unit
284 :
285 : CALL open_file(file_name=filename, file_status="REPLACE", &
286 : file_form="FORMATTED", file_action="WRITE", &
287 0 : file_position="REWIND", unit_number=print_unit)
288 :
289 0 : nrow = SIZE(matrix, 1)
290 0 : ncol = SIZE(matrix, 2)
291 0 : WRITE (sfmt, "('(',i0,'(E15.5))')") ncol
292 0 : WRITE (print_unit, *) nrow, ncol
293 0 : DO i = 1, nrow
294 0 : WRITE (print_unit, sfmt) (matrix(i, j), j=1, ncol)
295 : END DO
296 :
297 0 : CALL close_file(print_unit)
298 :
299 0 : END SUBROUTINE negf_print_matrix_to_file
300 :
301 : ! **************************************************************************************************
302 : !> \brief Reads full matrix from a file.
303 : !> \param filename ...
304 : !> \param matrix ...
305 : !> \par History
306 : !> * 12.2025 created [Dmitry Ryndyk]
307 : ! **************************************************************************************************
308 0 : SUBROUTINE negf_read_matrix_from_file(filename, matrix)
309 : CHARACTER(LEN=default_path_length), INTENT(IN) :: filename
310 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: matrix
311 :
312 : INTEGER :: i, j, ncol, nrow, print_unit
313 :
314 : CALL open_file(file_name=filename, file_status="OLD", &
315 : file_form="FORMATTED", file_action="READ", &
316 0 : file_position="REWIND", unit_number=print_unit)
317 :
318 0 : READ (print_unit, *) nrow, ncol
319 0 : DO i = 1, nrow
320 0 : READ (print_unit, *) (matrix(i, j), j=1, ncol)
321 : END DO
322 :
323 0 : CALL close_file(print_unit)
324 :
325 0 : END SUBROUTINE negf_read_matrix_from_file
326 :
327 : END MODULE negf_io
|