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 189255 : 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 189255 : CALL timeset(routineN, handle)
133 :
134 189255 : logger => cp_get_default_logger()
135 :
136 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
137 189255 : 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 19173 : 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 13346 : DO ispin = 1, SIZE(mo_array)
145 7209 : CPASSERT(ASSOCIATED(mo_array(ispin)%mo_coeff_b))
146 : CALL copy_dbcsr_to_fm(mo_array(ispin)%mo_coeff_b, &
147 13346 : mo_array(ispin)%mo_coeff) !fm->dbcsr
148 : END DO
149 : END IF
150 :
151 57519 : DO ikey = 1, SIZE(keys)
152 38346 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
153 189255 : 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 19185 : do_backup=.TRUE., file_form="UNFORMATTED")
157 19185 : IF (PRESENT(matrix_ks)) THEN
158 : CALL write_mo_set_low(mo_array, particle_set=particle_set, qs_kind_set=qs_kind_set, &
159 6121 : 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 13064 : ires=ires)
163 : END IF
164 19185 : CALL cp_print_key_finished_output(ires, logger, dft_section, TRIM(keys(ikey)))
165 : END IF
166 : END DO
167 : END IF
168 :
169 189255 : CALL timestop(handle)
170 :
171 189255 : 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 11043 : 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 11043 : CALL timeset(routineN, handle)
197 11043 : logger => cp_get_default_logger()
198 11043 : IF (logger%para_env%is_source()) THEN
199 5650 : unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
200 : ELSE
201 : unit_nr = -1
202 : END IF
203 :
204 11043 : project_name = logger%iter_info%project_name
205 11043 : CALL section_vals_val_get(dft_section, "SCF%PRINT%DM_RESTART_WRITE", l_val=do_dm_restart)
206 11043 : NULLIFY (matrix_p_tmp)
207 :
208 11043 : 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 11043 : CALL timestop(handle)
232 :
233 11043 : 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 19307 : 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 19307 : INTEGER, DIMENSION(:), POINTER :: nset_info, nshell
312 19307 : INTEGER, DIMENSION(:, :), POINTER :: l, nshell_info
313 19307 : INTEGER, DIMENSION(:, :, :), POINTER :: nso_info
314 19307 : 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 19307 : CALL timeset(routineN, handle)
320 :
321 19307 : NULLIFY (mo_coeff)
322 : NULLIFY (mo_eigenvalues)
323 19307 : NULLIFY (mo_occupation_numbers)
324 :
325 19307 : nspin = SIZE(mo_array)
326 19307 : nao = mo_array(1)%nao
327 :
328 19307 : IF (ires > 0) THEN
329 : ! Create some info about the basis set first
330 9829 : natom = SIZE(particle_set, 1)
331 9829 : nset_max = 0
332 9829 : nshell_max = 0
333 :
334 62103 : DO iatom = 1, natom
335 52274 : NULLIFY (orb_basis_set, dftb_parameter)
336 52274 : 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 52274 : dftb_parameter=dftb_parameter)
340 114377 : 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 44732 : l=l)
345 44732 : nset_max = MAX(nset_max, nset)
346 129172 : DO iset = 1, nset
347 129172 : nshell_max = MAX(nshell_max, nshell(iset))
348 : END DO
349 7542 : ELSEIF (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 49145 : ALLOCATE (nso_info(nshell_max, nset_max, natom))
360 362745 : nso_info(:, :, :) = 0
361 :
362 39316 : ALLOCATE (nshell_info(nset_max, natom))
363 164479 : nshell_info(:, :) = 0
364 :
365 29487 : ALLOCATE (nset_info(natom))
366 62103 : nset_info(:) = 0
367 :
368 62103 : DO iatom = 1, natom
369 52274 : NULLIFY (orb_basis_set, dftb_parameter)
370 52274 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
371 : CALL get_qs_kind(qs_kind_set(ikind), &
372 52274 : basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
373 114377 : 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 44732 : l=l)
378 44732 : nset_info(iatom) = nset
379 129172 : DO iset = 1, nset
380 84440 : nshell_info(iset, iatom) = nshell(iset)
381 245989 : DO ishell = 1, nshell(iset)
382 116817 : lshell = l(ishell, iset)
383 201257 : nso_info(ishell, iset, iatom) = nso(lshell)
384 : END DO
385 : END DO
386 7542 : ELSEIF (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 9829 : WRITE (ires) natom, nspin, nao, nset_max, nshell_max
401 62103 : WRITE (ires) nset_info
402 164479 : WRITE (ires) nshell_info
403 362745 : WRITE (ires) nso_info
404 :
405 9829 : DEALLOCATE (nset_info)
406 :
407 9829 : DEALLOCATE (nshell_info)
408 :
409 9829 : DEALLOCATE (nso_info)
410 : END IF
411 :
412 : ! Use the ScaLAPACK block size as a default for buffering columns
413 19307 : CALL cp_fm_get_info(mo_array(1)%mo_coeff, ncol_block=max_block)
414 41648 : DO ispin = 1, nspin
415 22341 : mo_coeff => mo_array(ispin)%mo_coeff
416 22341 : nmo = mo_array(ispin)%nmo
417 22341 : IF (nmo > 0) THEN
418 22095 : mo_eigenvalues => mo_array(ispin)%eigenvalues
419 22095 : mo_occupation_numbers => mo_array(ispin)%occupation_numbers
420 22095 : 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 7149 : evals_arg=mo_eigenvalues)
425 : END IF
426 22095 : IF (ires > 0) THEN
427 11232 : WRITE (ires) nmo, &
428 11232 : mo_array(ispin)%homo, &
429 11232 : mo_array(ispin)%lfomo, &
430 22464 : mo_array(ispin)%nelectron
431 250366 : WRITE (ires) mo_eigenvalues(1:nmo), mo_occupation_numbers(1:nmo)
432 : END IF
433 : END IF
434 41648 : 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 22195 : CALL cp_fm_write_unformatted(mo_coeff, ires)
440 : END IF
441 : END DO
442 :
443 19307 : CALL timestop(handle)
444 :
445 19307 : 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 1250 : 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 625 : my_kp = .FALSE.
469 625 : my_xas = .FALSE.
470 625 : my_rtp = .FALSE.
471 625 : IF (PRESENT(kp)) my_kp = kp
472 625 : IF (PRESENT(xas)) my_xas = xas
473 625 : IF (PRESENT(rtp)) my_rtp = rtp
474 :
475 625 : exist = .FALSE.
476 625 : CALL section_vals_val_get(section, "WFN_RESTART_FILE_NAME", n_rep_val=n_rep_val)
477 625 : IF (n_rep_val > 0) THEN
478 474 : CALL section_vals_val_get(section, "WFN_RESTART_FILE_NAME", c_val=filename)
479 : ELSE
480 151 : 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 147 : 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 144 : 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 139 : print_key => section_vals_get_subs_vals(section, "SCF%PRINT%RESTART")
498 : filename = cp_print_key_generate_filename(logger, print_key, &
499 139 : extension=".wfn", my_local=.FALSE.)
500 : END IF
501 : END IF
502 625 : IF (.NOT. my_xas) THEN
503 619 : INQUIRE (FILE=filename, exist=exist)
504 : END IF
505 :
506 625 : 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)) &
758 0 : CPABORT("To change basis is not possible. ")
759 : END IF
760 :
761 1140 : READ (rst_unit) nset_info
762 2829 : READ (rst_unit) nshell_info
763 6925 : READ (rst_unit) nso_info
764 :
765 311 : i = 1
766 1140 : DO iatom = 1, natom
767 2663 : DO iset = 1, nset_info(iatom)
768 4879 : DO ishell = 1, nshell_info(iset, iatom)
769 2527 : offset_info(ishell, iset, iatom) = i
770 4050 : i = i + nso_info(ishell, iset, iatom)
771 : END DO
772 : END DO
773 : END DO
774 :
775 933 : ALLOCATE (vecbuffer_read(1, nao_read))
776 :
777 : END IF ! natom_match
778 : END IF ! ionode
779 :
780 : ! make natom_match and natom_mismatch uniform across all nodes
781 585 : CALL para_env%bcast(natom_match)
782 585 : IF (PRESENT(natom_mismatch)) natom_mismatch = .NOT. natom_match
783 : ! handle natom_match false
784 585 : IF (.NOT. natom_match) THEN
785 0 : IF (PRESENT(natom_mismatch)) THEN
786 : WRITE (cp_logger_get_default_unit_nr(logger), *) &
787 0 : " READ RESTART : WARNING : DIFFERENT natom, returning ", natom, natom_read
788 : RETURN
789 : ELSE
790 0 : CPABORT("Incorrect number of atoms in restart file. ")
791 : END IF
792 : END IF
793 :
794 585 : CALL para_env%bcast(nspin_read)
795 :
796 1755 : ALLOCATE (vecbuffer(1, nao))
797 :
798 1596 : DO ispin = 1, nspin
799 :
800 1011 : nmo = mos(ispin)%nmo
801 1011 : homo = mos(ispin)%homo
802 5286 : mos(ispin)%eigenvalues(:) = 0.0_dp
803 5286 : mos(ispin)%occupation_numbers(:) = 0.0_dp
804 1011 : CALL cp_fm_set_all(mos(ispin)%mo_coeff, 0.0_dp)
805 :
806 1011 : IF (para_env%is_source() .AND. (nmo > 0)) THEN
807 533 : READ (rst_unit) nmo_read, homo_read, lfomo_read, nelectron_read
808 2132 : ALLOCATE (eig_read(nmo_read), occ_read(nmo_read))
809 533 : eig_read = 0.0_dp
810 533 : occ_read = 0.0_dp
811 :
812 533 : nmo = MIN(nmo, nmo_read)
813 : IF (nmo_read < nmo) &
814 : CALL cp_warn(__LOCATION__, &
815 : "The number of MOs on the restart unit is smaller than the number of "// &
816 : "the allocated MOs. The MO set will be padded with zeros!")
817 533 : IF (nmo_read > nmo) &
818 : CALL cp_warn(__LOCATION__, &
819 : "The number of MOs on the restart unit is greater than the number of "// &
820 7 : "the allocated MOs. The read MO set will be truncated!")
821 :
822 533 : READ (rst_unit) eig_read(1:nmo_read), occ_read(1:nmo_read)
823 2704 : mos(ispin)%eigenvalues(1:nmo) = eig_read(1:nmo)
824 2704 : mos(ispin)%occupation_numbers(1:nmo) = occ_read(1:nmo)
825 533 : DEALLOCATE (eig_read, occ_read)
826 :
827 533 : mos(ispin)%homo = homo_read
828 533 : mos(ispin)%lfomo = lfomo_read
829 533 : IF (MIN(homo_read, homo) > nmo) THEN
830 0 : IF (nelectron_read == mos(ispin)%nelectron) THEN
831 : CALL cp_warn(__LOCATION__, &
832 : "The number of occupied MOs on the restart unit is larger than "// &
833 0 : "the allocated MOs. The read MO set will be truncated and the occupation numbers recalculated!")
834 0 : CALL set_mo_occupation(mo_set=mos(ispin))
835 : ELSE
836 : ! can not make this a warning i.e. homo must be smaller than nmo
837 : ! otherwise e.g. set_mo_occupation will go out of bounds
838 0 : CPABORT("Number of occupied MOs on restart unit larger than allocated MOs. ")
839 : END IF
840 : END IF
841 : END IF
842 :
843 1011 : CALL para_env%bcast(nmo)
844 1011 : CALL para_env%bcast(mos(ispin)%homo)
845 1011 : CALL para_env%bcast(mos(ispin)%lfomo)
846 1011 : CALL para_env%bcast(mos(ispin)%nelectron)
847 9561 : CALL para_env%bcast(mos(ispin)%eigenvalues)
848 9561 : CALL para_env%bcast(mos(ispin)%occupation_numbers)
849 :
850 1011 : IF (PRESENT(rt_mos)) THEN
851 24 : DO imat = 2*ispin - 1, 2*ispin
852 40 : DO i = 1, nmo
853 16 : IF (para_env%is_source()) THEN
854 168 : READ (rst_unit) vecbuffer
855 : ELSE
856 88 : vecbuffer(1, :) = 0.0_dp
857 : END IF
858 656 : CALL para_env%bcast(vecbuffer)
859 : CALL cp_fm_set_submatrix(rt_mos(imat), &
860 32 : vecbuffer, 1, i, nao, 1, transpose=.TRUE.)
861 : END DO
862 : END DO
863 : ELSE
864 5246 : DO i = 1, nmo
865 4243 : IF (para_env%is_source()) THEN
866 145287 : READ (rst_unit) vecbuffer_read
867 : ! now, try to assign the read to the real vector
868 : ! in case the basis set changed this involves some guessing
869 2167 : irow = 1
870 9702 : DO iatom = 1, natom
871 7535 : NULLIFY (orb_basis_set, dftb_parameter, l, nshell)
872 7535 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
873 : CALL get_qs_kind(qs_kind_set(ikind), &
874 7535 : basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
875 7535 : IF (ASSOCIATED(orb_basis_set)) THEN
876 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
877 : nset=nset, &
878 : nshell=nshell, &
879 7487 : l=l)
880 7487 : minbas = .FALSE.
881 48 : ELSEIF (ASSOCIATED(dftb_parameter)) THEN
882 48 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
883 48 : nset = 1
884 48 : minbas = .TRUE.
885 : ELSE
886 : ! assume an atom without basis set
887 : ! CPABORT("Unknown basis set type. ")
888 0 : nset = 0
889 : END IF
890 :
891 7535 : use_this = .TRUE.
892 7535 : iset_read = 1
893 35114 : DO iset = 1, nset
894 17877 : ishell_read = 1
895 17877 : IF (minbas) THEN
896 48 : nnshell = lmax + 1
897 : ELSE
898 17829 : nnshell = nshell(iset)
899 : END IF
900 56888 : DO ishell = 1, nnshell
901 31476 : IF (minbas) THEN
902 72 : lshell = ishell - 1
903 : ELSE
904 31404 : lshell = l(ishell, iset)
905 : END IF
906 31476 : IF (iset_read > nset_info(iatom)) use_this = .FALSE.
907 : IF (use_this) THEN ! avoids out of bound access of the lower line if false
908 31452 : IF (nso(lshell) == nso_info(ishell_read, iset_read, iatom)) THEN
909 31452 : offset_read = offset_info(ishell_read, iset_read, iatom)
910 31452 : ishell_read = ishell_read + 1
911 31452 : IF (ishell_read > nshell_info(iset, iatom)) THEN
912 17873 : ishell_read = 1
913 17873 : iset_read = iset_read + 1
914 : END IF
915 : ELSE
916 : use_this = .FALSE.
917 : END IF
918 : END IF
919 103180 : DO iso = 1, nso(lshell)
920 71704 : IF (use_this) THEN
921 71560 : IF (offset_read - 1 + iso < 1 .OR. offset_read - 1 + iso > nao_read) THEN
922 0 : vecbuffer(1, irow) = 0.0_dp
923 : ELSE
924 71560 : vecbuffer(1, irow) = vecbuffer_read(1, offset_read - 1 + iso)
925 : END IF
926 : ELSE
927 144 : vecbuffer(1, irow) = 0.0_dp
928 : END IF
929 103180 : irow = irow + 1
930 : END DO
931 49353 : use_this = .TRUE.
932 : END DO
933 : END DO
934 : END DO
935 :
936 : ELSE
937 :
938 72302 : vecbuffer(1, :) = 0.0_dp
939 :
940 : END IF
941 :
942 571963 : CALL para_env%bcast(vecbuffer)
943 : CALL cp_fm_set_submatrix(mos(ispin)%mo_coeff, &
944 5246 : vecbuffer, 1, i, nao, 1, transpose=.TRUE.)
945 : END DO
946 : END IF
947 : ! Skip extra MOs if there any
948 1011 : IF (para_env%is_source()) THEN
949 : !ignore nmo = 0
950 536 : IF (nmo > 0) THEN
951 563 : DO i = nmo + 1, nmo_read
952 1783 : READ (rst_unit) vecbuffer_read
953 : END DO
954 : END IF
955 : END IF
956 :
957 1596 : IF (.NOT. PRESENT(rt_mos)) THEN
958 1003 : IF (ispin == 1 .AND. nspin_read < nspin) THEN
959 :
960 0 : mos(ispin + 1)%homo = mos(ispin)%homo
961 0 : mos(ispin + 1)%lfomo = mos(ispin)%lfomo
962 0 : nelectron = mos(ispin)%nelectron
963 0 : IF (my_mult /= 1) THEN
964 : CALL cp_abort(__LOCATION__, &
965 0 : "Restarting an LSD calculation from an LDA wfn only works for multiplicity=1 (singlets).")
966 : END IF
967 0 : IF (mos(ispin + 1)%nelectron < 0) THEN
968 0 : CPABORT("LSD: too few electrons for this multiplisity. ")
969 : END IF
970 0 : mos(ispin + 1)%eigenvalues = mos(ispin)%eigenvalues
971 0 : mos(ispin)%occupation_numbers = mos(ispin)%occupation_numbers/2.0_dp
972 0 : mos(ispin + 1)%occupation_numbers = mos(ispin)%occupation_numbers
973 0 : CALL cp_fm_to_fm(mos(ispin)%mo_coeff, mos(ispin + 1)%mo_coeff)
974 0 : EXIT
975 : END IF
976 : END IF
977 : END DO ! ispin
978 :
979 585 : DEALLOCATE (vecbuffer)
980 :
981 585 : IF (para_env%is_source()) THEN
982 311 : DEALLOCATE (vecbuffer_read)
983 311 : DEALLOCATE (offset_info)
984 311 : DEALLOCATE (nso_info)
985 311 : DEALLOCATE (nshell_info)
986 311 : DEALLOCATE (nset_info)
987 : END IF
988 :
989 1170 : END SUBROUTINE read_mos_restart_low
990 :
991 : ! **************************************************************************************************
992 : !> \brief Write MO information to output file (eigenvalues, occupation numbers, coefficients)
993 : !> \param mo_set ...
994 : !> \param qs_kind_set ...
995 : !> \param particle_set ...
996 : !> \param dft_section ...
997 : !> \param before Digits before the dot
998 : !> \param kpoint An integer that labels the current k point, e.g. its index
999 : !> \param final_mos ...
1000 : !> \param spin ...
1001 : !> \param solver_method ...
1002 : !> \param rtp ...
1003 : !> \param cpart ...
1004 : !> \param sim_step ...
1005 : !> \param umo_set ...
1006 : !> \param qs_env ...
1007 : !> \date 15.05.2001
1008 : !> \par History:
1009 : !> - Optionally print Cartesian MOs (20.04.2005, MK)
1010 : !> - Revise printout of MO information (05.05.2021, MK)
1011 : !> \par Variables
1012 : !> - after : Number of digits after point.
1013 : !> - before: Number of digits before point.
1014 : !> \author Matthias Krack (MK)
1015 : !> \version 1.1
1016 : ! **************************************************************************************************
1017 6419 : SUBROUTINE write_mo_set_to_output_unit(mo_set, qs_kind_set, particle_set, &
1018 : dft_section, before, kpoint, final_mos, spin, &
1019 : solver_method, rtp, cpart, sim_step, umo_set, qs_env)
1020 :
1021 : TYPE(mo_set_type), INTENT(IN) :: mo_set
1022 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1023 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1024 : TYPE(section_vals_type), POINTER :: dft_section
1025 : INTEGER, INTENT(IN) :: before, kpoint
1026 : LOGICAL, INTENT(IN), OPTIONAL :: final_mos
1027 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: spin
1028 : CHARACTER(LEN=2), INTENT(IN), OPTIONAL :: solver_method
1029 : LOGICAL, INTENT(IN), OPTIONAL :: rtp
1030 : INTEGER, INTENT(IN), OPTIONAL :: cpart, sim_step
1031 : TYPE(mo_set_type), INTENT(IN), OPTIONAL :: umo_set
1032 : TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
1033 :
1034 : CHARACTER(LEN=12) :: symbol
1035 6419 : CHARACTER(LEN=12), DIMENSION(:), POINTER :: bcgf_symbol
1036 : CHARACTER(LEN=14) :: fmtstr5
1037 : CHARACTER(LEN=15) :: energy_str, orbital_str, step_string
1038 : CHARACTER(LEN=2) :: element_symbol, my_solver_method
1039 : CHARACTER(LEN=2*default_string_length) :: name
1040 : CHARACTER(LEN=21) :: vector_str
1041 : CHARACTER(LEN=22) :: fmtstr4
1042 : CHARACTER(LEN=24) :: fmtstr2
1043 : CHARACTER(LEN=25) :: fmtstr1
1044 : CHARACTER(LEN=29) :: fmtstr6
1045 : CHARACTER(LEN=4) :: reim
1046 : CHARACTER(LEN=40) :: fmtstr3
1047 6419 : CHARACTER(LEN=6), DIMENSION(:), POINTER :: bsgf_symbol
1048 : INTEGER :: after, first_mo, from, homo, iatom, icgf, ico, icol, ikind, imo, irow, iset, &
1049 : isgf, ishell, iso, iw, jcol, last_mo, left, lmax, lshell, nao, natom, ncgf, ncol, nkind, &
1050 : nmo, nset, nsgf, numo, right, scf_step, to, width
1051 6419 : INTEGER, DIMENSION(:), POINTER :: mo_index_range, nshell
1052 6419 : INTEGER, DIMENSION(:, :), POINTER :: l
1053 : LOGICAL :: ionode, my_final, my_rtp, omit_headers, print_cartesian, print_cartesian_overlap, &
1054 : print_eigvals, print_eigvecs, print_occup, should_output
1055 : REAL(KIND=dp) :: gap, maxocc
1056 6419 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: mo_eigenvalues, mo_occupation_numbers
1057 6419 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: cmatrix, smatrix
1058 6419 : REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvalues, occupation_numbers
1059 : TYPE(cp_fm_type), POINTER :: mo_coeff, umo_coeff
1060 : TYPE(cp_logger_type), POINTER :: logger
1061 6419 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: sro
1062 6419 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: orb_basis_set_list
1063 : TYPE(gto_basis_set_type), POINTER :: orb_basis_set, orbbasis
1064 : TYPE(mp_para_env_type), POINTER :: para_env
1065 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1066 6419 : POINTER :: sro_list
1067 : TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
1068 : TYPE(qs_kind_type), POINTER :: qs_kind
1069 : TYPE(qs_ks_env_type), POINTER :: ks_env
1070 :
1071 6419 : NULLIFY (bcgf_symbol)
1072 6419 : NULLIFY (bsgf_symbol)
1073 6419 : NULLIFY (logger)
1074 6419 : NULLIFY (mo_index_range)
1075 6419 : NULLIFY (nshell)
1076 6419 : NULLIFY (mo_coeff)
1077 :
1078 12838 : logger => cp_get_default_logger()
1079 6419 : ionode = logger%para_env%is_source()
1080 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%EIGENVALUES", l_val=print_eigvals)
1081 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%EIGENVECTORS", l_val=print_eigvecs)
1082 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%OCCUPATION_NUMBERS", l_val=print_occup)
1083 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%CARTESIAN", l_val=print_cartesian)
1084 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%MO_INDEX_RANGE", i_vals=mo_index_range)
1085 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%NDIGITS", i_val=after)
1086 6419 : CALL section_vals_val_get(dft_section, "PRINT%MO%CARTESIAN_OVERLAP", l_val=print_cartesian_overlap)
1087 6419 : after = MIN(MAX(after, 1), 16)
1088 :
1089 : ! Do we print the final MO information after SCF convergence is reached (default: no)
1090 6419 : IF (PRESENT(final_mos)) THEN
1091 6411 : my_final = final_mos
1092 : ELSE
1093 : my_final = .FALSE.
1094 : END IF
1095 :
1096 : ! complex MOS for RTP, no eigenvalues
1097 6419 : my_rtp = .FALSE.
1098 6419 : IF (PRESENT(rtp)) THEN
1099 8 : my_rtp = rtp
1100 : ! print the first time step if MO print required
1101 : should_output = BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
1102 : "PRINT%MO"), cp_p_file) &
1103 8 : .OR. (sim_step == 1)
1104 : ELSE
1105 : should_output = BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
1106 7338 : "PRINT%MO"), cp_p_file) .OR. my_final
1107 : END IF
1108 :
1109 6419 : IF ((.NOT. should_output) .OR. (.NOT. (print_eigvals .OR. print_eigvecs .OR. print_occup))) RETURN
1110 :
1111 5488 : IF (my_rtp) THEN
1112 8 : CPASSERT(PRESENT(sim_step))
1113 8 : CPASSERT(PRESENT(cpart))
1114 8 : scf_step = sim_step
1115 8 : IF (cpart == 0) THEN
1116 4 : reim = "IMAG"
1117 : ELSE
1118 4 : reim = "REAL"
1119 : END IF
1120 8 : print_eigvals = .FALSE.
1121 : ELSE
1122 5480 : scf_step = MAX(0, logger%iter_info%iteration(logger%iter_info%n_rlevel) - 1)
1123 : END IF
1124 :
1125 5488 : IF (.NOT. my_final) THEN
1126 4222 : IF (.NOT. my_rtp) THEN
1127 4214 : step_string = " AFTER SCF STEP"
1128 : ELSE
1129 8 : step_string = " AFTER RTP STEP"
1130 : END IF
1131 : END IF
1132 :
1133 5488 : IF (PRESENT(solver_method)) THEN
1134 5334 : my_solver_method = solver_method
1135 : ELSE
1136 : ! Traditional diagonalization is assumed as default solver method
1137 154 : my_solver_method = "TD"
1138 : END IF
1139 :
1140 : ! Retrieve MO information
1141 : CALL get_mo_set(mo_set=mo_set, &
1142 : mo_coeff=mo_coeff, &
1143 : eigenvalues=eigenvalues, &
1144 : occupation_numbers=occupation_numbers, &
1145 : homo=homo, &
1146 : maxocc=maxocc, &
1147 : nao=nao, &
1148 5488 : nmo=nmo)
1149 5488 : IF (PRESENT(umo_set)) THEN
1150 : CALL get_mo_set(mo_set=umo_set, &
1151 : mo_coeff=umo_coeff, &
1152 20 : nmo=numo)
1153 20 : nmo = nmo + numo
1154 : ELSE
1155 5468 : numo = 0
1156 : END IF
1157 16414 : ALLOCATE (mo_eigenvalues(nmo))
1158 5488 : mo_eigenvalues(:) = 0.0_dp
1159 48558 : mo_eigenvalues(1:nmo - numo) = eigenvalues(1:nmo - numo)
1160 16414 : ALLOCATE (mo_occupation_numbers(nmo))
1161 5488 : mo_occupation_numbers(:) = 0.0_dp
1162 48558 : mo_occupation_numbers(1:nmo - numo) = occupation_numbers(1:nmo - numo)
1163 5488 : IF (numo > 0) THEN
1164 : CALL get_mo_set(mo_set=umo_set, &
1165 20 : eigenvalues=eigenvalues)
1166 130 : mo_eigenvalues(nmo - numo + 1:nmo) = eigenvalues(1:numo)
1167 : END IF
1168 :
1169 5488 : IF (print_eigvecs) THEN
1170 13974 : ALLOCATE (smatrix(nao, nmo))
1171 3506 : CALL cp_fm_get_submatrix(mo_coeff, smatrix(1:nao, 1:nmo - numo))
1172 3506 : IF (numo > 0) THEN
1173 14 : CALL cp_fm_get_submatrix(umo_coeff, smatrix(1:nao, nmo - numo + 1:nmo))
1174 : END IF
1175 3506 : IF (.NOT. ionode) THEN
1176 1753 : DEALLOCATE (smatrix)
1177 : END IF
1178 : END IF
1179 :
1180 5488 : IF (PRESENT(qs_env)) THEN
1181 5334 : IF (ASSOCIATED(qs_env) .AND. my_final .AND. print_cartesian_overlap) THEN
1182 2 : NULLIFY (qs_kind_set)
1183 2 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
1184 2 : nkind = SIZE(qs_kind_set)
1185 :
1186 2 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
1187 : qs_env%input, "DFT%PRINT%AO_MATRICES/OVERLAP"), cp_p_file)) THEN
1188 8 : ALLOCATE (orb_basis_set_list(nkind))
1189 4 : DO ikind = 1, nkind
1190 2 : qs_kind => qs_kind_set(ikind)
1191 2 : NULLIFY (orb_basis_set_list(ikind)%gto_basis_set)
1192 2 : NULLIFY (orbbasis)
1193 2 : CALL get_qs_kind(qs_kind=qs_kind, basis_set=orbbasis, basis_type="ORB")
1194 4 : IF (ASSOCIATED(orbbasis)) orb_basis_set_list(ikind)%gto_basis_set => orbbasis
1195 : END DO
1196 2 : NULLIFY (sro_list)
1197 2 : CALL setup_neighbor_list(sro_list, orb_basis_set_list, qs_env=qs_env)
1198 2 : NULLIFY (sro)
1199 2 : NULLIFY (para_env)
1200 2 : CALL get_qs_env(qs_env, ks_env=ks_env, para_env=para_env)
1201 : CALL build_overlap_matrix_simple(ks_env, sro, &
1202 2 : orb_basis_set_list, orb_basis_set_list, sro_list, .TRUE.)
1203 2 : CALL release_neighbor_list_sets(sro_list)
1204 :
1205 : iw = cp_print_key_unit_nr(logger, qs_env%input, "DFT%PRINT%AO_MATRICES/OVERLAP", &
1206 2 : extension=".Log")
1207 2 : CALL section_vals_val_get(qs_env%input, "DFT%PRINT%AO_MATRICES%OMIT_HEADERS", l_val=omit_headers)
1208 2 : CALL section_vals_val_get(qs_env%input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
1209 2 : after = MIN(MAX(after, 1), 16)
1210 2 : IF (ASSOCIATED(sro)) THEN
1211 : CALL cp_dbcsr_write_sparse_matrix(sro(1)%matrix, 4, after, qs_env, para_env, &
1212 : output_unit=iw, omit_headers=omit_headers, &
1213 2 : cartesian_basis=.TRUE.)
1214 : END IF
1215 : CALL cp_print_key_finished_output(iw, logger, qs_env%input, &
1216 2 : "DFT%PRINT%AO_MATRICES/OVERLAP")
1217 2 : IF (ASSOCIATED(sro)) CALL dbcsr_deallocate_matrix_set(sro)
1218 4 : DEALLOCATE (orb_basis_set_list)
1219 : END IF
1220 : END IF
1221 : END IF
1222 :
1223 : iw = cp_print_key_unit_nr(logger, dft_section, "PRINT%MO", &
1224 : ignore_should_output=should_output, &
1225 5488 : extension=".MOLog")
1226 :
1227 5488 : IF (iw > 0) THEN
1228 :
1229 2744 : natom = SIZE(particle_set)
1230 2744 : CALL get_qs_kind_set(qs_kind_set, ncgf=ncgf, nsgf=nsgf)
1231 :
1232 : ! Definition of the variable formats
1233 :
1234 2744 : fmtstr1 = "(T2,A,21X, ( X,I5, X))"
1235 2744 : fmtstr2 = "(T2,A,21X, (1X,F . ))"
1236 2744 : fmtstr3 = "(T2,A,I5,1X,I5,1X,A,1X,A6, (1X,F . ))"
1237 :
1238 2744 : width = before + after + 3
1239 2744 : ncol = INT(56/width)
1240 :
1241 2744 : right = MAX((after - 2), 1)
1242 2744 : left = width - right - 5
1243 :
1244 2744 : WRITE (UNIT=fmtstr1(11:12), FMT="(I2)") ncol
1245 2744 : WRITE (UNIT=fmtstr1(14:15), FMT="(I2)") left
1246 2744 : WRITE (UNIT=fmtstr1(21:22), FMT="(I2)") right
1247 :
1248 2744 : WRITE (UNIT=fmtstr2(11:12), FMT="(I2)") ncol
1249 2744 : WRITE (UNIT=fmtstr2(18:19), FMT="(I2)") width - 1
1250 2744 : WRITE (UNIT=fmtstr2(21:22), FMT="(I2)") after
1251 :
1252 2744 : WRITE (UNIT=fmtstr3(27:28), FMT="(I2)") ncol
1253 2744 : WRITE (UNIT=fmtstr3(34:35), FMT="(I2)") width - 1
1254 2744 : WRITE (UNIT=fmtstr3(37:38), FMT="(I2)") after
1255 :
1256 2744 : IF (my_final .OR. (my_solver_method == "TD")) THEN
1257 2744 : energy_str = "EIGENVALUES"
1258 2744 : vector_str = "EIGENVECTORS"
1259 : ELSE
1260 0 : energy_str = "ENERGIES"
1261 0 : vector_str = "COEFFICIENTS"
1262 : END IF
1263 :
1264 2744 : IF (my_rtp) THEN
1265 4 : energy_str = "ZEROS"
1266 4 : vector_str = TRIM(reim)//" RTP COEFFICIENTS"
1267 : END IF
1268 :
1269 2744 : IF (print_eigvecs) THEN
1270 :
1271 1753 : IF (print_cartesian) THEN
1272 :
1273 97 : orbital_str = "CARTESIAN"
1274 :
1275 388 : ALLOCATE (cmatrix(ncgf, ncgf))
1276 97 : cmatrix = 0.0_dp
1277 :
1278 : ! Transform spherical MOs to Cartesian MOs
1279 97 : icgf = 1
1280 97 : isgf = 1
1281 307 : DO iatom = 1, natom
1282 210 : NULLIFY (orb_basis_set, dftb_parameter)
1283 210 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
1284 : CALL get_qs_kind(qs_kind_set(ikind), &
1285 : basis_set=orb_basis_set, &
1286 210 : dftb_parameter=dftb_parameter)
1287 517 : IF (ASSOCIATED(orb_basis_set)) THEN
1288 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1289 : nset=nset, &
1290 : nshell=nshell, &
1291 174 : l=l)
1292 538 : DO iset = 1, nset
1293 1064 : DO ishell = 1, nshell(iset)
1294 526 : lshell = l(ishell, iset)
1295 : CALL dgemm("T", "N", nco(lshell), nmo, nso(lshell), 1.0_dp, &
1296 : orbtramat(lshell)%c2s, nso(lshell), &
1297 : smatrix(isgf, 1), nsgf, 0.0_dp, &
1298 526 : cmatrix(icgf, 1), ncgf)
1299 526 : icgf = icgf + nco(lshell)
1300 890 : isgf = isgf + nso(lshell)
1301 : END DO
1302 : END DO
1303 36 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
1304 36 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
1305 90 : DO ishell = 1, lmax + 1
1306 54 : lshell = ishell - 1
1307 : CALL dgemm("T", "N", nco(lshell), nsgf, nso(lshell), 1.0_dp, &
1308 : orbtramat(lshell)%c2s, nso(lshell), &
1309 : smatrix(isgf, 1), nsgf, 0.0_dp, &
1310 54 : cmatrix(icgf, 1), ncgf)
1311 54 : icgf = icgf + nco(lshell)
1312 90 : isgf = isgf + nso(lshell)
1313 : END DO
1314 : ELSE
1315 : ! assume atom without basis set
1316 : ! CPABORT("Unknown basis set type")
1317 : END IF
1318 : END DO ! iatom
1319 :
1320 : ELSE
1321 :
1322 1656 : orbital_str = "SPHERICAL"
1323 :
1324 : END IF ! print_cartesian
1325 :
1326 : name = TRIM(energy_str)//", OCCUPATION NUMBERS, AND "// &
1327 1753 : TRIM(orbital_str)//" "//TRIM(vector_str)
1328 :
1329 1753 : IF (.NOT. my_final) &
1330 1408 : WRITE (UNIT=name, FMT="(A,1X,I0)") TRIM(name)//step_string, scf_step
1331 :
1332 991 : ELSE IF (print_occup .OR. print_eigvals) THEN
1333 991 : name = TRIM(energy_str)//" AND OCCUPATION NUMBERS"
1334 :
1335 991 : IF (.NOT. my_final) &
1336 703 : WRITE (UNIT=name, FMT="(A,1X,I0)") TRIM(name)//step_string, scf_step
1337 : END IF ! print_eigvecs
1338 :
1339 : ! Print headline
1340 2744 : IF (PRESENT(spin) .AND. (kpoint > 0)) THEN
1341 : WRITE (UNIT=iw, FMT="(/,T2,A,I0)") &
1342 0 : "MO| "//TRIM(spin)//" "//TRIM(name)//" FOR K POINT ", kpoint
1343 : ELSE IF (PRESENT(spin)) THEN
1344 : WRITE (UNIT=iw, FMT="(/,T2,A)") &
1345 312 : "MO| "//TRIM(spin)//" "//TRIM(name)
1346 2432 : ELSE IF (kpoint > 0) THEN
1347 : WRITE (UNIT=iw, FMT="(/,T2,A,I0)") &
1348 293 : "MO| "//TRIM(name)//" FOR K POINT ", kpoint
1349 : ELSE
1350 : WRITE (UNIT=iw, FMT="(/,T2,A)") &
1351 2139 : "MO| "//TRIM(name)
1352 : END IF
1353 :
1354 : ! Check if only a subset of the MOs has to be printed
1355 3028 : IF (ALL(mo_index_range > 0)) THEN
1356 142 : IF (mo_index_range(2) > nmo) THEN
1357 : CALL cp_warn(__LOCATION__, &
1358 7 : "The last orbital index is larger than the number of orbitals.")
1359 : END IF
1360 142 : IF (mo_index_range(1) > mo_index_range(2)) THEN
1361 : CALL cp_warn(__LOCATION__, &
1362 0 : "The first orbital index is larger than the last orbital index.")
1363 : END IF
1364 142 : first_mo = MIN(MAX(1, mo_index_range(1)), nmo)
1365 142 : last_mo = MIN(MAX(first_mo, mo_index_range(2)), nmo)
1366 2602 : ELSE IF (mo_index_range(2) < 0) THEN
1367 0 : IF (mo_index_range(1) > nmo) THEN
1368 : CALL cp_warn(__LOCATION__, &
1369 0 : "The first orbital index is larger than the number of orbitals.")
1370 : END IF
1371 0 : first_mo = MIN(MAX(1, mo_index_range(1)), nmo)
1372 0 : last_mo = nmo
1373 : ELSE
1374 2602 : first_mo = 1
1375 2602 : last_mo = nmo
1376 : END IF
1377 :
1378 2744 : IF (print_eigvecs) THEN
1379 :
1380 : ! Print full MO information
1381 :
1382 3952 : DO icol = first_mo, last_mo, ncol
1383 :
1384 2199 : from = icol
1385 2199 : to = MIN((from + ncol - 1), last_mo)
1386 :
1387 2199 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1388 : WRITE (UNIT=iw, FMT=fmtstr1) &
1389 10206 : "MO|", (jcol, jcol=from, to)
1390 : WRITE (UNIT=iw, FMT=fmtstr2) &
1391 2199 : "MO|", (mo_eigenvalues(jcol), jcol=from, to)
1392 2199 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1393 : WRITE (UNIT=iw, FMT=fmtstr2) &
1394 2199 : "MO|", (mo_occupation_numbers(jcol), jcol=from, to)
1395 2199 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1396 :
1397 2199 : irow = 1
1398 :
1399 8687 : DO iatom = 1, natom
1400 :
1401 4735 : IF (iatom /= 1) WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1402 :
1403 4735 : NULLIFY (orb_basis_set, dftb_parameter)
1404 : CALL get_atomic_kind(particle_set(iatom)%atomic_kind, &
1405 4735 : element_symbol=element_symbol, kind_number=ikind)
1406 : CALL get_qs_kind(qs_kind_set(ikind), &
1407 : basis_set=orb_basis_set, &
1408 4735 : dftb_parameter=dftb_parameter)
1409 :
1410 11669 : IF (print_cartesian) THEN
1411 :
1412 876 : IF (ASSOCIATED(orb_basis_set)) THEN
1413 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1414 : nset=nset, &
1415 : nshell=nshell, &
1416 : l=l, &
1417 768 : cgf_symbol=bcgf_symbol)
1418 :
1419 768 : icgf = 1
1420 2592 : DO iset = 1, nset
1421 5064 : DO ishell = 1, nshell(iset)
1422 2472 : lshell = l(ishell, iset)
1423 10968 : DO ico = 1, nco(lshell)
1424 : WRITE (UNIT=iw, FMT=fmtstr3) &
1425 6672 : "MO|", irow, iatom, ADJUSTR(element_symbol), bcgf_symbol(icgf), &
1426 13344 : (cmatrix(irow, jcol), jcol=from, to)
1427 6672 : icgf = icgf + 1
1428 9144 : irow = irow + 1
1429 : END DO
1430 : END DO
1431 : END DO
1432 108 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
1433 108 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
1434 108 : icgf = 1
1435 270 : DO ishell = 1, lmax + 1
1436 162 : lshell = ishell - 1
1437 540 : DO ico = 1, nco(lshell)
1438 270 : symbol = cgf_symbol(1, indco(1:3, icgf))
1439 270 : symbol(1:2) = " "
1440 : WRITE (UNIT=iw, FMT=fmtstr3) &
1441 270 : "MO|", irow, iatom, ADJUSTR(element_symbol), symbol, &
1442 540 : (cmatrix(irow, jcol), jcol=from, to)
1443 270 : icgf = icgf + 1
1444 432 : irow = irow + 1
1445 : END DO
1446 : END DO
1447 : ELSE
1448 : ! assume atom without basis set
1449 : ! CPABORT("Unknown basis set type")
1450 : END IF
1451 :
1452 : ELSE
1453 :
1454 3859 : IF (ASSOCIATED(orb_basis_set)) THEN
1455 : CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1456 : nset=nset, &
1457 : nshell=nshell, &
1458 : l=l, &
1459 3859 : sgf_symbol=bsgf_symbol)
1460 3859 : isgf = 1
1461 11027 : DO iset = 1, nset
1462 20499 : DO ishell = 1, nshell(iset)
1463 9472 : lshell = l(ishell, iset)
1464 39040 : DO iso = 1, nso(lshell)
1465 : WRITE (UNIT=iw, FMT=fmtstr3) &
1466 22400 : "MO|", irow, iatom, ADJUSTR(element_symbol), bsgf_symbol(isgf), &
1467 44800 : (smatrix(irow, jcol), jcol=from, to)
1468 22400 : isgf = isgf + 1
1469 31872 : irow = irow + 1
1470 : END DO
1471 : END DO
1472 : END DO
1473 0 : ELSE IF (ASSOCIATED(dftb_parameter)) THEN
1474 0 : CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
1475 0 : isgf = 1
1476 0 : DO ishell = 1, lmax + 1
1477 0 : lshell = ishell - 1
1478 0 : DO iso = 1, nso(lshell)
1479 0 : symbol = sgf_symbol(1, lshell, -lshell + iso - 1)
1480 0 : symbol(1:2) = " "
1481 : WRITE (UNIT=iw, FMT=fmtstr3) &
1482 0 : "MO|", irow, iatom, ADJUSTR(element_symbol), symbol, &
1483 0 : (smatrix(irow, jcol), jcol=from, to)
1484 0 : isgf = isgf + 1
1485 0 : irow = irow + 1
1486 : END DO
1487 : END DO
1488 : ELSE
1489 : ! assume atom without basis set
1490 : ! CPABORT("Unknown basis set type")
1491 : END IF
1492 :
1493 : END IF ! print_cartesian
1494 :
1495 : END DO ! iatom
1496 :
1497 : END DO ! icol
1498 :
1499 1753 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1500 :
1501 : ! Release work storage
1502 :
1503 1753 : IF (print_cartesian) THEN
1504 97 : DEALLOCATE (cmatrix)
1505 : END IF
1506 1753 : DEALLOCATE (smatrix)
1507 :
1508 991 : ELSE IF (print_occup .OR. print_eigvals) THEN
1509 :
1510 991 : WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
1511 991 : fmtstr4 = "(T2,A,I7,3(1X,F22. ))"
1512 991 : WRITE (UNIT=fmtstr4(19:20), FMT="(I2)") after
1513 991 : IF (my_final .OR. (my_solver_method == "TD")) THEN
1514 : WRITE (UNIT=iw, FMT="(A)") &
1515 991 : " MO| Index Eigenvalue [a.u.] Eigenvalue [eV] Occupation"
1516 : ELSE
1517 : WRITE (UNIT=iw, FMT="(A)") &
1518 0 : " MO| Index Energy [a.u.] Energy [eV] Occupation"
1519 : END IF
1520 14530 : DO imo = first_mo, last_mo
1521 : WRITE (UNIT=iw, FMT=fmtstr4) &
1522 13539 : "MO|", imo, mo_eigenvalues(imo), &
1523 13539 : mo_eigenvalues(imo)*evolt, &
1524 28069 : mo_occupation_numbers(imo)
1525 : END DO
1526 991 : fmtstr5 = "(A,T59,F22. )"
1527 991 : WRITE (UNIT=fmtstr5(12:13), FMT="(I2)") after
1528 : WRITE (UNIT=iw, FMT=fmtstr5) &
1529 991 : " MO| Sum:", accurate_sum(mo_occupation_numbers(:))
1530 :
1531 : END IF ! print_eigvecs
1532 :
1533 2744 : IF (.NOT. my_rtp) THEN
1534 2740 : fmtstr6 = "(A,T18,F17. ,A,T41,F17. ,A)"
1535 2740 : WRITE (UNIT=fmtstr6(12:13), FMT="(I2)") after
1536 2740 : WRITE (UNIT=fmtstr6(25:26), FMT="(I2)") after
1537 : WRITE (UNIT=iw, FMT=fmtstr6) &
1538 2740 : " MO| E(Fermi):", mo_set%mu, " a.u.", mo_set%mu*evolt, " eV"
1539 : END IF
1540 2744 : IF ((homo > 0) .AND. .NOT. my_rtp) THEN
1541 2715 : IF ((mo_occupation_numbers(homo) == maxocc) .AND. (last_mo > homo)) THEN
1542 : gap = mo_eigenvalues(homo + 1) - &
1543 409 : mo_eigenvalues(homo)
1544 : WRITE (UNIT=iw, FMT=fmtstr6) &
1545 409 : " MO| Band gap:", gap, " a.u.", gap*evolt, " eV"
1546 : END IF
1547 : END IF
1548 2744 : WRITE (UNIT=iw, FMT="(A)") ""
1549 :
1550 : END IF ! iw
1551 :
1552 5488 : IF (ALLOCATED(mo_eigenvalues)) DEALLOCATE (mo_eigenvalues)
1553 5488 : IF (ALLOCATED(mo_occupation_numbers)) DEALLOCATE (mo_occupation_numbers)
1554 :
1555 : CALL cp_print_key_finished_output(iw, logger, dft_section, "PRINT%MO", &
1556 5488 : ignore_should_output=should_output)
1557 :
1558 24745 : END SUBROUTINE write_mo_set_to_output_unit
1559 :
1560 : END MODULE qs_mo_io
|
