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 Definition and initialisation of the mo data type.
10 : !> \par History
11 : !> - adapted to the new QS environment data structure (02.04.2002,MK)
12 : !> - set_mo_occupation added (17.04.02,MK)
13 : !> - correct_mo_eigenvalues added (18.04.02,MK)
14 : !> - calculate_density_matrix moved from qs_scf to here (22.04.02,MK)
15 : !> - mo_set_p_type added (23.04.02,MK)
16 : !> - PRIVATE attribute set for TYPE mo_set_type (23.04.02,MK)
17 : !> - started conversion to LSD (1.2003, Joost VandeVondele)
18 : !> - Split of from qs_mo_types (07.2014, JGH)
19 : !> \author Matthias Krack (09.05.2001,MK)
20 : ! **************************************************************************************************
21 : MODULE qs_mo_io
22 :
23 : USE atomic_kind_types, ONLY: get_atomic_kind
24 : USE basis_set_types, ONLY: get_gto_basis_set,&
25 : gto_basis_set_p_type,&
26 : gto_basis_set_type
27 : USE cp_dbcsr_api, ONLY: dbcsr_binary_write,&
28 : dbcsr_create,&
29 : dbcsr_p_type,&
30 : dbcsr_release,&
31 : dbcsr_type
32 : USE cp_dbcsr_contrib, ONLY: dbcsr_checksum
33 : USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
34 : copy_fm_to_dbcsr,&
35 : dbcsr_deallocate_matrix_set
36 : USE cp_dbcsr_output, ONLY: cp_dbcsr_write_sparse_matrix
37 : USE cp_files, ONLY: close_file,&
38 : open_file
39 : USE cp_fm_types, ONLY: cp_fm_get_info,&
40 : cp_fm_get_submatrix,&
41 : cp_fm_set_all,&
42 : cp_fm_set_submatrix,&
43 : cp_fm_to_fm,&
44 : cp_fm_type,&
45 : cp_fm_write_unformatted
46 : USE cp_log_handling, ONLY: cp_get_default_logger,&
47 : cp_logger_get_default_unit_nr,&
48 : cp_logger_type,&
49 : cp_to_string
50 : USE cp_output_handling, ONLY: cp_p_file,&
51 : cp_print_key_finished_output,&
52 : cp_print_key_generate_filename,&
53 : cp_print_key_should_output,&
54 : cp_print_key_unit_nr
55 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
56 : section_vals_type,&
57 : section_vals_val_get
58 : USE kahan_sum, ONLY: accurate_sum
59 : USE kinds, ONLY: default_path_length,&
60 : default_string_length,&
61 : dp
62 : USE message_passing, ONLY: mp_para_env_type
63 : USE orbital_pointers, ONLY: indco,&
64 : nco,&
65 : nso
66 : USE orbital_symbols, ONLY: cgf_symbol,&
67 : sgf_symbol
68 : USE orbital_transformation_matrices, ONLY: orbtramat
69 : USE particle_types, ONLY: particle_type
70 : USE physcon, ONLY: evolt
71 : USE qs_density_matrices, ONLY: calculate_density_matrix
72 : USE qs_dftb_types, ONLY: qs_dftb_atom_type
73 : USE qs_dftb_utils, ONLY: get_dftb_atom_param
74 : USE qs_environment_types, ONLY: get_qs_env,&
75 : qs_environment_type
76 : USE qs_kind_types, ONLY: get_qs_kind,&
77 : get_qs_kind_set,&
78 : qs_kind_type
79 : USE qs_ks_types, ONLY: qs_ks_env_type
80 : USE qs_mo_methods, ONLY: calculate_subspace_eigenvalues
81 : USE qs_mo_occupation, ONLY: set_mo_occupation
82 : USE qs_mo_types, ONLY: get_mo_set,&
83 : mo_set_type
84 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type,&
85 : release_neighbor_list_sets
86 : USE qs_neighbor_lists, ONLY: setup_neighbor_list
87 : USE qs_overlap, ONLY: build_overlap_matrix_simple
88 : #include "./base/base_uses.f90"
89 :
90 : IMPLICIT NONE
91 :
92 : PRIVATE
93 :
94 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_mo_io'
95 :
96 : PUBLIC :: wfn_restart_file_name, &
97 : write_rt_mos_to_restart, &
98 : read_rt_mos_from_restart, &
99 : write_dm_binary_restart, &
100 : write_mo_set_to_output_unit, &
101 : write_mo_set_to_restart, &
102 : read_mo_set_from_restart, &
103 : read_mos_restart_low, &
104 : write_mo_set_low
105 :
106 : CONTAINS
107 :
108 : ! **************************************************************************************************
109 : !> \brief ...
110 : !> \param mo_array ...
111 : !> \param particle_set ...
112 : !> \param dft_section ...
113 : !> \param qs_kind_set ...
114 : !> \param matrix_ks ...
115 : ! **************************************************************************************************
116 191411 : SUBROUTINE write_mo_set_to_restart(mo_array, particle_set, dft_section, qs_kind_set, matrix_ks)
117 :
118 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mo_array
119 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
120 : TYPE(section_vals_type), POINTER :: dft_section
121 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
122 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
123 : POINTER :: matrix_ks
124 :
125 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_mo_set_to_restart'
126 : CHARACTER(LEN=30), DIMENSION(2), PARAMETER :: &
127 : keys = ["SCF%PRINT%RESTART_HISTORY", "SCF%PRINT%RESTART "]
128 :
129 : INTEGER :: handle, ikey, ires, ispin
130 : TYPE(cp_logger_type), POINTER :: logger
131 :
132 191411 : CALL timeset(routineN, handle)
133 :
134 191411 : logger => cp_get_default_logger()
135 :
136 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
137 191411 : dft_section, keys(1)), cp_p_file) .OR. &
138 : BTEST(cp_print_key_should_output(logger%iter_info, &
139 : dft_section, keys(2)), cp_p_file)) THEN
140 :
141 19369 : IF (mo_array(1)%use_mo_coeff_b) THEN
142 : ! we are using the dbcsr mo_coeff
143 : ! we copy it to the fm for anycase
144 13454 : DO ispin = 1, SIZE(mo_array)
145 7275 : CPASSERT(ASSOCIATED(mo_array(ispin)%mo_coeff_b))
146 : CALL copy_dbcsr_to_fm(mo_array(ispin)%mo_coeff_b, &
147 13454 : mo_array(ispin)%mo_coeff) !fm->dbcsr
148 : END DO
149 : END IF
150 :
151 58107 : DO ikey = 1, SIZE(keys)
152 38738 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
153 191411 : dft_section, keys(ikey)), cp_p_file)) THEN
154 : ires = cp_print_key_unit_nr(logger, dft_section, keys(ikey), &
155 : extension=".wfn", file_status="REPLACE", file_action="WRITE", &
156 19381 : do_backup=.TRUE., file_form="UNFORMATTED")
157 19381 : IF (PRESENT(matrix_ks)) THEN
158 : CALL write_mo_set_low(mo_array, particle_set=particle_set, qs_kind_set=qs_kind_set, &
159 6163 : ires=ires, matrix_ks=matrix_ks)
160 : ELSE
161 : CALL write_mo_set_low(mo_array, particle_set=particle_set, qs_kind_set=qs_kind_set, &
162 13218 : ires=ires)
163 : END IF
164 19381 : CALL cp_print_key_finished_output(ires, logger, dft_section, TRIM(keys(ikey)))
165 : END IF
166 : END DO
167 : END IF
168 :
169 191411 : CALL timestop(handle)
170 :
171 191411 : END SUBROUTINE write_mo_set_to_restart
172 :
173 : ! **************************************************************************************************
174 : !> \brief calculates density matrix from mo set and writes the density matrix
175 : !> into a binary restart file
176 : !> \param mo_array mos
177 : !> \param dft_section dft input section
178 : !> \param tmpl_matrix template dbcsr matrix
179 : !> \author Mohammad Hossein Bani-Hashemian
180 : ! **************************************************************************************************
181 11099 : SUBROUTINE write_dm_binary_restart(mo_array, dft_section, tmpl_matrix)
182 :
183 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mo_array
184 : TYPE(section_vals_type), POINTER :: dft_section
185 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: tmpl_matrix
186 :
187 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_dm_binary_restart'
188 :
189 : CHARACTER(LEN=default_path_length) :: file_name, project_name
190 : INTEGER :: handle, ispin, unit_nr
191 : LOGICAL :: do_dm_restart
192 : REAL(KIND=dp) :: cs_pos
193 : TYPE(cp_logger_type), POINTER :: logger
194 : TYPE(dbcsr_type), POINTER :: matrix_p_tmp
195 :
196 11099 : CALL timeset(routineN, handle)
197 11099 : logger => cp_get_default_logger()
198 11099 : IF (logger%para_env%is_source()) THEN
199 5678 : unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
200 : ELSE
201 : unit_nr = -1
202 : END IF
203 :
204 11099 : project_name = logger%iter_info%project_name
205 11099 : CALL section_vals_val_get(dft_section, "SCF%PRINT%DM_RESTART_WRITE", l_val=do_dm_restart)
206 11099 : NULLIFY (matrix_p_tmp)
207 :
208 11099 : IF (do_dm_restart) THEN
209 0 : ALLOCATE (matrix_p_tmp)
210 0 : DO ispin = 1, SIZE(mo_array)
211 0 : CALL dbcsr_create(matrix_p_tmp, template=tmpl_matrix(ispin)%matrix, name="DM RESTART")
212 :
213 0 : IF (.NOT. ASSOCIATED(mo_array(ispin)%mo_coeff_b)) CPABORT("mo_coeff_b NOT ASSOCIATED")
214 :
215 0 : CALL copy_fm_to_dbcsr(mo_array(ispin)%mo_coeff, mo_array(ispin)%mo_coeff_b)
216 : CALL calculate_density_matrix(mo_array(ispin), matrix_p_tmp, &
217 0 : use_dbcsr=.TRUE., retain_sparsity=.FALSE.)
218 :
219 0 : WRITE (file_name, '(A,I0,A)') TRIM(project_name)//"_SCF_DM_SPIN_", ispin, "_RESTART.dm"
220 0 : cs_pos = dbcsr_checksum(matrix_p_tmp, pos=.TRUE.)
221 0 : IF (unit_nr > 0) THEN
222 0 : WRITE (unit_nr, '(T2,A,E20.8)') "Writing restart DM "//TRIM(file_name)//" with checksum: ", cs_pos
223 : END IF
224 0 : CALL dbcsr_binary_write(matrix_p_tmp, file_name)
225 :
226 0 : CALL dbcsr_release(matrix_p_tmp)
227 : END DO
228 0 : DEALLOCATE (matrix_p_tmp)
229 : END IF
230 :
231 11099 : CALL timestop(handle)
232 :
233 11099 : END SUBROUTINE write_dm_binary_restart
234 :
235 : ! **************************************************************************************************
236 : !> \brief ...
237 : !> \param mo_array ...
238 : !> \param rt_mos ...
239 : !> \param particle_set ...
240 : !> \param dft_section ...
241 : !> \param qs_kind_set ...
242 : ! **************************************************************************************************
243 444 : SUBROUTINE write_rt_mos_to_restart(mo_array, rt_mos, particle_set, dft_section, qs_kind_set)
244 :
245 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mo_array
246 : TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: rt_mos
247 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
248 : TYPE(section_vals_type), POINTER :: dft_section
249 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
250 :
251 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_rt_mos_to_restart'
252 : CHARACTER(LEN=43), DIMENSION(2), PARAMETER :: keys = [ &
253 : "REAL_TIME_PROPAGATION%PRINT%RESTART_HISTORY", &
254 : "REAL_TIME_PROPAGATION%PRINT%RESTART "]
255 :
256 : INTEGER :: handle, ikey, ires
257 : TYPE(cp_logger_type), POINTER :: logger
258 :
259 444 : CALL timeset(routineN, handle)
260 444 : logger => cp_get_default_logger()
261 :
262 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
263 444 : dft_section, keys(1)), cp_p_file) .OR. &
264 : BTEST(cp_print_key_should_output(logger%iter_info, &
265 : dft_section, keys(2)), cp_p_file)) THEN
266 :
267 342 : DO ikey = 1, SIZE(keys)
268 :
269 228 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
270 444 : dft_section, keys(ikey)), cp_p_file)) THEN
271 : ires = cp_print_key_unit_nr(logger, dft_section, keys(ikey), &
272 : extension=".rtpwfn", file_status="REPLACE", file_action="WRITE", &
273 114 : do_backup=.TRUE., file_form="UNFORMATTED")
274 : CALL write_mo_set_low(mo_array, qs_kind_set=qs_kind_set, particle_set=particle_set, &
275 114 : ires=ires, rt_mos=rt_mos)
276 114 : CALL cp_print_key_finished_output(ires, logger, dft_section, TRIM(keys(ikey)))
277 : END IF
278 : END DO
279 : END IF
280 :
281 444 : CALL timestop(handle)
282 :
283 444 : END SUBROUTINE write_rt_mos_to_restart
284 :
285 : ! **************************************************************************************************
286 : !> \brief ...
287 : !> \param mo_array ...
288 : !> \param qs_kind_set ...
289 : !> \param particle_set ...
290 : !> \param ires ...
291 : !> \param rt_mos ...
292 : !> \param matrix_ks ...
293 : ! **************************************************************************************************
294 19503 : SUBROUTINE write_mo_set_low(mo_array, qs_kind_set, particle_set, ires, rt_mos, matrix_ks)
295 :
296 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mo_array
297 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
298 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
299 : INTEGER :: ires
300 : TYPE(cp_fm_type), DIMENSION(:), INTENT(IN), &
301 : OPTIONAL :: rt_mos
302 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
303 : POINTER :: matrix_ks
304 :
305 : CHARACTER(LEN=*), PARAMETER :: routineN = 'write_mo_set_low'
306 :
307 : INTEGER :: handle, iatom, ikind, imat, iset, &
308 : ishell, ispin, lmax, lshell, &
309 : max_block, nao, natom, nmo, nset, &
310 : nset_max, nshell_max, nspin
311 19503 : INTEGER, DIMENSION(:), POINTER :: nset_info, nshell
312 19503 : INTEGER, DIMENSION(:, :), POINTER :: l, nshell_info
313 19503 : INTEGER, DIMENSION(:, :, :), POINTER :: nso_info
314 19503 : REAL(KIND=dp), DIMENSION(:), POINTER :: mo_eigenvalues, mo_occupation_numbers
315 : TYPE(cp_fm_type), POINTER :: mo_coeff
316 : TYPE(gto_basis_set_type), POINTER :: orb_basis_set
317 : TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
318 :
319 19503 : CALL timeset(routineN, handle)
320 :
321 19503 : NULLIFY (mo_coeff)
322 : NULLIFY (mo_eigenvalues)
323 19503 : NULLIFY (mo_occupation_numbers)
324 :
325 19503 : nspin = SIZE(mo_array)
326 19503 : nao = mo_array(1)%nao
327 :
328 19503 : IF (ires > 0) THEN
329 : ! Create some info about the basis set first
330 9927 : natom = SIZE(particle_set, 1)
331 9927 : nset_max = 0
332 9927 : nshell_max = 0
333 :
334 62774 : DO iatom = 1, natom
335 52847 : NULLIFY (orb_basis_set, dftb_parameter)
336 52847 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
337 : CALL get_qs_kind(qs_kind_set(ikind), &
338 : basis_set=orb_basis_set, &
339 52847 : dftb_parameter=dftb_parameter)
340 115621 : IF (ASSOCIATED(orb_basis_set)) THEN
341 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
342 : nset=nset, &
343 : nshell=nshell, &
344 45305 : l=l)
345 45305 : nset_max = MAX(nset_max, nset)
346 130862 : DO iset = 1, nset
347 130862 : nshell_max = MAX(nshell_max, nshell(iset))
348 : END DO
349 7542 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
350 7541 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
351 7541 : nset_max = MAX(nset_max, 1)
352 7541 : nshell_max = MAX(nshell_max, lmax + 1)
353 : ELSE
354 : ! We assume here an atom without a basis set
355 : ! CPABORT("Unknown basis type. ")
356 : END IF
357 : END DO
358 :
359 49635 : ALLOCATE (nso_info(nshell_max, nset_max, natom))
360 366360 : nso_info(:, :, :) = 0
361 :
362 39708 : ALLOCATE (nshell_info(nset_max, natom))
363 166531 : nshell_info(:, :) = 0
364 :
365 29781 : ALLOCATE (nset_info(natom))
366 62774 : nset_info(:) = 0
367 :
368 62774 : DO iatom = 1, natom
369 52847 : NULLIFY (orb_basis_set, dftb_parameter)
370 52847 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
371 : CALL get_qs_kind(qs_kind_set(ikind), &
372 52847 : basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
373 115621 : IF (ASSOCIATED(orb_basis_set)) THEN
374 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
375 : nset=nset, &
376 : nshell=nshell, &
377 45305 : l=l)
378 45305 : nset_info(iatom) = nset
379 130862 : DO iset = 1, nset
380 85557 : nshell_info(iset, iatom) = nshell(iset)
381 248919 : DO ishell = 1, nshell(iset)
382 118057 : lshell = l(ishell, iset)
383 203614 : nso_info(ishell, iset, iatom) = nso(lshell)
384 : END DO
385 : END DO
386 7542 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
387 7541 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
388 7541 : nset_info(iatom) = 1
389 7541 : nshell_info(1, iatom) = lmax + 1
390 17666 : DO ishell = 1, lmax + 1
391 10125 : lshell = ishell - 1
392 17666 : nso_info(ishell, 1, iatom) = nso(lshell)
393 : END DO
394 : ELSE
395 : ! We assume here an atom without a basis set
396 : ! CPABORT("Unknown basis type. ")
397 : END IF
398 : END DO
399 :
400 9927 : WRITE (ires) natom, nspin, nao, nset_max, nshell_max
401 62774 : WRITE (ires) nset_info
402 166531 : WRITE (ires) nshell_info
403 366360 : WRITE (ires) nso_info
404 :
405 9927 : DEALLOCATE (nset_info)
406 :
407 9927 : DEALLOCATE (nshell_info)
408 :
409 9927 : DEALLOCATE (nso_info)
410 : END IF
411 :
412 : ! Use the ScaLAPACK block size as a default for buffering columns
413 19503 : CALL cp_fm_get_info(mo_array(1)%mo_coeff, ncol_block=max_block)
414 42186 : DO ispin = 1, nspin
415 22683 : mo_coeff => mo_array(ispin)%mo_coeff
416 22683 : nmo = mo_array(ispin)%nmo
417 22683 : IF (nmo > 0) THEN
418 22437 : mo_eigenvalues => mo_array(ispin)%eigenvalues
419 22437 : mo_occupation_numbers => mo_array(ispin)%occupation_numbers
420 22437 : IF (PRESENT(matrix_ks)) THEN
421 : ! With OT: use the Kohn-Sham matrix for the update of the MO eigenvalues
422 : CALL calculate_subspace_eigenvalues(orbitals=mo_coeff, &
423 : ks_matrix=matrix_ks(ispin)%matrix, &
424 7215 : evals_arg=mo_eigenvalues)
425 : END IF
426 22437 : IF (ires > 0) THEN
427 11403 : WRITE (ires) nmo, &
428 11403 : mo_array(ispin)%homo, &
429 11403 : mo_array(ispin)%lfomo, &
430 22806 : mo_array(ispin)%nelectron
431 255426 : WRITE (ires) mo_eigenvalues(1:nmo), mo_occupation_numbers(1:nmo)
432 : END IF
433 : END IF
434 42186 : IF (PRESENT(rt_mos)) THEN
435 438 : DO imat = 2*ispin - 1, 2*ispin
436 438 : CALL cp_fm_write_unformatted(rt_mos(imat), ires)
437 : END DO
438 : ELSE
439 22537 : CALL cp_fm_write_unformatted(mo_coeff, ires)
440 : END IF
441 : END DO
442 :
443 19503 : CALL timestop(handle)
444 :
445 19503 : END SUBROUTINE write_mo_set_low
446 :
447 : ! **************************************************************************************************
448 : !> \brief ...
449 : !> \param filename ...
450 : !> \param exist ...
451 : !> \param section ...
452 : !> \param logger ...
453 : !> \param kp ...
454 : !> \param xas ...
455 : !> \param rtp ...
456 : ! **************************************************************************************************
457 1252 : SUBROUTINE wfn_restart_file_name(filename, exist, section, logger, kp, xas, rtp)
458 : CHARACTER(LEN=default_path_length), INTENT(OUT) :: filename
459 : LOGICAL, INTENT(OUT) :: exist
460 : TYPE(section_vals_type), POINTER :: section
461 : TYPE(cp_logger_type), POINTER :: logger
462 : LOGICAL, INTENT(IN), OPTIONAL :: kp, xas, rtp
463 :
464 : INTEGER :: n_rep_val
465 : LOGICAL :: my_kp, my_rtp, my_xas
466 : TYPE(section_vals_type), POINTER :: print_key
467 :
468 626 : my_kp = .FALSE.
469 626 : my_xas = .FALSE.
470 626 : my_rtp = .FALSE.
471 626 : IF (PRESENT(kp)) my_kp = kp
472 626 : IF (PRESENT(xas)) my_xas = xas
473 626 : IF (PRESENT(rtp)) my_rtp = rtp
474 :
475 626 : exist = .FALSE.
476 626 : CALL section_vals_val_get(section, "WFN_RESTART_FILE_NAME", n_rep_val=n_rep_val)
477 626 : IF (n_rep_val > 0) THEN
478 474 : CALL section_vals_val_get(section, "WFN_RESTART_FILE_NAME", c_val=filename)
479 : ELSE
480 152 : IF (my_xas) THEN
481 : ! try to read from the filename that is generated automatically from the printkey
482 4 : print_key => section_vals_get_subs_vals(section, "PRINT%RESTART")
483 : filename = cp_print_key_generate_filename(logger, print_key, &
484 4 : extension="", my_local=.FALSE.)
485 148 : ELSE IF (my_rtp) THEN
486 : ! try to read from the filename that is generated automatically from the printkey
487 3 : print_key => section_vals_get_subs_vals(section, "REAL_TIME_PROPAGATION%PRINT%RESTART")
488 : filename = cp_print_key_generate_filename(logger, print_key, &
489 3 : extension=".rtpwfn", my_local=.FALSE.)
490 145 : ELSE IF (my_kp) THEN
491 : ! try to read from the filename that is generated automatically from the printkey
492 5 : print_key => section_vals_get_subs_vals(section, "SCF%PRINT%RESTART")
493 : filename = cp_print_key_generate_filename(logger, print_key, &
494 5 : extension=".kp", my_local=.FALSE.)
495 : ELSE
496 : ! try to read from the filename that is generated automatically from the printkey
497 140 : print_key => section_vals_get_subs_vals(section, "SCF%PRINT%RESTART")
498 : filename = cp_print_key_generate_filename(logger, print_key, &
499 140 : extension=".wfn", my_local=.FALSE.)
500 : END IF
501 : END IF
502 626 : IF (.NOT. my_xas) THEN
503 620 : INQUIRE (FILE=filename, exist=exist)
504 : END IF
505 :
506 626 : END SUBROUTINE wfn_restart_file_name
507 :
508 : ! **************************************************************************************************
509 : !> \brief ...
510 : !> \param mo_array ...
511 : !> \param qs_kind_set ...
512 : !> \param particle_set ...
513 : !> \param para_env ...
514 : !> \param id_nr ...
515 : !> \param multiplicity ...
516 : !> \param dft_section ...
517 : !> \param natom_mismatch ...
518 : !> \param cdft ...
519 : !> \param out_unit ...
520 : ! **************************************************************************************************
521 527 : SUBROUTINE read_mo_set_from_restart(mo_array, qs_kind_set, particle_set, &
522 : para_env, id_nr, multiplicity, dft_section, natom_mismatch, &
523 : cdft, out_unit)
524 :
525 : TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT) :: mo_array
526 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
527 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
528 : TYPE(mp_para_env_type), POINTER :: para_env
529 : INTEGER, INTENT(IN) :: id_nr, multiplicity
530 : TYPE(section_vals_type), POINTER :: dft_section
531 : LOGICAL, INTENT(OUT), OPTIONAL :: natom_mismatch
532 : LOGICAL, INTENT(IN), OPTIONAL :: cdft
533 : INTEGER, INTENT(IN), OPTIONAL :: out_unit
534 :
535 : CHARACTER(LEN=*), PARAMETER :: routineN = 'read_mo_set_from_restart'
536 :
537 : CHARACTER(LEN=default_path_length) :: file_name
538 : INTEGER :: handle, ispin, my_out_unit, natom, &
539 : nspin, restart_unit
540 : LOGICAL :: exist, my_cdft
541 : TYPE(cp_logger_type), POINTER :: logger
542 :
543 527 : CALL timeset(routineN, handle)
544 527 : logger => cp_get_default_logger()
545 527 : my_cdft = .FALSE.
546 527 : IF (PRESENT(cdft)) my_cdft = cdft
547 527 : my_out_unit = -1
548 527 : IF (PRESENT(out_unit)) my_out_unit = out_unit
549 :
550 527 : nspin = SIZE(mo_array)
551 527 : restart_unit = -1
552 :
553 527 : IF (para_env%is_source()) THEN
554 :
555 282 : natom = SIZE(particle_set, 1)
556 282 : CALL wfn_restart_file_name(file_name, exist, dft_section, logger)
557 282 : IF (id_nr /= 0) THEN
558 : ! Is it one of the backup files?
559 1 : file_name = TRIM(file_name)//".bak-"//ADJUSTL(cp_to_string(id_nr))
560 : END IF
561 :
562 : CALL open_file(file_name=file_name, &
563 : file_action="READ", &
564 : file_form="UNFORMATTED", &
565 : file_status="OLD", &
566 282 : unit_number=restart_unit)
567 :
568 : END IF
569 :
570 : CALL read_mos_restart_low(mo_array, para_env=para_env, qs_kind_set=qs_kind_set, &
571 : particle_set=particle_set, natom=natom, &
572 527 : rst_unit=restart_unit, multiplicity=multiplicity, natom_mismatch=natom_mismatch)
573 :
574 527 : IF (PRESENT(natom_mismatch)) THEN
575 : ! read_mos_restart_low only the io_node returns natom_mismatch, must broadcast it
576 497 : CALL para_env%bcast(natom_mismatch)
577 497 : IF (natom_mismatch) THEN
578 0 : IF (para_env%is_source()) CALL close_file(unit_number=restart_unit)
579 0 : CALL timestop(handle)
580 0 : RETURN
581 : END IF
582 : END IF
583 :
584 : ! Close restart file
585 527 : IF (para_env%is_source()) THEN
586 282 : IF (my_out_unit > 0) THEN
587 : WRITE (UNIT=my_out_unit, FMT="(T2,A)") &
588 6 : "WFN_RESTART| Restart file "//TRIM(file_name)//" read"
589 : END IF
590 282 : CALL close_file(unit_number=restart_unit)
591 : END IF
592 :
593 : ! CDFT has no real dft_section and does not need to print
594 527 : IF (.NOT. my_cdft) THEN
595 1408 : DO ispin = 1, nspin
596 : CALL write_mo_set_to_output_unit(mo_array(ispin), qs_kind_set, particle_set, &
597 1408 : dft_section, 4, 0, final_mos=.FALSE.)
598 : END DO
599 : END IF
600 :
601 527 : CALL timestop(handle)
602 :
603 : END SUBROUTINE read_mo_set_from_restart
604 :
605 : ! **************************************************************************************************
606 : !> \brief ...
607 : !> \param mo_array ...
608 : !> \param rt_mos ...
609 : !> \param qs_kind_set ...
610 : !> \param particle_set ...
611 : !> \param para_env ...
612 : !> \param id_nr ...
613 : !> \param multiplicity ...
614 : !> \param dft_section ...
615 : ! **************************************************************************************************
616 8 : SUBROUTINE read_rt_mos_from_restart(mo_array, rt_mos, qs_kind_set, particle_set, para_env, id_nr, multiplicity, dft_section)
617 :
618 : TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT) :: mo_array
619 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: rt_mos
620 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
621 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
622 : TYPE(mp_para_env_type), POINTER :: para_env
623 : INTEGER, INTENT(IN) :: id_nr, multiplicity
624 : TYPE(section_vals_type), POINTER :: dft_section
625 :
626 : CHARACTER(LEN=*), PARAMETER :: routineN = 'read_rt_mos_from_restart'
627 :
628 : CHARACTER(LEN=default_path_length) :: file_name
629 : INTEGER :: handle, ispin, natom, nspin, &
630 : restart_unit, unit_nr
631 : LOGICAL :: exist
632 : TYPE(cp_logger_type), POINTER :: logger
633 :
634 8 : CALL timeset(routineN, handle)
635 8 : logger => cp_get_default_logger()
636 :
637 8 : nspin = SIZE(mo_array)
638 8 : restart_unit = -1
639 :
640 8 : IF (para_env%is_source()) THEN
641 :
642 4 : natom = SIZE(particle_set, 1)
643 4 : CALL wfn_restart_file_name(file_name, exist, dft_section, logger, rtp=.TRUE.)
644 4 : IF (id_nr /= 0) THEN
645 : ! Is it one of the backup files?
646 0 : file_name = TRIM(file_name)//".bak-"//ADJUSTL(cp_to_string(id_nr))
647 : END IF
648 :
649 4 : unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
650 4 : IF (unit_nr > 0) THEN
651 4 : WRITE (unit_nr, '(T2,A)') "Read RTP restart from the file: "//TRIM(file_name)
652 : END IF
653 :
654 : CALL open_file(file_name=file_name, &
655 : file_action="READ", &
656 : file_form="UNFORMATTED", &
657 : file_status="OLD", &
658 4 : unit_number=restart_unit)
659 :
660 : END IF
661 :
662 : CALL read_mos_restart_low(mo_array, rt_mos=rt_mos, para_env=para_env, &
663 : particle_set=particle_set, qs_kind_set=qs_kind_set, natom=natom, &
664 8 : rst_unit=restart_unit, multiplicity=multiplicity)
665 :
666 : ! Close restart file
667 8 : IF (para_env%is_source()) CALL close_file(unit_number=restart_unit)
668 :
669 16 : DO ispin = 1, nspin
670 : CALL write_mo_set_to_output_unit(mo_array(ispin), qs_kind_set, particle_set, &
671 16 : dft_section, 4, 0, final_mos=.FALSE.)
672 : END DO
673 :
674 8 : CALL timestop(handle)
675 :
676 8 : END SUBROUTINE read_rt_mos_from_restart
677 :
678 : ! **************************************************************************************************
679 : !> \brief Reading the mos from apreviously defined restart file
680 : !> \param mos ...
681 : !> \param para_env ...
682 : !> \param qs_kind_set ...
683 : !> \param particle_set ...
684 : !> \param natom ...
685 : !> \param rst_unit ...
686 : !> \param multiplicity ...
687 : !> \param rt_mos ...
688 : !> \param natom_mismatch ...
689 : !> \par History
690 : !> 12.2007 created [MI]
691 : !> \author MI
692 : ! **************************************************************************************************
693 585 : SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, rst_unit, &
694 : multiplicity, rt_mos, natom_mismatch)
695 :
696 : TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT) :: mos
697 : TYPE(mp_para_env_type), POINTER :: para_env
698 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
699 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
700 : INTEGER, INTENT(IN) :: natom, rst_unit
701 : INTEGER, INTENT(in), OPTIONAL :: multiplicity
702 : TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: rt_mos
703 : LOGICAL, INTENT(OUT), OPTIONAL :: natom_mismatch
704 :
705 : INTEGER :: homo, homo_read, i, iatom, ikind, imat, irow, iset, iset_read, ishell, &
706 : ishell_read, iso, ispin, lfomo_read, lmax, lshell, my_mult, nao, nao_read, natom_read, &
707 : nelectron, nelectron_read, nmo, nmo_read, nnshell, nset, nset_max, nshell_max, nspin, &
708 : nspin_read, offset_read
709 585 : INTEGER, DIMENSION(:), POINTER :: nset_info, nshell
710 585 : INTEGER, DIMENSION(:, :), POINTER :: l, nshell_info
711 585 : INTEGER, DIMENSION(:, :, :), POINTER :: nso_info, offset_info
712 : LOGICAL :: minbas, natom_match, use_this
713 585 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eig_read, occ_read
714 585 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: vecbuffer, vecbuffer_read
715 : TYPE(cp_logger_type), POINTER :: logger
716 : TYPE(gto_basis_set_type), POINTER :: orb_basis_set
717 : TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
718 :
719 1170 : logger => cp_get_default_logger()
720 :
721 585 : nspin = SIZE(mos)
722 585 : nao = mos(1)%nao
723 585 : my_mult = 0
724 585 : IF (PRESENT(multiplicity)) my_mult = multiplicity
725 :
726 585 : IF (para_env%is_source()) THEN
727 311 : READ (rst_unit) natom_read, nspin_read, nao_read, nset_max, nshell_max
728 311 : IF (PRESENT(rt_mos)) THEN
729 4 : IF (nspin_read /= nspin) THEN
730 0 : CPABORT("To change nspin is not possible. ")
731 : END IF
732 : ELSE
733 : ! we should allow for restarting with different spin settings
734 307 : IF (nspin_read /= nspin) THEN
735 : WRITE (cp_logger_get_default_unit_nr(logger), *) &
736 0 : "READ RESTART : WARNING : nspin is not equal "
737 : END IF
738 : ! this case needs fixing of homo/lfomo/nelec/occupations ...
739 307 : IF (nspin_read > nspin) THEN
740 0 : CPABORT("Reducing nspin is not possible. ")
741 : END IF
742 : END IF
743 :
744 311 : natom_match = (natom_read == natom)
745 :
746 311 : IF (natom_match) THEN ! actually do the read read
747 :
748 : ! Let's make it possible to change the basis set
749 1555 : ALLOCATE (nso_info(nshell_max, nset_max, natom_read))
750 1244 : ALLOCATE (nshell_info(nset_max, natom_read))
751 933 : ALLOCATE (nset_info(natom_read))
752 1244 : ALLOCATE (offset_info(nshell_max, nset_max, natom_read))
753 :
754 311 : IF (nao_read /= nao) THEN
755 : WRITE (cp_logger_get_default_unit_nr(logger), *) &
756 1 : " READ RESTART : WARNING : DIFFERENT # AOs ", nao, nao_read
757 1 : IF (PRESENT(rt_mos)) THEN
758 0 : CPABORT("To change basis is not possible. ")
759 : END IF
760 : END IF
761 :
762 1140 : READ (rst_unit) nset_info
763 2829 : READ (rst_unit) nshell_info
764 6925 : READ (rst_unit) nso_info
765 :
766 311 : i = 1
767 1140 : DO iatom = 1, natom
768 2663 : DO iset = 1, nset_info(iatom)
769 4879 : DO ishell = 1, nshell_info(iset, iatom)
770 2527 : offset_info(ishell, iset, iatom) = i
771 4050 : i = i + nso_info(ishell, iset, iatom)
772 : END DO
773 : END DO
774 : END DO
775 :
776 933 : ALLOCATE (vecbuffer_read(1, nao_read))
777 :
778 : END IF ! natom_match
779 : END IF ! ionode
780 :
781 : ! make natom_match and natom_mismatch uniform across all nodes
782 585 : CALL para_env%bcast(natom_match)
783 585 : IF (PRESENT(natom_mismatch)) natom_mismatch = .NOT. natom_match
784 : ! handle natom_match false
785 585 : IF (.NOT. natom_match) THEN
786 0 : IF (PRESENT(natom_mismatch)) THEN
787 : WRITE (cp_logger_get_default_unit_nr(logger), *) &
788 0 : " READ RESTART : WARNING : DIFFERENT natom, returning ", natom, natom_read
789 : RETURN
790 : ELSE
791 0 : CPABORT("Incorrect number of atoms in restart file. ")
792 : END IF
793 : END IF
794 :
795 585 : CALL para_env%bcast(nspin_read)
796 :
797 1755 : ALLOCATE (vecbuffer(1, nao))
798 :
799 1596 : DO ispin = 1, nspin
800 :
801 1011 : nmo = mos(ispin)%nmo
802 1011 : homo = mos(ispin)%homo
803 5286 : mos(ispin)%eigenvalues(:) = 0.0_dp
804 5286 : mos(ispin)%occupation_numbers(:) = 0.0_dp
805 1011 : CALL cp_fm_set_all(mos(ispin)%mo_coeff, 0.0_dp)
806 :
807 1011 : IF (para_env%is_source() .AND. (nmo > 0)) THEN
808 533 : READ (rst_unit) nmo_read, homo_read, lfomo_read, nelectron_read
809 2132 : ALLOCATE (eig_read(nmo_read), occ_read(nmo_read))
810 533 : eig_read = 0.0_dp
811 533 : occ_read = 0.0_dp
812 :
813 533 : nmo = MIN(nmo, nmo_read)
814 : IF (nmo_read < nmo) THEN
815 : CALL cp_warn(__LOCATION__, &
816 : "The number of MOs on the restart unit is smaller than the number of "// &
817 : "the allocated MOs. The MO set will be padded with zeros!")
818 : END IF
819 533 : IF (nmo_read > nmo) THEN
820 : CALL cp_warn(__LOCATION__, &
821 : "The number of MOs on the restart unit is greater than the number of "// &
822 7 : "the allocated MOs. The read MO set will be truncated!")
823 : END IF
824 :
825 533 : READ (rst_unit) eig_read(1:nmo_read), occ_read(1:nmo_read)
826 2704 : mos(ispin)%eigenvalues(1:nmo) = eig_read(1:nmo)
827 2704 : mos(ispin)%occupation_numbers(1:nmo) = occ_read(1:nmo)
828 533 : DEALLOCATE (eig_read, occ_read)
829 :
830 533 : mos(ispin)%homo = homo_read
831 533 : mos(ispin)%lfomo = lfomo_read
832 533 : IF (MIN(homo_read, homo) > nmo) THEN
833 0 : IF (nelectron_read == mos(ispin)%nelectron) THEN
834 : CALL cp_warn(__LOCATION__, &
835 : "The number of occupied MOs on the restart unit is larger than "// &
836 0 : "the allocated MOs. The read MO set will be truncated and the occupation numbers recalculated!")
837 0 : CALL set_mo_occupation(mo_set=mos(ispin))
838 : ELSE
839 : ! can not make this a warning i.e. homo must be smaller than nmo
840 : ! otherwise e.g. set_mo_occupation will go out of bounds
841 0 : CPABORT("Number of occupied MOs on restart unit larger than allocated MOs. ")
842 : END IF
843 : END IF
844 : END IF
845 :
846 1011 : CALL para_env%bcast(nmo)
847 1011 : CALL para_env%bcast(mos(ispin)%homo)
848 1011 : CALL para_env%bcast(mos(ispin)%lfomo)
849 1011 : CALL para_env%bcast(mos(ispin)%nelectron)
850 9561 : CALL para_env%bcast(mos(ispin)%eigenvalues)
851 9561 : CALL para_env%bcast(mos(ispin)%occupation_numbers)
852 :
853 1011 : IF (PRESENT(rt_mos)) THEN
854 24 : DO imat = 2*ispin - 1, 2*ispin
855 40 : DO i = 1, nmo
856 16 : IF (para_env%is_source()) THEN
857 168 : READ (rst_unit) vecbuffer
858 : ELSE
859 88 : vecbuffer(1, :) = 0.0_dp
860 : END IF
861 656 : CALL para_env%bcast(vecbuffer)
862 : CALL cp_fm_set_submatrix(rt_mos(imat), &
863 32 : vecbuffer, 1, i, nao, 1, transpose=.TRUE.)
864 : END DO
865 : END DO
866 : ELSE
867 5246 : DO i = 1, nmo
868 4243 : IF (para_env%is_source()) THEN
869 145287 : READ (rst_unit) vecbuffer_read
870 : ! now, try to assign the read to the real vector
871 : ! in case the basis set changed this involves some guessing
872 2167 : irow = 1
873 9702 : DO iatom = 1, natom
874 7535 : NULLIFY (orb_basis_set, dftb_parameter, l, nshell)
875 7535 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
876 : CALL get_qs_kind(qs_kind_set(ikind), &
877 7535 : basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
878 7535 : IF (ASSOCIATED(orb_basis_set)) THEN
879 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
880 : nset=nset, &
881 : nshell=nshell, &
882 7487 : l=l)
883 7487 : minbas = .FALSE.
884 48 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
885 48 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
886 48 : nset = 1
887 48 : minbas = .TRUE.
888 : ELSE
889 : ! assume an atom without basis set
890 : ! CPABORT("Unknown basis set type. ")
891 0 : nset = 0
892 : END IF
893 :
894 7535 : use_this = .TRUE.
895 7535 : iset_read = 1
896 35114 : DO iset = 1, nset
897 17877 : ishell_read = 1
898 17877 : IF (minbas) THEN
899 48 : nnshell = lmax + 1
900 : ELSE
901 17829 : nnshell = nshell(iset)
902 : END IF
903 56888 : DO ishell = 1, nnshell
904 31476 : IF (minbas) THEN
905 72 : lshell = ishell - 1
906 : ELSE
907 31404 : lshell = l(ishell, iset)
908 : END IF
909 31476 : IF (iset_read > nset_info(iatom)) use_this = .FALSE.
910 : IF (use_this) THEN ! avoids out of bound access of the lower line if false
911 31452 : IF (nso(lshell) == nso_info(ishell_read, iset_read, iatom)) THEN
912 31452 : offset_read = offset_info(ishell_read, iset_read, iatom)
913 31452 : ishell_read = ishell_read + 1
914 31452 : IF (ishell_read > nshell_info(iset, iatom)) THEN
915 17873 : ishell_read = 1
916 17873 : iset_read = iset_read + 1
917 : END IF
918 : ELSE
919 : use_this = .FALSE.
920 : END IF
921 : END IF
922 103180 : DO iso = 1, nso(lshell)
923 71704 : IF (use_this) THEN
924 71560 : IF (offset_read - 1 + iso < 1 .OR. offset_read - 1 + iso > nao_read) THEN
925 0 : vecbuffer(1, irow) = 0.0_dp
926 : ELSE
927 71560 : vecbuffer(1, irow) = vecbuffer_read(1, offset_read - 1 + iso)
928 : END IF
929 : ELSE
930 144 : vecbuffer(1, irow) = 0.0_dp
931 : END IF
932 103180 : irow = irow + 1
933 : END DO
934 49353 : use_this = .TRUE.
935 : END DO
936 : END DO
937 : END DO
938 :
939 : ELSE
940 :
941 72302 : vecbuffer(1, :) = 0.0_dp
942 :
943 : END IF
944 :
945 571963 : CALL para_env%bcast(vecbuffer)
946 : CALL cp_fm_set_submatrix(mos(ispin)%mo_coeff, &
947 5246 : vecbuffer, 1, i, nao, 1, transpose=.TRUE.)
948 : END DO
949 : END IF
950 : ! Skip extra MOs if there any
951 1011 : IF (para_env%is_source()) THEN
952 : !ignore nmo = 0
953 536 : IF (nmo > 0) THEN
954 563 : DO i = nmo + 1, nmo_read
955 1783 : READ (rst_unit) vecbuffer_read
956 : END DO
957 : END IF
958 : END IF
959 :
960 1596 : IF (.NOT. PRESENT(rt_mos)) THEN
961 1003 : IF (ispin == 1 .AND. nspin_read < nspin) THEN
962 :
963 0 : mos(ispin + 1)%homo = mos(ispin)%homo
964 0 : mos(ispin + 1)%lfomo = mos(ispin)%lfomo
965 0 : nelectron = mos(ispin)%nelectron
966 0 : IF (my_mult /= 1) THEN
967 : CALL cp_abort(__LOCATION__, &
968 0 : "Restarting an LSD calculation from an LDA wfn only works for multiplicity=1 (singlets).")
969 : END IF
970 0 : IF (mos(ispin + 1)%nelectron < 0) THEN
971 0 : CPABORT("LSD: too few electrons for this multiplisity. ")
972 : END IF
973 0 : mos(ispin + 1)%eigenvalues = mos(ispin)%eigenvalues
974 0 : mos(ispin)%occupation_numbers = mos(ispin)%occupation_numbers/2.0_dp
975 0 : mos(ispin + 1)%occupation_numbers = mos(ispin)%occupation_numbers
976 0 : CALL cp_fm_to_fm(mos(ispin)%mo_coeff, mos(ispin + 1)%mo_coeff)
977 0 : EXIT
978 : END IF
979 : END IF
980 : END DO ! ispin
981 :
982 585 : DEALLOCATE (vecbuffer)
983 :
984 585 : IF (para_env%is_source()) THEN
985 311 : DEALLOCATE (vecbuffer_read)
986 311 : DEALLOCATE (offset_info)
987 311 : DEALLOCATE (nso_info)
988 311 : DEALLOCATE (nshell_info)
989 311 : DEALLOCATE (nset_info)
990 : END IF
991 :
992 1170 : END SUBROUTINE read_mos_restart_low
993 :
994 : ! **************************************************************************************************
995 : !> \brief Write MO information to output file (eigenvalues, occupation numbers, coefficients)
996 : !> \param mo_set ...
997 : !> \param qs_kind_set ...
998 : !> \param particle_set ...
999 : !> \param dft_section ...
1000 : !> \param before Digits before the dot
1001 : !> \param kpoint An integer that labels the current k point, e.g. its index
1002 : !> \param final_mos ...
1003 : !> \param spin ...
1004 : !> \param solver_method ...
1005 : !> \param rtp ...
1006 : !> \param cpart ...
1007 : !> \param sim_step ...
1008 : !> \param umo_set ...
1009 : !> \param qs_env ...
1010 : !> \date 15.05.2001
1011 : !> \par History:
1012 : !> - Optionally print Cartesian MOs (20.04.2005, MK)
1013 : !> - Revise printout of MO information (05.05.2021, MK)
1014 : !> \par Variables
1015 : !> - after : Number of digits after point.
1016 : !> - before: Number of digits before point.
1017 : !> \author Matthias Krack (MK)
1018 : !> \version 1.1
1019 : ! **************************************************************************************************
1020 6415 : SUBROUTINE write_mo_set_to_output_unit(mo_set, qs_kind_set, particle_set, &
1021 : dft_section, before, kpoint, final_mos, spin, &
1022 : solver_method, rtp, cpart, sim_step, umo_set, qs_env)
1023 :
1024 : TYPE(mo_set_type), INTENT(IN) :: mo_set
1025 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1026 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1027 : TYPE(section_vals_type), POINTER :: dft_section
1028 : INTEGER, INTENT(IN) :: before, kpoint
1029 : LOGICAL, INTENT(IN), OPTIONAL :: final_mos
1030 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: spin
1031 : CHARACTER(LEN=2), INTENT(IN), OPTIONAL :: solver_method
1032 : LOGICAL, INTENT(IN), OPTIONAL :: rtp
1033 : INTEGER, INTENT(IN), OPTIONAL :: cpart, sim_step
1034 : TYPE(mo_set_type), INTENT(IN), OPTIONAL :: umo_set
1035 : TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
1036 :
1037 : CHARACTER(LEN=12) :: symbol
1038 6415 : CHARACTER(LEN=12), DIMENSION(:), POINTER :: bcgf_symbol
1039 : CHARACTER(LEN=14) :: fmtstr5
1040 : CHARACTER(LEN=15) :: energy_str, orbital_str, step_string
1041 : CHARACTER(LEN=2) :: element_symbol, my_solver_method
1042 : CHARACTER(LEN=2*default_string_length) :: name
1043 : CHARACTER(LEN=21) :: vector_str
1044 : CHARACTER(LEN=22) :: fmtstr4
1045 : CHARACTER(LEN=24) :: fmtstr2
1046 : CHARACTER(LEN=25) :: fmtstr1
1047 : CHARACTER(LEN=29) :: fmtstr6
1048 : CHARACTER(LEN=4) :: reim
1049 : CHARACTER(LEN=40) :: fmtstr3
1050 6415 : CHARACTER(LEN=6), DIMENSION(:), POINTER :: bsgf_symbol
1051 : INTEGER :: after, first_mo, from, homo, iatom, icgf, ico, icol, ikind, imo, irow, iset, &
1052 : isgf, ishell, iso, iw, jcol, last_mo, left, lmax, lshell, nao, natom, ncgf, ncol, nkind, &
1053 : nmo, nset, nsgf, numo, right, scf_step, to, width
1054 6415 : INTEGER, DIMENSION(:), POINTER :: mo_index_range, nshell
1055 6415 : INTEGER, DIMENSION(:, :), POINTER :: l
1056 : LOGICAL :: ionode, my_final, my_rtp, omit_headers, print_cartesian, print_cartesian_overlap, &
1057 : print_eigvals, print_eigvecs, print_occup, should_output
1058 : REAL(KIND=dp) :: gap, maxocc
1059 6415 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: mo_eigenvalues, mo_occupation_numbers
1060 6415 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: cmatrix, smatrix
1061 6415 : REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvalues, occupation_numbers
1062 : TYPE(cp_fm_type), POINTER :: mo_coeff, umo_coeff
1063 : TYPE(cp_logger_type), POINTER :: logger
1064 6415 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: sro
1065 6415 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: orb_basis_set_list
1066 : TYPE(gto_basis_set_type), POINTER :: orb_basis_set, orbbasis
1067 : TYPE(mp_para_env_type), POINTER :: para_env
1068 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1069 6415 : POINTER :: sro_list
1070 : TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
1071 : TYPE(qs_kind_type), POINTER :: qs_kind
1072 : TYPE(qs_ks_env_type), POINTER :: ks_env
1073 :
1074 6415 : NULLIFY (bcgf_symbol)
1075 6415 : NULLIFY (bsgf_symbol)
1076 6415 : NULLIFY (logger)
1077 6415 : NULLIFY (mo_index_range)
1078 6415 : NULLIFY (nshell)
1079 6415 : NULLIFY (mo_coeff)
1080 :
1081 12830 : logger => cp_get_default_logger()
1082 6415 : ionode = logger%para_env%is_source()
1083 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%EIGENVALUES", l_val=print_eigvals)
1084 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%EIGENVECTORS", l_val=print_eigvecs)
1085 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%OCCUPATION_NUMBERS", l_val=print_occup)
1086 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%CARTESIAN", l_val=print_cartesian)
1087 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%MO_INDEX_RANGE", i_vals=mo_index_range)
1088 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%NDIGITS", i_val=after)
1089 6415 : CALL section_vals_val_get(dft_section, "PRINT%MO%CARTESIAN_OVERLAP", l_val=print_cartesian_overlap)
1090 6415 : after = MIN(MAX(after, 1), 16)
1091 :
1092 : ! Do we print the final MO information after SCF convergence is reached (default: no)
1093 6415 : IF (PRESENT(final_mos)) THEN
1094 6407 : my_final = final_mos
1095 : ELSE
1096 : my_final = .FALSE.
1097 : END IF
1098 :
1099 : ! complex MOS for RTP, no eigenvalues
1100 6415 : my_rtp = .FALSE.
1101 6415 : IF (PRESENT(rtp)) THEN
1102 8 : my_rtp = rtp
1103 : ! print the first time step if MO print required
1104 : should_output = BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
1105 : "PRINT%MO"), cp_p_file) &
1106 8 : .OR. (sim_step == 1)
1107 : ELSE
1108 : should_output = BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
1109 7334 : "PRINT%MO"), cp_p_file) .OR. my_final
1110 : END IF
1111 :
1112 6415 : IF ((.NOT. should_output) .OR. (.NOT. (print_eigvals .OR. print_eigvecs .OR. print_occup))) RETURN
1113 :
1114 5484 : IF (my_rtp) THEN
1115 8 : CPASSERT(PRESENT(sim_step))
1116 8 : CPASSERT(PRESENT(cpart))
1117 8 : scf_step = sim_step
1118 8 : IF (cpart == 0) THEN
1119 4 : reim = "IMAG"
1120 : ELSE
1121 4 : reim = "REAL"
1122 : END IF
1123 8 : print_eigvals = .FALSE.
1124 : ELSE
1125 5476 : scf_step = MAX(0, logger%iter_info%iteration(logger%iter_info%n_rlevel) - 1)
1126 : END IF
1127 :
1128 5484 : IF (.NOT. my_final) THEN
1129 4218 : IF (.NOT. my_rtp) THEN
1130 4210 : step_string = " AFTER SCF STEP"
1131 : ELSE
1132 8 : step_string = " AFTER RTP STEP"
1133 : END IF
1134 : END IF
1135 :
1136 5484 : IF (PRESENT(solver_method)) THEN
1137 5330 : my_solver_method = solver_method
1138 : ELSE
1139 : ! Traditional diagonalization is assumed as default solver method
1140 154 : my_solver_method = "TD"
1141 : END IF
1142 :
1143 : ! Retrieve MO information
1144 : CALL get_mo_set(mo_set=mo_set, &
1145 : mo_coeff=mo_coeff, &
1146 : eigenvalues=eigenvalues, &
1147 : occupation_numbers=occupation_numbers, &
1148 : homo=homo, &
1149 : maxocc=maxocc, &
1150 : nao=nao, &
1151 5484 : nmo=nmo)
1152 5484 : IF (PRESENT(umo_set)) THEN
1153 : CALL get_mo_set(mo_set=umo_set, &
1154 : mo_coeff=umo_coeff, &
1155 20 : nmo=numo)
1156 20 : nmo = nmo + numo
1157 : ELSE
1158 5464 : numo = 0
1159 : END IF
1160 16404 : ALLOCATE (mo_eigenvalues(nmo))
1161 5484 : mo_eigenvalues(:) = 0.0_dp
1162 48552 : mo_eigenvalues(1:nmo - numo) = eigenvalues(1:nmo - numo)
1163 16404 : ALLOCATE (mo_occupation_numbers(nmo))
1164 5484 : mo_occupation_numbers(:) = 0.0_dp
1165 48552 : mo_occupation_numbers(1:nmo - numo) = occupation_numbers(1:nmo - numo)
1166 5484 : IF (numo > 0) THEN
1167 : CALL get_mo_set(mo_set=umo_set, &
1168 20 : eigenvalues=eigenvalues)
1169 130 : mo_eigenvalues(nmo - numo + 1:nmo) = eigenvalues(1:numo)
1170 : END IF
1171 :
1172 5484 : IF (print_eigvecs) THEN
1173 13960 : ALLOCATE (smatrix(nao, nmo))
1174 3502 : CALL cp_fm_get_submatrix(mo_coeff, smatrix(1:nao, 1:nmo - numo))
1175 3502 : IF (numo > 0) THEN
1176 14 : CALL cp_fm_get_submatrix(umo_coeff, smatrix(1:nao, nmo - numo + 1:nmo))
1177 : END IF
1178 3502 : IF (.NOT. ionode) THEN
1179 1751 : DEALLOCATE (smatrix)
1180 : END IF
1181 : END IF
1182 :
1183 5484 : IF (PRESENT(qs_env)) THEN
1184 5330 : IF (ASSOCIATED(qs_env) .AND. my_final .AND. print_cartesian_overlap) THEN
1185 2 : NULLIFY (qs_kind_set)
1186 2 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
1187 2 : nkind = SIZE(qs_kind_set)
1188 :
1189 2 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
1190 : qs_env%input, "DFT%PRINT%AO_MATRICES/OVERLAP"), cp_p_file)) THEN
1191 8 : ALLOCATE (orb_basis_set_list(nkind))
1192 4 : DO ikind = 1, nkind
1193 2 : qs_kind => qs_kind_set(ikind)
1194 2 : NULLIFY (orb_basis_set_list(ikind)%gto_basis_set)
1195 2 : NULLIFY (orbbasis)
1196 2 : CALL get_qs_kind(qs_kind=qs_kind, basis_set=orbbasis, basis_type="ORB")
1197 4 : IF (ASSOCIATED(orbbasis)) orb_basis_set_list(ikind)%gto_basis_set => orbbasis
1198 : END DO
1199 2 : NULLIFY (sro_list)
1200 2 : CALL setup_neighbor_list(sro_list, orb_basis_set_list, qs_env=qs_env)
1201 2 : NULLIFY (sro)
1202 2 : NULLIFY (para_env)
1203 2 : CALL get_qs_env(qs_env, ks_env=ks_env, para_env=para_env)
1204 : CALL build_overlap_matrix_simple(ks_env, sro, &
1205 2 : orb_basis_set_list, orb_basis_set_list, sro_list, .TRUE.)
1206 2 : CALL release_neighbor_list_sets(sro_list)
1207 :
1208 : iw = cp_print_key_unit_nr(logger, qs_env%input, "DFT%PRINT%AO_MATRICES/OVERLAP", &
1209 2 : extension=".Log")
1210 2 : CALL section_vals_val_get(qs_env%input, "DFT%PRINT%AO_MATRICES%OMIT_HEADERS", l_val=omit_headers)
1211 2 : CALL section_vals_val_get(qs_env%input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
1212 2 : after = MIN(MAX(after, 1), 16)
1213 2 : IF (ASSOCIATED(sro)) THEN
1214 : CALL cp_dbcsr_write_sparse_matrix(sro(1)%matrix, 4, after, qs_env, para_env, &
1215 : output_unit=iw, omit_headers=omit_headers, &
1216 2 : cartesian_basis=.TRUE.)
1217 : END IF
1218 : CALL cp_print_key_finished_output(iw, logger, qs_env%input, &
1219 2 : "DFT%PRINT%AO_MATRICES/OVERLAP")
1220 2 : IF (ASSOCIATED(sro)) CALL dbcsr_deallocate_matrix_set(sro)
1221 4 : DEALLOCATE (orb_basis_set_list)
1222 : END IF
1223 : END IF
1224 : END IF
1225 :
1226 : iw = cp_print_key_unit_nr(logger, dft_section, "PRINT%MO", &
1227 : ignore_should_output=should_output, &
1228 5484 : extension=".MOLog")
1229 :
1230 5484 : IF (iw > 0) THEN
1231 :
1232 2742 : natom = SIZE(particle_set)
1233 2742 : CALL get_qs_kind_set(qs_kind_set, ncgf=ncgf, nsgf=nsgf)
1234 :
1235 : ! Definition of the variable formats
1236 :
1237 2742 : fmtstr1 = "(T2,A,21X, ( X,I5, X))"
1238 2742 : fmtstr2 = "(T2,A,21X, (1X,F . ))"
1239 2742 : fmtstr3 = "(T2,A,I5,1X,I5,1X,A,1X,A6, (1X,F . ))"
1240 :
1241 2742 : width = before + after + 3
1242 2742 : ncol = INT(56/width)
1243 :
1244 2742 : right = MAX((after - 2), 1)
1245 2742 : left = width - right - 5
1246 :
1247 2742 : WRITE (UNIT=fmtstr1(11:12), FMT="(I2)") ncol
1248 2742 : WRITE (UNIT=fmtstr1(14:15), FMT="(I2)") left
1249 2742 : WRITE (UNIT=fmtstr1(21:22), FMT="(I2)") right
1250 :
1251 2742 : WRITE (UNIT=fmtstr2(11:12), FMT="(I2)") ncol
1252 2742 : WRITE (UNIT=fmtstr2(18:19), FMT="(I2)") width - 1
1253 2742 : WRITE (UNIT=fmtstr2(21:22), FMT="(I2)") after
1254 :
1255 2742 : WRITE (UNIT=fmtstr3(27:28), FMT="(I2)") ncol
1256 2742 : WRITE (UNIT=fmtstr3(34:35), FMT="(I2)") width - 1
1257 2742 : WRITE (UNIT=fmtstr3(37:38), FMT="(I2)") after
1258 :
1259 2742 : IF (my_final .OR. (my_solver_method == "TD")) THEN
1260 2742 : energy_str = "EIGENVALUES"
1261 2742 : vector_str = "EIGENVECTORS"
1262 : ELSE
1263 0 : energy_str = "ENERGIES"
1264 0 : vector_str = "COEFFICIENTS"
1265 : END IF
1266 :
1267 2742 : IF (my_rtp) THEN
1268 4 : energy_str = "ZEROS"
1269 4 : vector_str = TRIM(reim)//" RTP COEFFICIENTS"
1270 : END IF
1271 :
1272 2742 : IF (print_eigvecs) THEN
1273 :
1274 1751 : IF (print_cartesian) THEN
1275 :
1276 97 : orbital_str = "CARTESIAN"
1277 :
1278 388 : ALLOCATE (cmatrix(ncgf, ncgf))
1279 97 : cmatrix = 0.0_dp
1280 :
1281 : ! Transform spherical MOs to Cartesian MOs
1282 97 : icgf = 1
1283 97 : isgf = 1
1284 307 : DO iatom = 1, natom
1285 210 : NULLIFY (orb_basis_set, dftb_parameter)
1286 210 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
1287 : CALL get_qs_kind(qs_kind_set(ikind), &
1288 : basis_set=orb_basis_set, &
1289 210 : dftb_parameter=dftb_parameter)
1290 517 : IF (ASSOCIATED(orb_basis_set)) THEN
1291 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1292 : nset=nset, &
1293 : nshell=nshell, &
1294 174 : l=l)
1295 538 : DO iset = 1, nset
1296 1064 : DO ishell = 1, nshell(iset)
1297 526 : lshell = l(ishell, iset)
1298 : CALL dgemm("T", "N", nco(lshell), nmo, nso(lshell), 1.0_dp, &
1299 : orbtramat(lshell)%c2s, nso(lshell), &
1300 : smatrix(isgf, 1), nsgf, 0.0_dp, &
1301 526 : cmatrix(icgf, 1), ncgf)
1302 526 : icgf = icgf + nco(lshell)
1303 890 : isgf = isgf + nso(lshell)
1304 : END DO
1305 : END DO
1306 36 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
1307 36 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
1308 90 : DO ishell = 1, lmax + 1
1309 54 : lshell = ishell - 1
1310 : CALL dgemm("T", "N", nco(lshell), nsgf, nso(lshell), 1.0_dp, &
1311 : orbtramat(lshell)%c2s, nso(lshell), &
1312 : smatrix(isgf, 1), nsgf, 0.0_dp, &
1313 54 : cmatrix(icgf, 1), ncgf)
1314 54 : icgf = icgf + nco(lshell)
1315 90 : isgf = isgf + nso(lshell)
1316 : END DO
1317 : ELSE
1318 : ! assume atom without basis set
1319 : ! CPABORT("Unknown basis set type")
1320 : END IF
1321 : END DO ! iatom
1322 :
1323 : ELSE
1324 :
1325 1654 : orbital_str = "SPHERICAL"
1326 :
1327 : END IF ! print_cartesian
1328 :
1329 : name = TRIM(energy_str)//", OCCUPATION NUMBERS, AND "// &
1330 1751 : TRIM(orbital_str)//" "//TRIM(vector_str)
1331 :
1332 1751 : IF (.NOT. my_final) THEN
1333 1406 : WRITE (UNIT=name, FMT="(A,1X,I0)") TRIM(name)//step_string, scf_step
1334 : END IF
1335 :
1336 991 : ELSE IF (print_occup .OR. print_eigvals) THEN
1337 991 : name = TRIM(energy_str)//" AND OCCUPATION NUMBERS"
1338 :
1339 991 : IF (.NOT. my_final) THEN
1340 703 : WRITE (UNIT=name, FMT="(A,1X,I0)") TRIM(name)//step_string, scf_step
1341 : END IF
1342 : END IF ! print_eigvecs
1343 :
1344 : ! Print headline
1345 2742 : IF (PRESENT(spin) .AND. (kpoint > 0)) THEN
1346 : WRITE (UNIT=iw, FMT="(/,T2,A,I0)") &
1347 0 : "MO| "//TRIM(spin)//" "//TRIM(name)//" FOR K POINT ", kpoint
1348 : ELSE IF (PRESENT(spin)) THEN
1349 : WRITE (UNIT=iw, FMT="(/,T2,A)") &
1350 310 : "MO| "//TRIM(spin)//" "//TRIM(name)
1351 2432 : ELSE IF (kpoint > 0) THEN
1352 : WRITE (UNIT=iw, FMT="(/,T2,A,I0)") &
1353 293 : "MO| "//TRIM(name)//" FOR K POINT ", kpoint
1354 : ELSE
1355 : WRITE (UNIT=iw, FMT="(/,T2,A)") &
1356 2139 : "MO| "//TRIM(name)
1357 : END IF
1358 :
1359 : ! Check if only a subset of the MOs has to be printed
1360 3026 : IF (ALL(mo_index_range > 0)) THEN
1361 142 : IF (mo_index_range(2) > nmo) THEN
1362 : CALL cp_warn(__LOCATION__, &
1363 7 : "The last orbital index is larger than the number of orbitals.")
1364 : END IF
1365 142 : IF (mo_index_range(1) > mo_index_range(2)) THEN
1366 : CALL cp_warn(__LOCATION__, &
1367 0 : "The first orbital index is larger than the last orbital index.")
1368 : END IF
1369 142 : first_mo = MIN(MAX(1, mo_index_range(1)), nmo)
1370 142 : last_mo = MIN(MAX(first_mo, mo_index_range(2)), nmo)
1371 2600 : ELSE IF (mo_index_range(2) < 0) THEN
1372 0 : IF (mo_index_range(1) > nmo) THEN
1373 : CALL cp_warn(__LOCATION__, &
1374 0 : "The first orbital index is larger than the number of orbitals.")
1375 : END IF
1376 0 : first_mo = MIN(MAX(1, mo_index_range(1)), nmo)
1377 0 : last_mo = nmo
1378 : ELSE
1379 2600 : first_mo = 1
1380 2600 : last_mo = nmo
1381 : END IF
1382 :
1383 2742 : IF (print_eigvecs) THEN
1384 :
1385 : ! Print full MO information
1386 :
1387 3949 : DO icol = first_mo, last_mo, ncol
1388 :
1389 2198 : from = icol
1390 2198 : to = MIN((from + ncol - 1), last_mo)
1391 :
1392 2198 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1393 : WRITE (UNIT=iw, FMT=fmtstr1) &
1394 10204 : "MO|", (jcol, jcol=from, to)
1395 : WRITE (UNIT=iw, FMT=fmtstr2) &
1396 2198 : "MO|", (mo_eigenvalues(jcol), jcol=from, to)
1397 2198 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1398 : WRITE (UNIT=iw, FMT=fmtstr2) &
1399 2198 : "MO|", (mo_occupation_numbers(jcol), jcol=from, to)
1400 2198 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1401 :
1402 2198 : irow = 1
1403 :
1404 8683 : DO iatom = 1, natom
1405 :
1406 4734 : IF (iatom /= 1) WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1407 :
1408 4734 : NULLIFY (orb_basis_set, dftb_parameter)
1409 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, &
1410 4734 : element_symbol=element_symbol, kind_number=ikind)
1411 : CALL get_qs_kind(qs_kind_set(ikind), &
1412 : basis_set=orb_basis_set, &
1413 4734 : dftb_parameter=dftb_parameter)
1414 :
1415 11666 : IF (print_cartesian) THEN
1416 :
1417 876 : IF (ASSOCIATED(orb_basis_set)) THEN
1418 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1419 : nset=nset, &
1420 : nshell=nshell, &
1421 : l=l, &
1422 768 : cgf_symbol=bcgf_symbol)
1423 :
1424 768 : icgf = 1
1425 2592 : DO iset = 1, nset
1426 5064 : DO ishell = 1, nshell(iset)
1427 2472 : lshell = l(ishell, iset)
1428 10968 : DO ico = 1, nco(lshell)
1429 : WRITE (UNIT=iw, FMT=fmtstr3) &
1430 6672 : "MO|", irow, iatom, ADJUSTR(element_symbol), bcgf_symbol(icgf), &
1431 13344 : (cmatrix(irow, jcol), jcol=from, to)
1432 6672 : icgf = icgf + 1
1433 9144 : irow = irow + 1
1434 : END DO
1435 : END DO
1436 : END DO
1437 108 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
1438 108 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
1439 108 : icgf = 1
1440 270 : DO ishell = 1, lmax + 1
1441 162 : lshell = ishell - 1
1442 540 : DO ico = 1, nco(lshell)
1443 270 : symbol = cgf_symbol(1, indco(1:3, icgf))
1444 270 : symbol(1:2) = " "
1445 : WRITE (UNIT=iw, FMT=fmtstr3) &
1446 270 : "MO|", irow, iatom, ADJUSTR(element_symbol), symbol, &
1447 540 : (cmatrix(irow, jcol), jcol=from, to)
1448 270 : icgf = icgf + 1
1449 432 : irow = irow + 1
1450 : END DO
1451 : END DO
1452 : ELSE
1453 : ! assume atom without basis set
1454 : ! CPABORT("Unknown basis set type")
1455 : END IF
1456 :
1457 : ELSE
1458 :
1459 3858 : IF (ASSOCIATED(orb_basis_set)) THEN
1460 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1461 : nset=nset, &
1462 : nshell=nshell, &
1463 : l=l, &
1464 3858 : sgf_symbol=bsgf_symbol)
1465 3858 : isgf = 1
1466 11024 : DO iset = 1, nset
1467 20494 : DO ishell = 1, nshell(iset)
1468 9470 : lshell = l(ishell, iset)
1469 39032 : DO iso = 1, nso(lshell)
1470 : WRITE (UNIT=iw, FMT=fmtstr3) &
1471 22396 : "MO|", irow, iatom, ADJUSTR(element_symbol), bsgf_symbol(isgf), &
1472 44792 : (smatrix(irow, jcol), jcol=from, to)
1473 22396 : isgf = isgf + 1
1474 31866 : irow = irow + 1
1475 : END DO
1476 : END DO
1477 : END DO
1478 0 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
1479 0 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
1480 0 : isgf = 1
1481 0 : DO ishell = 1, lmax + 1
1482 0 : lshell = ishell - 1
1483 0 : DO iso = 1, nso(lshell)
1484 0 : symbol = sgf_symbol(1, lshell, -lshell + iso - 1)
1485 0 : symbol(1:2) = " "
1486 : WRITE (UNIT=iw, FMT=fmtstr3) &
1487 0 : "MO|", irow, iatom, ADJUSTR(element_symbol), symbol, &
1488 0 : (smatrix(irow, jcol), jcol=from, to)
1489 0 : isgf = isgf + 1
1490 0 : irow = irow + 1
1491 : END DO
1492 : END DO
1493 : ELSE
1494 : ! assume atom without basis set
1495 : ! CPABORT("Unknown basis set type")
1496 : END IF
1497 :
1498 : END IF ! print_cartesian
1499 :
1500 : END DO ! iatom
1501 :
1502 : END DO ! icol
1503 :
1504 1751 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1505 :
1506 : ! Release work storage
1507 :
1508 1751 : IF (print_cartesian) THEN
1509 97 : DEALLOCATE (cmatrix)
1510 : END IF
1511 1751 : DEALLOCATE (smatrix)
1512 :
1513 991 : ELSE IF (print_occup .OR. print_eigvals) THEN
1514 :
1515 991 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1516 991 : fmtstr4 = "(T2,A,I7,3(1X,F22. ))"
1517 991 : WRITE (UNIT=fmtstr4(19:20), FMT="(I2)") after
1518 991 : IF (my_final .OR. (my_solver_method == "TD")) THEN
1519 : WRITE (UNIT=iw, FMT="(A)") &
1520 991 : " MO| Index Eigenvalue [a.u.] Eigenvalue [eV] Occupation"
1521 : ELSE
1522 : WRITE (UNIT=iw, FMT="(A)") &
1523 0 : " MO| Index Energy [a.u.] Energy [eV] Occupation"
1524 : END IF
1525 14530 : DO imo = first_mo, last_mo
1526 : WRITE (UNIT=iw, FMT=fmtstr4) &
1527 13539 : "MO|", imo, mo_eigenvalues(imo), &
1528 13539 : mo_eigenvalues(imo)*evolt, &
1529 28069 : mo_occupation_numbers(imo)
1530 : END DO
1531 991 : fmtstr5 = "(A,T59,F22. )"
1532 991 : WRITE (UNIT=fmtstr5(12:13), FMT="(I2)") after
1533 : WRITE (UNIT=iw, FMT=fmtstr5) &
1534 991 : " MO| Sum:", accurate_sum(mo_occupation_numbers(:))
1535 :
1536 : END IF ! print_eigvecs
1537 :
1538 2742 : IF (.NOT. my_rtp) THEN
1539 2738 : fmtstr6 = "(A,T18,F17. ,A,T41,F17. ,A)"
1540 2738 : WRITE (UNIT=fmtstr6(12:13), FMT="(I2)") after
1541 2738 : WRITE (UNIT=fmtstr6(25:26), FMT="(I2)") after
1542 : WRITE (UNIT=iw, FMT=fmtstr6) &
1543 2738 : " MO| E(Fermi):", mo_set%mu, " a.u.", mo_set%mu*evolt, " eV"
1544 : END IF
1545 2742 : IF ((homo > 0) .AND. .NOT. my_rtp) THEN
1546 2714 : IF ((mo_occupation_numbers(homo) == maxocc) .AND. (last_mo > homo)) THEN
1547 : gap = mo_eigenvalues(homo + 1) - &
1548 409 : mo_eigenvalues(homo)
1549 : WRITE (UNIT=iw, FMT=fmtstr6) &
1550 409 : " MO| Band gap:", gap, " a.u.", gap*evolt, " eV"
1551 : END IF
1552 : END IF
1553 2742 : WRITE (UNIT=iw, FMT="(A)") ""
1554 :
1555 : END IF ! iw
1556 :
1557 5484 : IF (ALLOCATED(mo_eigenvalues)) DEALLOCATE (mo_eigenvalues)
1558 5484 : IF (ALLOCATED(mo_occupation_numbers)) DEALLOCATE (mo_occupation_numbers)
1559 :
1560 : CALL cp_print_key_finished_output(iw, logger, dft_section, "PRINT%MO", &
1561 5484 : ignore_should_output=should_output)
1562 :
1563 24729 : END SUBROUTINE write_mo_set_to_output_unit
1564 :
1565 : END MODULE qs_mo_io
|
