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 - writing and printing the files, trajectory (pos, cell, dipoles) as
10 : !> well as restart files
11 : !> - usually just the Markov Chain elements are regarded, the elements
12 : !> beside this trajectory are neglected
13 : !> - futrthermore (by option) just the accepted configurations
14 : !> are print out to reduce the file sizes
15 : !> \par History
16 : !> 12.2012 created [Mandes Schoenherr]
17 : !> \author Mandes
18 : ! **************************************************************************************************
19 :
20 : MODULE tmc_file_io
21 : USE cp_files, ONLY: close_file,&
22 : open_file
23 : USE cp_log_handling, ONLY: cp_to_string
24 : USE kinds, ONLY: default_path_length,&
25 : default_string_length,&
26 : dp
27 : USE physcon, ONLY: au2a => angstrom
28 : USE tmc_analysis_types, ONLY: tmc_analysis_env
29 : USE tmc_calculations, ONLY: get_cell_scaling,&
30 : get_scaled_cell
31 : USE tmc_move_types, ONLY: nr_mv_types
32 : USE tmc_stati, ONLY: TMC_STATUS_FAILED,&
33 : TMC_STATUS_OK,&
34 : TMC_STATUS_WAIT_FOR_NEW_TASK,&
35 : tmc_default_restart_in_file_name,&
36 : tmc_default_restart_out_file_name,&
37 : tmc_default_trajectory_file_name
38 : USE tmc_tree_types, ONLY: elem_array_type,&
39 : tree_type
40 : USE tmc_types, ONLY: tmc_env_type,&
41 : tmc_param_type
42 : #include "../base/base_uses.f90"
43 :
44 : IMPLICIT NONE
45 :
46 : PRIVATE
47 :
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tmc_file_io'
49 :
50 : ! filename manipulation
51 : PUBLIC :: expand_file_name_char, expand_file_name_temp, expand_file_name_int
52 : ! read/write restart file
53 : PUBLIC :: print_restart_file, read_restart_file
54 : ! write the configuration
55 : PUBLIC :: write_result_list_element
56 : PUBLIC :: write_element_in_file
57 : PUBLIC :: write_dipoles_in_file
58 : ! analysis read
59 : PUBLIC :: analyse_files_open, read_element_from_file, analyse_files_close
60 :
61 : CONTAINS
62 :
63 : !------------------------------------------------------------------------------
64 : ! routines for manipulating the file name
65 : !------------------------------------------------------------------------------
66 : ! **************************************************************************************************
67 : !> \brief placing a character string at the end of a file name
68 : !> (instead of the ending)
69 : !> \param file_name original file name
70 : !> \param extra string to be added before the file extension
71 : !> \return the new filename
72 : !> \author Mandes 11.2012
73 : ! **************************************************************************************************
74 2615 : FUNCTION expand_file_name_ending(file_name, extra) RESULT(result_file_name)
75 : CHARACTER(LEN=*) :: file_name, extra
76 : CHARACTER(LEN=default_path_length) :: result_file_name
77 :
78 : INTEGER :: ind
79 :
80 0 : CPASSERT(file_name /= "")
81 :
82 2615 : ind = INDEX(file_name, ".", BACK=.TRUE.)
83 2615 : IF (.NOT. ind == 0) THEN
84 2615 : WRITE (result_file_name, *) file_name(1:ind - 1), ".", &
85 5230 : TRIM(ADJUSTL(extra))
86 : ELSE
87 0 : WRITE (result_file_name, *) TRIM(file_name), ".", extra
88 : END IF
89 2615 : result_file_name = TRIM(ADJUSTL(result_file_name))
90 2615 : CPASSERT(result_file_name /= "")
91 2615 : END FUNCTION expand_file_name_ending
92 :
93 : ! **************************************************************************************************
94 : !> \brief placing a character string at the end of a file name
95 : !> (before the file extension)
96 : !> \param file_name original file name
97 : !> \param extra string to be added before the file extension
98 : !> \return the new filename
99 : !> \author Mandes 11.2012
100 : ! **************************************************************************************************
101 1427 : FUNCTION expand_file_name_char(file_name, extra) RESULT(result_file_name)
102 : CHARACTER(LEN=*) :: file_name, extra
103 : CHARACTER(LEN=default_path_length) :: result_file_name
104 :
105 : INTEGER :: ind
106 :
107 0 : CPASSERT(file_name /= "")
108 :
109 1427 : ind = INDEX(file_name, ".", BACK=.TRUE.)
110 1427 : IF (.NOT. ind == 0) THEN
111 1427 : WRITE (result_file_name, *) file_name(1:ind - 1), "_", &
112 2854 : TRIM(ADJUSTL(extra)), file_name(ind:LEN_TRIM(file_name))
113 : ELSE
114 0 : WRITE (result_file_name, *) TRIM(file_name), "_", extra
115 : END IF
116 1427 : result_file_name = TRIM(ADJUSTL(result_file_name))
117 1427 : CPASSERT(result_file_name /= "")
118 1427 : END FUNCTION expand_file_name_char
119 :
120 : ! **************************************************************************************************
121 : !> \brief placing the temperature at the end of a file name
122 : !> (before the file extension)
123 : !> \param file_name original file name
124 : !> \param rvalue temperature to be added
125 : !> \return the new filename
126 : !> \author Mandes 11.2012
127 : ! **************************************************************************************************
128 2871 : FUNCTION expand_file_name_temp(file_name, rvalue) RESULT(result_file_name)
129 : CHARACTER(LEN=*) :: file_name
130 : REAL(KIND=dp) :: rvalue
131 : CHARACTER(LEN=default_path_length) :: result_file_name
132 :
133 : CHARACTER(LEN=18) :: rval_to_string
134 : INTEGER :: ind
135 :
136 2871 : CPASSERT(file_name /= "")
137 :
138 2871 : rval_to_string = ""
139 :
140 2871 : WRITE (rval_to_string, "(F16.2)") rvalue
141 2871 : ind = INDEX(file_name, ".", BACK=.TRUE.)
142 2871 : IF (.NOT. ind == 0) THEN
143 2871 : WRITE (result_file_name, *) file_name(1:ind - 1), "_T", &
144 5742 : TRIM(ADJUSTL(rval_to_string)), file_name(ind:LEN_TRIM(file_name))
145 : ELSE
146 0 : IF (LEN(file_name) == 0) THEN
147 0 : WRITE (result_file_name, *) TRIM(file_name), "T", TRIM(ADJUSTL(rval_to_string)), &
148 0 : file_name(ind:LEN_TRIM(file_name))
149 : ELSE
150 0 : WRITE (result_file_name, *) TRIM(file_name), "_T", TRIM(ADJUSTL(rval_to_string))
151 : END IF
152 : END IF
153 2871 : result_file_name = TRIM(ADJUSTL(result_file_name))
154 2871 : CPASSERT(result_file_name /= "")
155 2871 : END FUNCTION expand_file_name_temp
156 :
157 : ! **************************************************************************************************
158 : !> \brief placing an integer at the end of a file name
159 : !> (before the file extension)
160 : !> \param file_name original file name
161 : !> \param ivalue number to be added
162 : !> \return the new filename
163 : !> \author Mandes 11.2012
164 : ! **************************************************************************************************
165 19 : FUNCTION expand_file_name_int(file_name, ivalue) RESULT(result_file_name)
166 : CHARACTER(LEN=*) :: file_name
167 : INTEGER :: ivalue
168 : CHARACTER(LEN=default_path_length) :: result_file_name
169 :
170 : CHARACTER(LEN=18) :: rval_to_string
171 : INTEGER :: ind
172 :
173 19 : CPASSERT(file_name /= "")
174 :
175 19 : rval_to_string = ""
176 :
177 19 : WRITE (rval_to_string, *) ivalue
178 19 : ind = INDEX(file_name, ".", BACK=.TRUE.)
179 19 : IF (.NOT. ind == 0) THEN
180 19 : WRITE (result_file_name, *) file_name(1:ind - 1), "_", &
181 38 : TRIM(ADJUSTL(rval_to_string)), file_name(ind:LEN_TRIM(file_name))
182 : ELSE
183 0 : IF (LEN(file_name) == 0) THEN
184 0 : WRITE (result_file_name, *) TRIM(file_name), "", TRIM(ADJUSTL(rval_to_string)), &
185 0 : file_name(ind:LEN_TRIM(file_name))
186 : ELSE
187 0 : WRITE (result_file_name, *) TRIM(file_name), "_", TRIM(ADJUSTL(rval_to_string)), &
188 0 : file_name(ind:LEN_TRIM(file_name))
189 : END IF
190 : END IF
191 19 : result_file_name = TRIM(ADJUSTL(result_file_name))
192 19 : CPASSERT(result_file_name /= "")
193 19 : END FUNCTION expand_file_name_int
194 :
195 : !------------------------------------------------------------------------------
196 : ! routines for reading and writing RESTART file
197 : !------------------------------------------------------------------------------
198 : ! **************************************************************************************************
199 : !> \brief prints out the TMC restart files with all last configurations and
200 : !> counters etc.
201 : !> \param tmc_env the tmc environment, storing result lists and counters an in
202 : !> temperatures
203 : !> \param job_counts the counters for counting the submitted different job types
204 : !> \param timings ...
205 : !> \author Mandes 11.2012
206 : ! **************************************************************************************************
207 3 : SUBROUTINE print_restart_file(tmc_env, job_counts, timings)
208 : TYPE(tmc_env_type), POINTER :: tmc_env
209 : INTEGER, DIMENSION(:) :: job_counts
210 : REAL(KIND=dp), DIMENSION(4) :: timings
211 :
212 : CHARACTER(LEN=default_path_length) :: c_tmp, file_name
213 : INTEGER :: f_unit, i
214 :
215 3 : c_tmp = ""
216 3 : CPASSERT(ASSOCIATED(tmc_env))
217 3 : CPASSERT(ASSOCIATED(tmc_env%m_env))
218 3 : CPASSERT(ASSOCIATED(tmc_env%params))
219 3 : CPASSERT(ASSOCIATED(tmc_env%m_env%gt_act))
220 :
221 3 : WRITE (c_tmp, FMT='(I9.9)') tmc_env%m_env%result_count(0)
222 : file_name = TRIM(expand_file_name_char( &
223 : file_name=tmc_default_restart_out_file_name, &
224 3 : extra=c_tmp))
225 : CALL open_file(file_name=file_name, file_status="REPLACE", &
226 : file_action="WRITE", file_form="UNFORMATTED", &
227 3 : unit_number=f_unit)
228 3 : WRITE (f_unit) SIZE(tmc_env%params%Temp)
229 12 : WRITE (f_unit) tmc_env%params%Temp(:), &
230 3 : tmc_env%m_env%gt_act%nr, &
231 84 : tmc_env%m_env%gt_act%rng_seed, &
232 3 : tmc_env%m_env%gt_act%rnd_nr, &
233 3 : tmc_env%m_env%gt_act%prob_acc, &
234 3 : tmc_env%m_env%gt_act%mv_conf, &
235 3 : tmc_env%m_env%gt_act%mv_next_conf, &
236 15 : tmc_env%m_env%result_count(0:), &
237 33 : tmc_env%params%move_types%mv_weight, &
238 111 : tmc_env%params%move_types%acc_count, &
239 111 : tmc_env%params%move_types%mv_count, &
240 102 : tmc_env%params%move_types%subbox_acc_count, &
241 102 : tmc_env%params%move_types%subbox_count, &
242 39 : tmc_env%params%cell%hmat, &
243 3 : job_counts, &
244 6 : timings
245 12 : DO i = 1, SIZE(tmc_env%params%Temp)
246 9 : WRITE (f_unit) tmc_env%m_env%result_list(i)%elem%nr, &
247 252 : tmc_env%m_env%result_list(i)%elem%rng_seed, &
248 576 : tmc_env%m_env%result_list(i)%elem%pos, &
249 576 : tmc_env%m_env%result_list(i)%elem%vel, &
250 36 : tmc_env%m_env%result_list(i)%elem%box_scale, &
251 9 : tmc_env%m_env%result_list(i)%elem%potential, &
252 9 : tmc_env%m_env%result_list(i)%elem%e_pot_approx, &
253 9 : tmc_env%m_env%result_list(i)%elem%ekin, &
254 9 : tmc_env%m_env%result_list(i)%elem%ekin_before_md, &
255 21 : tmc_env%m_env%result_list(i)%elem%temp_created
256 : END DO
257 3 : CALL close_file(unit_number=f_unit)
258 : ! write the file, where the restart file name is written in
259 : CALL open_file(file_name=tmc_default_restart_in_file_name, &
260 : file_action="WRITE", file_status="REPLACE", &
261 3 : unit_number=f_unit)
262 3 : WRITE (f_unit, *) TRIM(file_name)
263 3 : CALL close_file(unit_number=f_unit)
264 3 : END SUBROUTINE print_restart_file
265 :
266 : ! **************************************************************************************************
267 : !> \brief reads the TMC restart file with all last configurations and
268 : !> counters etc.
269 : !> \param tmc_env the tmc environment, storing result lists and counters an in
270 : !> temperatures
271 : !> \param job_counts the counters for counting the submitted different job types
272 : !> \param timings ...
273 : !> \param file_name the restart file name
274 : !> \author Mandes 11.2012
275 : ! **************************************************************************************************
276 2 : SUBROUTINE read_restart_file(tmc_env, job_counts, timings, file_name)
277 : TYPE(tmc_env_type), POINTER :: tmc_env
278 : INTEGER, DIMENSION(:) :: job_counts
279 : REAL(KIND=dp), DIMENSION(4) :: timings
280 : CHARACTER(LEN=*) :: file_name
281 :
282 : INTEGER :: file_ptr, i, temp_size
283 : LOGICAL :: flag
284 2 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: tmp_temp
285 : REAL(KIND=dp), DIMENSION(nr_mv_types) :: mv_weight_tmp
286 :
287 2 : CPASSERT(ASSOCIATED(tmc_env))
288 2 : CPASSERT(ASSOCIATED(tmc_env%m_env))
289 2 : CPASSERT(ASSOCIATED(tmc_env%params))
290 2 : CPASSERT(ASSOCIATED(tmc_env%m_env%gt_act))
291 :
292 2 : IF (file_name == tmc_default_restart_in_file_name) THEN
293 2 : INQUIRE (FILE=tmc_default_restart_in_file_name, EXIST=flag)
294 2 : CPASSERT(flag)
295 : CALL open_file(file_name=tmc_default_restart_in_file_name, file_status="OLD", &
296 2 : file_action="READ", unit_number=file_ptr)
297 2 : READ (file_ptr, *) file_name
298 2 : CALL close_file(unit_number=file_ptr)
299 : END IF
300 :
301 : CALL open_file(file_name=file_name, file_status="OLD", file_form="UNFORMATTED", &
302 2 : file_action="READ", unit_number=file_ptr)
303 2 : READ (file_ptr) temp_size
304 2 : IF (temp_size /= SIZE(tmc_env%params%Temp)) THEN
305 : CALL cp_abort(__LOCATION__, &
306 : "the actual specified temperatures does not "// &
307 0 : "fit in amount with the one from restart file ")
308 : END IF
309 6 : ALLOCATE (tmp_temp(temp_size))
310 2 : READ (file_ptr) tmp_temp(:), &
311 2 : tmc_env%m_env%gt_act%nr, &
312 56 : tmc_env%m_env%gt_act%rng_seed, &
313 2 : tmc_env%m_env%gt_act%rnd_nr, &
314 2 : tmc_env%m_env%gt_act%prob_acc, &
315 2 : tmc_env%m_env%gt_act%mv_conf, & !
316 2 : tmc_env%m_env%gt_act%mv_next_conf, & !
317 10 : tmc_env%m_env%result_count(0:), &
318 2 : mv_weight_tmp, & !
319 74 : tmc_env%params%move_types%acc_count, &
320 74 : tmc_env%params%move_types%mv_count, &
321 68 : tmc_env%params%move_types%subbox_acc_count, &
322 68 : tmc_env%params%move_types%subbox_count, & !
323 26 : tmc_env%params%cell%hmat, &
324 2 : job_counts, &
325 4 : timings
326 :
327 8 : IF (ANY(ABS(tmc_env%params%Temp(:) - tmp_temp(:)) >= 0.005)) THEN
328 : CALL cp_abort(__LOCATION__, "the temperatures differ from the previous calculation. "// &
329 0 : "There were the following temperatures used:")
330 : END IF
331 22 : IF (ANY(mv_weight_tmp(:) /= tmc_env%params%move_types%mv_weight(:))) THEN
332 0 : CPWARN("The amount of mv types differs between the original and the restart run.")
333 : END IF
334 :
335 8 : DO i = 1, SIZE(tmc_env%params%Temp)
336 6 : tmc_env%m_env%gt_act%conf(i)%elem => tmc_env%m_env%result_list(i)%elem
337 6 : READ (file_ptr) tmc_env%m_env%result_list(i)%elem%nr, &
338 168 : tmc_env%m_env%result_list(i)%elem%rng_seed, &
339 384 : tmc_env%m_env%result_list(i)%elem%pos, &
340 384 : tmc_env%m_env%result_list(i)%elem%vel, &
341 24 : tmc_env%m_env%result_list(i)%elem%box_scale, &
342 6 : tmc_env%m_env%result_list(i)%elem%potential, &
343 6 : tmc_env%m_env%result_list(i)%elem%e_pot_approx, &
344 6 : tmc_env%m_env%result_list(i)%elem%ekin, &
345 6 : tmc_env%m_env%result_list(i)%elem%ekin_before_md, &
346 14 : tmc_env%m_env%result_list(i)%elem%temp_created
347 : END DO
348 2 : CALL close_file(unit_number=file_ptr)
349 2 : END SUBROUTINE read_restart_file
350 :
351 : !----------------------------------------------------------------------------
352 : ! printing configuration in file
353 : !----------------------------------------------------------------------------
354 :
355 : ! **************************************************************************************************
356 : !> \brief select the correct configuration to print out the
357 : !> (coordinates, forces, cell ...)
358 : !> \param result_list list of configurations for each temperature
359 : !> \param result_count list with number of Markov Chain number
360 : !> for each teperature (index 0 for global tree)
361 : !> \param conf_updated index of the updated (modified element)
362 : !> \param accepted acceptance flag
363 : !> \param tmc_params TMC environment parameters
364 : !> \author Mandes 02.2013
365 : ! **************************************************************************************************
366 9334 : SUBROUTINE write_result_list_element(result_list, result_count, conf_updated, &
367 : accepted, tmc_params)
368 : TYPE(elem_array_type), DIMENSION(:), POINTER :: result_list
369 : INTEGER, DIMENSION(:), POINTER :: result_count
370 : INTEGER :: conf_updated
371 : LOGICAL, INTENT(IN) :: accepted
372 : TYPE(tmc_param_type), POINTER :: tmc_params
373 :
374 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_result_list_element'
375 :
376 : CHARACTER(LEN=default_path_length) :: file_name
377 : INTEGER :: handle, i
378 :
379 4667 : file_name = ""
380 :
381 4667 : CPASSERT(ASSOCIATED(result_list))
382 4667 : CPASSERT(ASSOCIATED(result_count))
383 4667 : CPASSERT(ASSOCIATED(tmc_params))
384 4667 : CPASSERT(ASSOCIATED(tmc_params%Temp))
385 4667 : CPASSERT(conf_updated >= 0)
386 4667 : CPASSERT(conf_updated <= SIZE(tmc_params%Temp))
387 :
388 : ! start the timing
389 4667 : CALL timeset(routineN, handle)
390 :
391 4667 : IF (conf_updated == 0) THEN
392 : ! for debugging print every configuration of every temperature
393 0 : DO i = 1, SIZE(tmc_params%Temp)
394 0 : WRITE (file_name, *) "every_step_", TRIM(tmc_default_trajectory_file_name)
395 : CALL write_element_in_file(elem=result_list(i)%elem, &
396 : tmc_params=tmc_params, conf_nr=result_count(0), &
397 0 : file_name=expand_file_name_temp(file_name=file_name, rvalue=tmc_params%Temp(i)))
398 : END DO
399 : ELSE
400 4667 : IF ((.NOT. tmc_params%print_only_diff_conf) .OR. &
401 : (tmc_params%print_only_diff_conf .AND. accepted)) THEN
402 : CALL write_element_in_file(elem=result_list(conf_updated)%elem, &
403 : tmc_params=tmc_params, conf_nr=result_count(conf_updated), &
404 : file_name=expand_file_name_temp(file_name=TRIM(tmc_default_trajectory_file_name), &
405 1025 : rvalue=tmc_params%Temp(conf_updated)))
406 : END IF
407 : END IF
408 : ! end the timing
409 4667 : CALL timestop(handle)
410 4667 : END SUBROUTINE write_result_list_element
411 :
412 : ! **************************************************************************************************
413 : !> \brief writes the trajectory element in a file from sub tree element
414 : !> \param elem actual tree element to be printed out
415 : !> \param tmc_params TMC environment parameters
416 : !> \param temp_index ...
417 : !> \param file_name file name will be extended by type of file (pos, cell,...)
418 : !> \param conf_nr Markov chain element number
419 : !> \param conf_info whole header line
420 : !> \author Mandes 11.2012
421 : ! **************************************************************************************************
422 1025 : SUBROUTINE write_element_in_file(elem, tmc_params, temp_index, file_name, conf_nr, &
423 : conf_info)
424 : TYPE(tree_type), POINTER :: elem
425 : TYPE(tmc_param_type), POINTER :: tmc_params
426 : INTEGER, OPTIONAL :: temp_index
427 : CHARACTER(LEN=*), OPTIONAL :: file_name
428 : INTEGER, OPTIONAL :: conf_nr
429 : CHARACTER(LEN=*), OPTIONAL :: conf_info
430 :
431 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_element_in_file'
432 :
433 : CHARACTER(LEN=default_path_length) :: file_name_act, tmp_name
434 : CHARACTER(LEN=default_string_length) :: header
435 : INTEGER :: file_ptr, handle, i, nr_atoms
436 : LOGICAL :: file_exists, print_it
437 : REAL(KIND=dp) :: vol
438 : REAL(KIND=dp), DIMENSION(3, 3) :: hmat_scaled
439 :
440 1025 : file_name_act = ""
441 1025 : tmp_name = ""
442 1025 : header = ""
443 1025 : print_it = .TRUE.
444 :
445 0 : CPASSERT(ASSOCIATED(elem))
446 1025 : CPASSERT(ASSOCIATED(tmc_params))
447 1025 : CPASSERT(ASSOCIATED(tmc_params%atoms))
448 1025 : CPASSERT(PRESENT(conf_nr) .OR. PRESENT(conf_info))
449 :
450 1025 : IF (print_it) THEN
451 : ! start the timing
452 1025 : CALL timeset(routineN, handle)
453 :
454 : ! set default file name
455 1025 : IF (PRESENT(file_name)) THEN
456 1025 : CPASSERT(file_name /= "")
457 1025 : file_name_act = file_name
458 : ELSE
459 0 : CPASSERT(ASSOCIATED(tmc_params%Temp))
460 0 : CPASSERT(PRESENT(temp_index))
461 : file_name_act = expand_file_name_temp(file_name=tmc_default_trajectory_file_name, &
462 0 : rvalue=tmc_params%Temp(temp_index))
463 : END IF
464 :
465 1025 : nr_atoms = SIZE(elem%pos)/tmc_params%dim_per_elem
466 :
467 : ! set header (for coordinate or force file)
468 1025 : IF (tmc_params%print_trajectory .OR. tmc_params%print_forces) THEN
469 1025 : IF (PRESENT(conf_info)) THEN
470 0 : WRITE (header, *) TRIM(ADJUSTL(conf_info))
471 : ELSE
472 : !WRITE(header,FMT="(A,I8,A,F20.10)") " i = ", conf_nr,", E = ", elem%potential
473 1025 : WRITE (header, FMT="(A,I8,A,F20.10,F20.10,A,I8,I8)") "i =", conf_nr, " ,E =", &
474 2050 : elem%potential, elem%ekin, " st elem", elem%sub_tree_nr, elem%nr
475 : END IF
476 : END IF
477 :
478 : ! write the coordinates
479 1025 : IF (tmc_params%print_trajectory) THEN
480 1025 : tmp_name = expand_file_name_ending(file_name_act, "xyz")
481 : CALL open_file(file_name=tmp_name, file_status="UNKNOWN", &
482 : file_action="WRITE", file_position="APPEND", &
483 1025 : unit_number=file_ptr)
484 1025 : WRITE (file_ptr, FMT="(I8)") nr_atoms
485 1025 : WRITE (file_ptr, *) TRIM(header)
486 44797 : DO i = 1, SIZE(elem%pos), tmc_params%dim_per_elem
487 : WRITE (file_ptr, FMT="(A4,1X,1000F20.10)") &
488 43772 : TRIM(tmc_params%atoms((i - 1)/tmc_params%dim_per_elem + 1)%name), &
489 219885 : elem%pos(i:i + tmc_params%dim_per_elem - 1)*au2a
490 : END DO
491 1025 : CALL close_file(unit_number=file_ptr)
492 : END IF
493 :
494 : ! write the forces
495 1025 : IF (tmc_params%print_forces) THEN
496 331 : tmp_name = expand_file_name_ending(file_name_act, "frc")
497 : CALL open_file(file_name=tmp_name, file_status="UNKNOWN", &
498 : file_action="WRITE", file_position="APPEND", &
499 331 : unit_number=file_ptr)
500 331 : WRITE (file_ptr, FMT="(I8)") nr_atoms
501 331 : WRITE (file_ptr, *) TRIM(header)
502 7282 : DO i = 1, SIZE(elem%pos), tmc_params%dim_per_elem
503 : WRITE (file_ptr, FMT="(A4,1X,1000F20.10)") &
504 6951 : TRIM(tmc_params%atoms((i - 1)/tmc_params%dim_per_elem + 1)%name), &
505 35086 : elem%frc(i:i + tmc_params%dim_per_elem - 1)
506 : END DO
507 331 : CALL close_file(unit_number=file_ptr)
508 : END IF
509 :
510 : ! write the cell dipoles
511 1025 : IF (tmc_params%print_dipole) THEN
512 : CALL write_dipoles_in_file(file_name=file_name_act, &
513 0 : conf_nr=conf_nr, dip=elem%dipole)
514 : END IF
515 :
516 : ! write the cell file
517 1025 : IF (tmc_params%print_cell) THEN
518 392 : tmp_name = expand_file_name_ending(file_name_act, "cell")
519 : ! header
520 392 : INQUIRE (FILE=tmp_name, EXIST=file_exists) ! file_exists will be TRUE if the file exist
521 392 : IF (.NOT. file_exists) THEN
522 : CALL open_file(file_name=tmp_name, file_status="NEW", &
523 6 : file_action="WRITE", unit_number=file_ptr)
524 : WRITE (file_ptr, FMT='(A,9(7X,A2," [Angstrom]"),6X,A)') &
525 6 : "# MC step ", "Ax", "Ay", "Az", "Bx", "By", "Bz", "Cx", "Cy", "Cz", &
526 12 : "Volume [Angstrom^3]"
527 : ELSE
528 : CALL open_file(file_name=tmp_name, file_status="OLD", &
529 : file_action="WRITE", file_position="APPEND", &
530 386 : unit_number=file_ptr)
531 : END IF
532 : CALL get_scaled_cell(cell=tmc_params%cell, &
533 : box_scale=elem%box_scale, scaled_hmat=hmat_scaled, &
534 392 : vol=vol)
535 392 : WRITE (file_ptr, FMT="(I8,9(1X,F19.10),1X,F24.10)") conf_nr, &
536 5488 : hmat_scaled(:, :)*au2a, vol*au2a**3
537 : !TODO better cell output e.g. using cell_types routine
538 392 : CALL close_file(unit_number=file_ptr)
539 : END IF
540 :
541 : ! write the different energies
542 1025 : IF (tmc_params%print_energies) THEN
543 331 : tmp_name = expand_file_name_ending(file_name_act, "ener")
544 : ! header
545 331 : INQUIRE (FILE=tmp_name, EXIST=file_exists) ! file_exists will be TRUE if the file exist
546 331 : IF (.NOT. file_exists) THEN
547 : CALL open_file(file_name=tmp_name, file_status="NEW", &
548 3 : file_action="WRITE", unit_number=file_ptr)
549 : WRITE (file_ptr, FMT='(A,4A20)') &
550 3 : "# MC step ", " exact ", " approx ", " last SCF ", " kinetic "
551 : ELSE
552 : CALL open_file(file_name=tmp_name, file_status="OLD", &
553 : file_action="WRITE", file_position="APPEND", &
554 328 : unit_number=file_ptr)
555 : END IF
556 331 : WRITE (file_ptr, FMT="(I8,14F20.10)") conf_nr, elem%potential, elem%e_pot_approx, &
557 662 : elem%scf_energies(MOD(elem%scf_energies_count, 4) + 1), elem%ekin
558 331 : CALL close_file(unit_number=file_ptr)
559 : END IF
560 :
561 : ! end the timing
562 1025 : CALL timestop(handle)
563 : END IF
564 1025 : END SUBROUTINE write_element_in_file
565 :
566 : ! **************************************************************************************************
567 : !> \brief writes the cell dipoles in dipole trajectory file
568 : !> \param file_name ...
569 : !> \param conf_nr ...
570 : !> \param dip ...
571 : !> \param file_ext ...
572 : !> \param
573 : !> \author Mandes 11.2012
574 : ! **************************************************************************************************
575 500 : SUBROUTINE write_dipoles_in_file(file_name, conf_nr, dip, file_ext)
576 : CHARACTER(LEN=default_path_length) :: file_name
577 : INTEGER :: conf_nr
578 : REAL(KIND=dp), DIMENSION(:), POINTER :: dip
579 : CHARACTER(LEN=*), INTENT(in), OPTIONAL :: file_ext
580 :
581 : CHARACTER(LEN=default_path_length) :: file_name_tmp
582 : INTEGER :: file_ptr
583 : LOGICAL :: file_exists
584 :
585 500 : CPASSERT(ASSOCIATED(dip))
586 :
587 500 : IF (PRESENT(file_ext)) THEN
588 500 : CPASSERT(file_ext /= "")
589 500 : file_name_tmp = expand_file_name_ending(file_name, TRIM(file_ext))
590 : ELSE
591 0 : file_name_tmp = expand_file_name_ending(file_name, "dip")
592 : END IF
593 500 : INQUIRE (FILE=file_name_tmp, EXIST=file_exists)
594 500 : IF (.NOT. file_exists) THEN
595 : CALL open_file(file_name=file_name_tmp, file_status="NEW", &
596 3 : file_action="WRITE", unit_number=file_ptr)
597 3 : WRITE (file_ptr, FMT='(A8,10A20)') "# conf_nr", "dip_x [C Angstrom]", &
598 6 : "dip_y [C Angstrom]", "dip_z [C Angstrom]"
599 : ELSE
600 : CALL open_file(file_name=file_name_tmp, file_status="OLD", &
601 : file_action="WRITE", file_position="APPEND", &
602 497 : unit_number=file_ptr)
603 : END IF
604 2000 : WRITE (file_ptr, FMT="(I8,10F20.10)") conf_nr, dip(:)
605 500 : CALL close_file(unit_number=file_ptr)
606 500 : END SUBROUTINE write_dipoles_in_file
607 :
608 : !----------------------------------------------------------------------------
609 : ! read configuration from file
610 : !----------------------------------------------------------------------------
611 :
612 : ! **************************************************************************************************
613 : !> \brief read the trajectory element from a file from sub tree element
614 : !> \param elem actual tree element to be printed out
615 : !> \param tmc_ana TMC analysis environment parameters
616 : !> \param conf_nr Markov chain element number
617 : !> (input the old number and read only if conf nr from file is greater
618 : !> \param stat ...
619 : !> \author Mandes 03.2013
620 : ! **************************************************************************************************
621 2098 : SUBROUTINE read_element_from_file(elem, tmc_ana, conf_nr, stat)
622 : TYPE(tree_type), POINTER :: elem
623 : TYPE(tmc_analysis_env), POINTER :: tmc_ana
624 : INTEGER :: conf_nr, stat
625 :
626 : CHARACTER(LEN=*), PARAMETER :: routineN = 'read_element_from_file'
627 :
628 : INTEGER :: conf_nr_old, handle, i_tmp
629 : LOGICAL :: files_conf_missmatch
630 :
631 1049 : stat = TMC_STATUS_OK
632 1049 : conf_nr_old = conf_nr
633 1049 : files_conf_missmatch = .FALSE.
634 :
635 1049 : CPASSERT(ASSOCIATED(elem))
636 1049 : CPASSERT(ASSOCIATED(tmc_ana))
637 1049 : CPASSERT(ASSOCIATED(tmc_ana%atoms))
638 :
639 : ! start the timing
640 1049 : CALL timeset(routineN, handle)
641 :
642 : ! read the coordinates
643 1049 : IF (tmc_ana%id_traj > 0) THEN
644 1049 : i_tmp = conf_nr_old
645 : CALL read_pos_from_file(elem=elem, tmc_ana=tmc_ana, stat=stat, &
646 1049 : conf_nr=i_tmp)
647 1049 : IF (stat == TMC_STATUS_WAIT_FOR_NEW_TASK) THEN
648 : CALL cp_warn(__LOCATION__, &
649 : 'end of position file reached at line '// &
650 : cp_to_string(REAL(tmc_ana%lc_traj, KIND=dp))//", last element "// &
651 18 : cp_to_string(tmc_ana%last_elem%nr))
652 : ELSE
653 1031 : CPASSERT(i_tmp > conf_nr_old)
654 1031 : conf_nr = i_tmp
655 1031 : elem%nr = i_tmp
656 : END IF
657 : END IF
658 :
659 : ! read the forces
660 : ! TODO if necessary
661 :
662 : ! read the dipoles file
663 1049 : IF (tmc_ana%id_dip > 0 .AND. stat == TMC_STATUS_OK) THEN
664 0 : i_tmp = conf_nr_old
665 : search_conf_dip: DO
666 : CALL read_dipole_from_file(elem=elem, tmc_ana=tmc_ana, stat=stat, &
667 0 : conf_nr=i_tmp)
668 0 : IF (stat == TMC_STATUS_WAIT_FOR_NEW_TASK) THEN
669 : CALL cp_warn(__LOCATION__, &
670 : 'end of dipole file reached at line'// &
671 0 : cp_to_string(REAL(tmc_ana%lc_dip, KIND=dp)))
672 0 : EXIT search_conf_dip
673 : END IF
674 : ! check consitence with pos file
675 0 : IF (tmc_ana%id_traj > 0) THEN
676 0 : IF (i_tmp == conf_nr) THEN
677 : files_conf_missmatch = .FALSE.
678 : EXIT search_conf_dip
679 : ELSE
680 : ! the configuration numbering differ from the position file,
681 : ! but we keep on searching for the correct configuration
682 : files_conf_missmatch = .TRUE.
683 : END IF
684 : ! if no pos file, just take the next conf
685 0 : ELSE IF (i_tmp > conf_nr_old) THEN
686 0 : conf_nr = i_tmp
687 0 : elem%nr = i_tmp
688 0 : EXIT search_conf_dip
689 : END IF
690 : END DO search_conf_dip
691 : END IF
692 :
693 : ! read the cell file
694 1049 : IF (tmc_ana%id_cell > 0 .AND. stat == TMC_STATUS_OK) THEN
695 : search_conf_cell: DO
696 : CALL read_cell_from_file(elem=elem, tmc_ana=tmc_ana, stat=stat, &
697 1206 : conf_nr=i_tmp)
698 1206 : IF (stat == TMC_STATUS_WAIT_FOR_NEW_TASK) THEN
699 : CALL cp_warn(__LOCATION__, &
700 : 'end of cell file reached at line at line'// &
701 0 : cp_to_string(REAL(tmc_ana%lc_cell, KIND=dp)))
702 0 : EXIT search_conf_cell
703 : END IF
704 : ! check consitence with pos file
705 1206 : IF (tmc_ana%id_traj > 0) THEN
706 1206 : IF (i_tmp == conf_nr) THEN
707 : files_conf_missmatch = .FALSE.
708 : EXIT search_conf_cell
709 : ELSE
710 : ! the configuration numbering differ from the position file,
711 : ! but we keep on searching for the correct configuration
712 : files_conf_missmatch = .TRUE.
713 : END IF
714 : ! if no pos file, just take the next conf
715 0 : ELSE IF (i_tmp > conf_nr_old) THEN
716 0 : conf_nr = i_tmp
717 0 : elem%nr = i_tmp
718 0 : EXIT search_conf_cell
719 : END IF
720 : END DO search_conf_cell
721 :
722 : END IF
723 :
724 : ! write the different energies
725 : ! TODO if necessary
726 :
727 1049 : IF (files_conf_missmatch) THEN
728 : CALL cp_warn(__LOCATION__, &
729 : 'there is a missmatch in the configuration numbering. '// &
730 : "Read number of lines (pos|cell|dip)"// &
731 : cp_to_string(tmc_ana%lc_traj)//"|"// &
732 : cp_to_string(tmc_ana%lc_cell)//"|"// &
733 0 : cp_to_string(tmc_ana%lc_dip))
734 : END IF
735 :
736 : ! end the timing
737 1049 : CALL timestop(handle)
738 1049 : END SUBROUTINE read_element_from_file
739 :
740 : ! **************************************************************************************************
741 : !> \brief search for the next configurational position in file
742 : !> \param elem actual tree element to be read
743 : !> \param tmc_ana ...
744 : !> \param stat ...
745 : !> \param conf_nr Markov chain element number
746 : !> (input the old number and read only if conf nr from file is greater
747 : !> \param header_info ...
748 : !> \author Mandes 03.2013
749 : ! **************************************************************************************************
750 2098 : SUBROUTINE read_pos_from_file(elem, tmc_ana, stat, conf_nr, header_info)
751 : TYPE(tree_type), POINTER :: elem
752 : TYPE(tmc_analysis_env), POINTER :: tmc_ana
753 : INTEGER :: stat, conf_nr
754 : CHARACTER(LEN=*), OPTIONAL :: header_info
755 :
756 : CHARACTER(LEN=*), PARAMETER :: routineN = 'read_pos_from_file'
757 :
758 : CHARACTER(LEN=default_string_length) :: c_tmp
759 : INTEGER :: handle, i, i_tmp, status
760 :
761 1049 : stat = TMC_STATUS_FAILED
762 :
763 0 : CPASSERT(ASSOCIATED(elem))
764 1049 : CPASSERT(ASSOCIATED(elem%pos))
765 1049 : CPASSERT(ASSOCIATED(tmc_ana))
766 1049 : CPASSERT(tmc_ana%id_traj > 0)
767 :
768 : ! start the timing
769 1049 : CALL timeset(routineN, handle)
770 :
771 : search_next_conf: DO
772 6105 : c_tmp(:) = " "
773 6105 : tmc_ana%lc_traj = tmc_ana%lc_traj + 1
774 6105 : READ (tmc_ana%id_traj, '(A)', IOSTAT=status) c_tmp(:)
775 6105 : IF (status > 0) THEN
776 : CALL cp_abort(__LOCATION__, &
777 : "configuration header read error at line: "// &
778 0 : cp_to_string(tmc_ana%lc_traj)//": "//c_tmp)
779 : END IF
780 6105 : IF (status < 0) THEN ! end of file reached
781 18 : stat = TMC_STATUS_WAIT_FOR_NEW_TASK
782 18 : EXIT search_next_conf
783 : END IF
784 6087 : IF (INDEX(c_tmp, "=") > 0) THEN
785 1206 : READ (c_tmp(INDEX(c_tmp, "=") + 1:), *, IOSTAT=status) i_tmp ! read the configuration number
786 1206 : IF (status /= 0) THEN
787 : CALL cp_abort(__LOCATION__, &
788 : "configuration header read error (for conf nr) at line: "// &
789 0 : cp_to_string(tmc_ana%lc_traj))
790 : END IF
791 1206 : IF (i_tmp > conf_nr) THEN
792 : ! TODO we could also read the energy ...
793 1031 : conf_nr = i_tmp
794 1031 : IF (PRESENT(header_info)) header_info = c_tmp
795 1031 : stat = TMC_STATUS_OK
796 1031 : EXIT search_next_conf
797 : END IF
798 : END IF
799 : END DO search_next_conf
800 :
801 1049 : IF (stat == TMC_STATUS_OK) THEN
802 22682 : pos_loop: DO i = 1, SIZE(elem%pos), tmc_ana%dim_per_elem
803 21651 : tmc_ana%lc_traj = tmc_ana%lc_traj + 1
804 : READ (tmc_ana%id_traj, FMT="(A4,1X,1000F20.10)", IOSTAT=status) &
805 86604 : c_tmp, elem%pos(i:i + tmc_ana%dim_per_elem - 1)
806 22682 : IF (status /= 0) THEN
807 : CALL cp_abort(__LOCATION__, &
808 : "configuration pos read error at line: "// &
809 0 : cp_to_string(tmc_ana%lc_traj))
810 : END IF
811 : END DO pos_loop
812 65984 : elem%pos(:) = elem%pos(:)/au2a
813 : END IF
814 :
815 : ! end the timing
816 1049 : CALL timestop(handle)
817 1049 : END SUBROUTINE read_pos_from_file
818 :
819 : ! **************************************************************************************************
820 : !> \brief search for the dipole entry
821 : !> \param elem actual tree element to be read
822 : !> \param tmc_ana ...
823 : !> \param stat ...
824 : !> \param conf_nr Markov chain element number
825 : !> (input the old number and read only if conf nr from file is greater
826 : !> \author Mandes 03.2013
827 : ! **************************************************************************************************
828 0 : SUBROUTINE read_dipole_from_file(elem, tmc_ana, stat, conf_nr)
829 : TYPE(tree_type), POINTER :: elem
830 : TYPE(tmc_analysis_env), POINTER :: tmc_ana
831 : INTEGER :: stat, conf_nr
832 :
833 : CHARACTER(LEN=*), PARAMETER :: routineN = 'read_dipole_from_file'
834 :
835 : CHARACTER(LEN=250) :: c_tmp
836 : INTEGER :: handle, status
837 :
838 0 : stat = TMC_STATUS_FAILED
839 :
840 0 : CPASSERT(ASSOCIATED(elem))
841 0 : CPASSERT(ASSOCIATED(elem%dipole))
842 0 : CPASSERT(ASSOCIATED(tmc_ana))
843 0 : CPASSERT(tmc_ana%id_dip > 0)
844 :
845 : ! start the timing
846 0 : CALL timeset(routineN, handle)
847 0 : tmc_ana%lc_dip = tmc_ana%lc_dip + 1
848 0 : READ (tmc_ana%id_dip, FMT="(A)", IOSTAT=status) c_tmp
849 0 : IF (status == 0) THEN
850 : ! skip the initial line (header)
851 0 : IF (INDEX(c_tmp, "#") > 0) THEN
852 0 : tmc_ana%lc_dip = tmc_ana%lc_dip + 1
853 0 : READ (tmc_ana%id_dip, FMT="(A)", IOSTAT=status) c_tmp
854 : END IF
855 : END IF
856 0 : IF (status == 0) THEN
857 : READ (c_tmp, FMT="(I8,10F20.10)", IOSTAT=status) &
858 0 : conf_nr, elem%dipole(:)
859 : END IF
860 0 : IF (status == 0) THEN ! success
861 0 : stat = TMC_STATUS_OK
862 0 : ELSE IF (status < 0) THEN ! end of file reached
863 0 : stat = TMC_STATUS_WAIT_FOR_NEW_TASK
864 : ELSE
865 : IF (status /= 0) THEN
866 0 : CPWARN("configuration dipole read error at line: "//cp_to_string(tmc_ana%lc_dip))
867 : END IF
868 0 : stat = TMC_STATUS_FAILED
869 : END IF
870 :
871 : ! end the timing
872 0 : CALL timestop(handle)
873 0 : END SUBROUTINE read_dipole_from_file
874 :
875 : ! **************************************************************************************************
876 : !> \brief search for the cell entry
877 : !> \param elem actual tree element to be read
878 : !> \param tmc_ana ...
879 : !> \param stat ...
880 : !> \param conf_nr Markov chain element number
881 : !> (input the old number and read only if conf nr from file is greater
882 : !> \author Mandes 03.2013
883 : ! **************************************************************************************************
884 2412 : SUBROUTINE read_cell_from_file(elem, tmc_ana, stat, conf_nr)
885 : TYPE(tree_type), POINTER :: elem
886 : TYPE(tmc_analysis_env), POINTER :: tmc_ana
887 : INTEGER :: stat, conf_nr
888 :
889 : CHARACTER(LEN=*), PARAMETER :: routineN = 'read_cell_from_file'
890 :
891 : CHARACTER(LEN=250) :: c_tmp
892 : INTEGER :: handle, status
893 : REAL(KIND=dp) :: r_tmp
894 : REAL(KIND=dp), DIMENSION(3, 3) :: hmat
895 :
896 1206 : stat = TMC_STATUS_FAILED
897 :
898 1206 : CPASSERT(ASSOCIATED(elem))
899 1206 : CPASSERT(ASSOCIATED(tmc_ana))
900 1206 : CPASSERT(ASSOCIATED(tmc_ana%cell))
901 1206 : CPASSERT(tmc_ana%id_cell > 0)
902 :
903 : ! start the timing
904 1206 : CALL timeset(routineN, handle)
905 :
906 1206 : tmc_ana%lc_cell = tmc_ana%lc_cell + 1
907 1206 : READ (tmc_ana%id_cell, FMT="(A)", IOSTAT=status) c_tmp
908 1206 : IF (status == 0) THEN
909 : ! skip the initial line (header)
910 1206 : IF (INDEX(c_tmp, "#") > 0) THEN
911 18 : tmc_ana%lc_cell = tmc_ana%lc_cell + 1
912 18 : READ (tmc_ana%id_cell, FMT="(A)", IOSTAT=status) c_tmp
913 : END IF
914 : END IF
915 1206 : IF (status == 0) THEN
916 1206 : READ (c_tmp, FMT="(I8,9(1X,F19.10),1X,F24.10)", IOSTAT=status) conf_nr, &
917 2412 : hmat(:, :), r_tmp
918 : END IF
919 1206 : IF (status < 0) THEN ! end of file reached
920 0 : stat = TMC_STATUS_WAIT_FOR_NEW_TASK
921 1206 : ELSE IF (status > 0) THEN
922 : IF (status /= 0) THEN
923 0 : CPABORT("configuration cell read error at line: "//cp_to_string(tmc_ana%lc_cell))
924 : END IF
925 0 : stat = TMC_STATUS_FAILED
926 : ELSE
927 1206 : IF (elem%nr < 0) elem%nr = conf_nr
928 15678 : hmat(:, :) = hmat(:, :)/au2a
929 : ! get the box scaling
930 : CALL get_cell_scaling(cell=tmc_ana%cell, scaled_hmat=hmat, &
931 1206 : box_scale=elem%box_scale)
932 1206 : stat = TMC_STATUS_OK
933 : END IF
934 : ! end the timing
935 1206 : CALL timestop(handle)
936 1206 : END SUBROUTINE read_cell_from_file
937 :
938 : !----------------------------------------------------------------------------
939 : ! get the configurations from file and calc
940 : !----------------------------------------------------------------------------
941 :
942 : ! **************************************************************************************************
943 : !> \brief opens the files for reading configurations data to analyze
944 : !> \param tmc_ana ...
945 : !> \param stat ...
946 : !> \param dir_ind ...
947 : !> \param
948 : !> \author Mandes 02.2013
949 : ! **************************************************************************************************
950 36 : SUBROUTINE analyse_files_open(tmc_ana, stat, dir_ind)
951 : TYPE(tmc_analysis_env), POINTER :: tmc_ana
952 : INTEGER :: stat
953 : INTEGER, OPTIONAL :: dir_ind
954 :
955 : CHARACTER(LEN=*), PARAMETER :: routineN = 'analyse_files_open'
956 :
957 : CHARACTER(LEN=default_path_length) :: dir_name, file_name_act, file_name_temp
958 : INTEGER :: handle
959 : LOGICAL :: file_exists
960 :
961 18 : CPASSERT(ASSOCIATED(tmc_ana))
962 :
963 18 : stat = TMC_STATUS_WAIT_FOR_NEW_TASK
964 :
965 : ! start the timing
966 18 : CALL timeset(routineN, handle)
967 :
968 18 : IF (PRESENT(dir_ind)) THEN
969 18 : CPASSERT(ASSOCIATED(tmc_ana%dirs))
970 18 : CPASSERT(dir_ind > 0)
971 18 : CPASSERT(dir_ind <= SIZE(tmc_ana%dirs))
972 :
973 18 : IF (INDEX(tmc_ana%dirs(dir_ind), "/", BACK=.TRUE.) == &
974 : LEN_TRIM(tmc_ana%dirs(dir_ind))) THEN
975 18 : dir_name = TRIM(tmc_ana%dirs(dir_ind))
976 : ELSE
977 0 : dir_name = TRIM(tmc_ana%dirs(dir_ind))//"/"
978 : END IF
979 : ELSE
980 0 : dir_name = "./"
981 : END IF
982 :
983 : ! open the files
984 : file_name_temp = expand_file_name_temp( &
985 : file_name=tmc_default_trajectory_file_name, &
986 18 : rvalue=tmc_ana%temperature)
987 : ! position file
988 18 : IF (tmc_ana%costum_pos_file_name /= "") THEN
989 0 : file_name_act = TRIM(dir_name)//tmc_ana%costum_pos_file_name
990 : ELSE
991 : file_name_act = TRIM(dir_name)// &
992 18 : expand_file_name_ending(file_name_temp, "xyz")
993 : END IF
994 18 : INQUIRE (FILE=file_name_act, EXIST=file_exists)
995 18 : IF (file_exists) THEN
996 : CALL open_file(file_name=file_name_act, file_status="OLD", &
997 18 : file_action="READ", unit_number=tmc_ana%id_traj)
998 18 : WRITE (tmc_ana%io_unit, FMT='(T2,A,"| ",A,T41,A40)') "TMC_ANA", &
999 36 : "read xyz file", TRIM(file_name_act)
1000 : END IF
1001 :
1002 : ! cell file
1003 18 : IF (tmc_ana%costum_cell_file_name /= "") THEN
1004 0 : file_name_act = TRIM(dir_name)//tmc_ana%costum_cell_file_name
1005 : ELSE
1006 : file_name_act = TRIM(dir_name)// &
1007 18 : expand_file_name_ending(file_name_temp, "cell")
1008 : END IF
1009 18 : INQUIRE (FILE=file_name_act, EXIST=file_exists)
1010 18 : IF (file_exists) THEN
1011 : CALL open_file(file_name=file_name_act, file_status="OLD", &
1012 18 : file_action="READ", unit_number=tmc_ana%id_cell)
1013 18 : WRITE (tmc_ana%io_unit, FMT='(T2,A,"| ",A,T41,A40)') "TMC_ANA", &
1014 36 : "read cell file", TRIM(file_name_act)
1015 : END IF
1016 :
1017 : ! dipole file
1018 18 : IF (tmc_ana%costum_dip_file_name /= "") THEN
1019 18 : file_name_act = TRIM(dir_name)//tmc_ana%costum_dip_file_name
1020 : ELSE
1021 : file_name_act = TRIM(dir_name)// &
1022 0 : expand_file_name_ending(file_name_temp, "dip")
1023 : END IF
1024 18 : INQUIRE (FILE=file_name_act, EXIST=file_exists)
1025 18 : IF (file_exists) THEN
1026 : CALL open_file(file_name=file_name_act, file_status="OLD", &
1027 0 : file_action="READ", unit_number=tmc_ana%id_dip)
1028 0 : WRITE (tmc_ana%io_unit, FMT='(T2,A,"| ",A,T41,A40)') "TMC_ANA", &
1029 0 : "read dip file", TRIM(file_name_act)
1030 : END IF
1031 :
1032 18 : IF (tmc_ana%id_traj > 0 .OR. tmc_ana%id_cell > 0 .OR. &
1033 : tmc_ana%id_dip > 0) THEN
1034 18 : stat = TMC_STATUS_OK
1035 : ELSE
1036 : CALL cp_warn(__LOCATION__, &
1037 : "There is no file to open for temperature "//cp_to_string(tmc_ana%temperature)// &
1038 0 : "K in directory "//TRIM(dir_name))
1039 : END IF
1040 : ! end the timing
1041 18 : CALL timestop(handle)
1042 18 : END SUBROUTINE analyse_files_open
1043 :
1044 : ! **************************************************************************************************
1045 : !> \brief close the files for reading configurations data to analyze
1046 : !> \param tmc_ana ...
1047 : !> \param
1048 : !> \author Mandes 02.2013
1049 : ! **************************************************************************************************
1050 36 : SUBROUTINE analyse_files_close(tmc_ana)
1051 : TYPE(tmc_analysis_env), POINTER :: tmc_ana
1052 :
1053 : CHARACTER(LEN=*), PARAMETER :: routineN = 'analyse_files_close'
1054 :
1055 : INTEGER :: handle
1056 :
1057 18 : CPASSERT(ASSOCIATED(tmc_ana))
1058 :
1059 : ! start the timing
1060 18 : CALL timeset(routineN, handle)
1061 :
1062 : ! position file
1063 18 : IF (tmc_ana%id_traj > 0) CALL close_file(unit_number=tmc_ana%id_traj)
1064 :
1065 : ! cell file
1066 18 : IF (tmc_ana%id_cell > 0) CALL close_file(unit_number=tmc_ana%id_cell)
1067 :
1068 : ! dipole file
1069 18 : IF (tmc_ana%id_dip > 0) CALL close_file(unit_number=tmc_ana%id_dip)
1070 :
1071 : ! end the timing
1072 18 : CALL timestop(handle)
1073 18 : END SUBROUTINE analyse_files_close
1074 :
1075 : END MODULE tmc_file_io
|
