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