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