Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Routines that print various information about an atomic kind.
10 : ! **************************************************************************************************
11 : MODULE atom_output
12 : USE atom_types, ONLY: &
13 : atom_basis_type, atom_gthpot_type, atom_potential_type, atom_state, atom_type, cgto_basis, &
14 : ecp_pseudo, gth_pseudo, gto_basis, lmat, no_pseudo, num_basis, sgp_pseudo, sto_basis, &
15 : upf_pseudo
16 : USE atom_utils, ONLY: get_maxl_occ,&
17 : get_maxn_occ,&
18 : get_rho0
19 : USE cp_files, ONLY: close_file,&
20 : open_file
21 : USE input_constants, ONLY: &
22 : barrier_conf, do_dkh0_atom, do_dkh1_atom, do_dkh2_atom, do_dkh3_atom, do_nonrel_atom, &
23 : do_rhf_atom, do_rks_atom, do_rohf_atom, do_sczoramp_atom, do_uhf_atom, do_uks_atom, &
24 : do_zoramp_atom, poly_conf, xc_none
25 : USE input_cp2k_check, ONLY: xc_functionals_expand
26 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
27 : section_vals_get_subs_vals2,&
28 : section_vals_type,&
29 : section_vals_val_get
30 : USE kinds, ONLY: default_string_length,&
31 : dp
32 : USE mathconstants, ONLY: dfac,&
33 : pi,&
34 : rootpi
35 : USE periodic_table, ONLY: ptable
36 : USE physcon, ONLY: evolt
37 : USE xc_derivatives, ONLY: xc_functional_get_info
38 : USE xc_libxc, ONLY: libxc_check_existence_in_libxc,&
39 : libxc_get_reference_length
40 : #include "./base/base_uses.f90"
41 :
42 : IMPLICIT NONE
43 :
44 : PRIVATE
45 :
46 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'atom_output'
47 :
48 : PUBLIC :: atom_print_state, atom_print_energies, atom_print_iteration, &
49 : atom_print_basis, atom_print_method, atom_print_info, atom_print_potential, &
50 : atom_print_basis_file, atom_write_pseudo_param, atom_print_orbitals, &
51 : atom_print_zmp_iteration
52 :
53 : CONTAINS
54 :
55 : ! **************************************************************************************************
56 : !> \brief Print an information string related to the atomic kind.
57 : !> \param zval atomic number
58 : !> \param info information string
59 : !> \param iw output file unit
60 : !> \par History
61 : !> * 09.2008 created [Juerg Hutter]
62 : ! **************************************************************************************************
63 180 : SUBROUTINE atom_print_info(zval, info, iw)
64 : INTEGER, INTENT(IN) :: zval
65 : CHARACTER(len=*), INTENT(IN) :: info
66 : INTEGER, INTENT(IN) :: iw
67 :
68 : WRITE (iw, '(/," ",A,T40,A," [",A,"]",T62,"Atomic number:",T78,I3,/)') &
69 180 : ADJUSTL(TRIM(info)), TRIM(ptable(zval)%name), TRIM(ptable(zval)%symbol), zval
70 :
71 180 : END SUBROUTINE atom_print_info
72 :
73 : ! **************************************************************************************************
74 : !> \brief Print information about electronic state.
75 : !> \param state electronic state
76 : !> \param iw output file unit
77 : !> \par History
78 : !> * 02.2010 unrestricted KS and HF methods [Juerg Hutter]
79 : !> * 11.2009 print multiplicity [Juerg Hutter]
80 : !> * 08.2008 created [Juerg Hutter]
81 : ! **************************************************************************************************
82 2176 : SUBROUTINE atom_print_state(state, iw)
83 : TYPE(atom_state) :: state
84 : INTEGER, INTENT(IN) :: iw
85 :
86 : CHARACTER(LEN=1), DIMENSION(0:7), PARAMETER :: &
87 : label = (/"S", "P", "D", "F", "G", "H", "I", "K"/)
88 :
89 : INTEGER :: j, l, mc, mlc, mlo, mm(0:lmat), mo
90 :
91 : CPASSERT(lmat <= 7)
92 2176 : WRITE (iw, '(/,T2,A)') "Electronic structure"
93 154496 : WRITE (iw, '(T5,A,T71,F10.2)') "Total number of core electrons", SUM(state%core)
94 154496 : WRITE (iw, '(T5,A,T71,F10.2)') "Total number of valence electrons", SUM(state%occ)
95 154496 : WRITE (iw, '(T5,A,T71,F10.2)') "Total number of electrons", SUM(state%occ + state%core)
96 4307 : SELECT CASE (state%multiplicity)
97 : CASE (-1)
98 2131 : WRITE (iw, '(T5,A,T68,A)') "Multiplicity", "not specified"
99 : CASE (-2)
100 10 : WRITE (iw, '(T5,A,T72,A)') "Multiplicity", "high spin"
101 : CASE (-3)
102 0 : WRITE (iw, '(T5,A,T73,A)') "Multiplicity", "low spin"
103 : CASE (1)
104 22 : WRITE (iw, '(T5,A,T74,A)') "Multiplicity", "singlet"
105 : CASE (2)
106 10 : WRITE (iw, '(T5,A,T74,A)') "Multiplicity", "doublet"
107 : CASE (3)
108 3 : WRITE (iw, '(T5,A,T74,A)') "Multiplicity", "triplet"
109 : CASE (4)
110 0 : WRITE (iw, '(T5,A,T74,A)') "Multiplicity", "quartet"
111 : CASE (5)
112 0 : WRITE (iw, '(T5,A,T74,A)') "Multiplicity", "quintet"
113 : CASE (6)
114 0 : WRITE (iw, '(T5,A,T75,A)') "Multiplicity", "sextet"
115 : CASE (7)
116 2176 : WRITE (iw, '(T5,A,T75,A)') "Multiplicity", "septet"
117 : CASE DEFAULT
118 : END SELECT
119 :
120 2176 : mlo = get_maxl_occ(state%occ)
121 2176 : mlc = get_maxl_occ(state%core)
122 2176 : mm = get_maxn_occ(state%core)
123 :
124 2176 : IF (state%multiplicity == -1) THEN
125 5524 : DO l = 0, MAX(mlo, mlc)
126 3393 : mo = state%maxn_occ(l)
127 39454 : IF (SUM(state%core(l, :)) == 0) THEN
128 5605 : WRITE (iw, '(A5,T10,10F6.2)') label(l), (state%occ(l, j), j=1, mo)
129 : ELSE
130 1053 : mc = mm(l)
131 2382 : CPASSERT(SUM(state%occ(l, 1:mc)) == 0)
132 2382 : WRITE (iw, ADVANCE="no", FMT='(A5,T9,A1,10F6.2)') label(l), "[", (state%core(l, j), j=1, mc)
133 2080 : WRITE (iw, FMT='(A1,F5.2,10F6.2)') "]", (state%occ(l, j), j=mc + 1, mc + mo)
134 : END IF
135 : END DO
136 : ELSE
137 45 : WRITE (iw, '(T5,A)') "Alpha Electrons"
138 122 : DO l = 0, MAX(mlo, mlc)
139 77 : mo = state%maxn_occ(l)
140 892 : IF (SUM(state%core(l, :)) == 0) THEN
141 104 : WRITE (iw, '(A5,T10,10F6.2)') label(l), (state%occa(l, j), j=1, mo)
142 : ELSE
143 35 : mc = mm(l)
144 86 : WRITE (iw, ADVANCE="no", FMT='(A5,T9,A1,10F6.2)') label(l), "[", (0.5_dp*state%core(l, j), j=1, mc)
145 60 : WRITE (iw, FMT='(A1,F5.2,10F6.2)') "]", (state%occa(l, j), j=1, mo)
146 : END IF
147 : END DO
148 45 : WRITE (iw, '(T5,A)') "Beta Electrons"
149 122 : DO l = 0, MAX(mlo, mlc)
150 77 : mo = state%maxn_occ(l)
151 892 : IF (SUM(state%core(l, :)) == 0) THEN
152 104 : WRITE (iw, '(A5,T10,10F6.2)') label(l), (state%occb(l, j), j=1, mo)
153 : ELSE
154 35 : mc = mm(l)
155 86 : WRITE (iw, ADVANCE="no", FMT='(A5,T9,A1,10F6.2)') label(l), "[", (0.5_dp*state%core(l, j), j=1, mc)
156 60 : WRITE (iw, FMT='(A1,F5.2,10F6.2)') "]", (state%occb(l, j), j=1, mo)
157 : END IF
158 : END DO
159 : END IF
160 2176 : WRITE (iw, *)
161 :
162 2176 : END SUBROUTINE atom_print_state
163 :
164 : ! **************************************************************************************************
165 : !> \brief Print energy components.
166 : !> \param atom information about the atomic kind
167 : !> \param iw output file unit
168 : !> \par History
169 : !> * 05.2010 print virial coefficient [Juerg Hutter]
170 : !> * 02.2010 unrestricted KS and HF methods [Juerg Hutter]
171 : !> * 09.2008 print orbital energies [Juerg Hutter]
172 : !> * 08.2008 created [Juerg Hutter]
173 : ! **************************************************************************************************
174 4352 : SUBROUTINE atom_print_energies(atom, iw)
175 : TYPE(atom_type) :: atom
176 : INTEGER, INTENT(IN) :: iw
177 :
178 : INTEGER :: i, l, n
179 : REAL(KIND=dp) :: drho
180 :
181 2176 : WRITE (iw, '(/,A,T36,A,T61,F20.12)') " Energy components [Hartree]", &
182 4352 : " Total Energy ::", atom%energy%etot
183 2176 : WRITE (iw, '(T36,A,T61,F20.12)') " Band Energy ::", atom%energy%eband
184 2176 : WRITE (iw, '(T36,A,T61,F20.12)') " Kinetic Energy ::", atom%energy%ekin
185 2176 : WRITE (iw, '(T36,A,T61,F20.12)') "Potential Energy ::", atom%energy%epot
186 2176 : IF (atom%energy%ekin /= 0.0_dp) THEN
187 2163 : WRITE (iw, '(T36,A,T61,F20.12)') " Virial (-V/T) ::", -atom%energy%epot/atom%energy%ekin
188 : END IF
189 2176 : WRITE (iw, '(T36,A,T61,F20.12)') " Core Energy ::", atom%energy%ecore
190 2176 : IF (atom%energy%exc /= 0._dp) &
191 2145 : WRITE (iw, '(T36,A,T61,F20.12)') " XC Energy ::", atom%energy%exc
192 2176 : WRITE (iw, '(T36,A,T61,F20.12)') " Coulomb Energy ::", atom%energy%ecoulomb
193 2176 : IF (atom%energy%eexchange /= 0._dp) &
194 46 : WRITE (iw, '(T34,A,T61,F20.12)') "HF Exchange Energy ::", atom%energy%eexchange
195 2176 : IF (atom%potential%ppot_type /= NO_PSEUDO) THEN
196 1784 : WRITE (iw, '(T20,A,T61,F20.12)') " Total Pseudopotential Energy ::", atom%energy%epseudo
197 1784 : WRITE (iw, '(T20,A,T61,F20.12)') " Local Pseudopotential Energy ::", atom%energy%eploc
198 1784 : IF (atom%energy%elsd /= 0._dp) &
199 0 : WRITE (iw, '(T20,A,T61,F20.12)') " Local Spin-potential Energy ::", atom%energy%elsd
200 1784 : WRITE (iw, '(T20,A,T61,F20.12)') " Nonlocal Pseudopotential Energy ::", atom%energy%epnl
201 : END IF
202 2176 : IF (atom%potential%confinement) THEN
203 1778 : WRITE (iw, '(T36,A,T61,F20.12)') " Confinement ::", atom%energy%econfinement
204 : END IF
205 :
206 2176 : IF (atom%state%multiplicity == -1) THEN
207 2131 : WRITE (iw, '(/,A,T20,A,T30,A,T36,A,T49,A,T71,A,/)') " Orbital energies", &
208 4262 : "State", "L", "Occupation", "Energy[a.u.]", "Energy[eV]"
209 5635 : DO l = 0, atom%state%maxl_calc
210 3504 : n = atom%state%maxn_calc(l)
211 7911 : DO i = 1, n
212 : WRITE (iw, '(T23,I2,T30,I1,T36,F10.3,T46,F15.6,T66,F15.6)') &
213 7911 : i, l, atom%state%occupation(l, i), atom%orbitals%ener(i, l), atom%orbitals%ener(i, l)*evolt
214 : END DO
215 5635 : IF (n > 0) WRITE (iw, *)
216 : END DO
217 : ELSE
218 45 : WRITE (iw, '(/,A,T20,A,T30,A,T36,A,T42,A,T55,A,T71,A,/)') " Orbital energies", &
219 90 : "State", "Spin", "L", "Occupation", "Energy[a.u.]", "Energy[eV]"
220 162 : DO l = 0, atom%state%maxl_calc
221 117 : n = atom%state%maxn_calc(l)
222 208 : DO i = 1, n
223 : WRITE (iw, '(T23,I2,T29,A,T36,I1,T42,F10.3,T52,F15.6,T68,F13.6)') &
224 208 : i, "alpha", l, atom%state%occa(l, i), atom%orbitals%enera(i, l), atom%orbitals%enera(i, l)*evolt
225 : END DO
226 208 : DO i = 1, n
227 : WRITE (iw, '(T23,I2,T29,A,T36,I1,T42,F10.3,T52,F15.6,T68,F13.6)') &
228 208 : i, " beta", l, atom%state%occb(l, i), atom%orbitals%enerb(i, l), atom%orbitals%enerb(i, l)*evolt
229 : END DO
230 162 : IF (n > 0) WRITE (iw, *)
231 : END DO
232 : END IF
233 :
234 2176 : CALL get_rho0(atom, drho)
235 2176 : WRITE (iw, '(/,A,T66,F15.6)') " Total Electron Density at R=0: ", drho
236 :
237 2176 : END SUBROUTINE atom_print_energies
238 :
239 : ! **************************************************************************************************
240 : !> \brief Printing of the atomic iterations when ZMP is active.
241 : !> \param iter current iteration number
242 : !> \param deps convergence
243 : !> \param atom intormation about the atomic kind
244 : !> \param iw output file unit
245 : !> \author D. Varsano [daniele.varsano@nano.cnr.it]
246 : ! **************************************************************************************************
247 0 : SUBROUTINE atom_print_zmp_iteration(iter, deps, atom, iw)
248 : INTEGER, INTENT(IN) :: iter
249 : REAL(dp), INTENT(IN) :: deps
250 : TYPE(atom_type), INTENT(IN) :: atom
251 : INTEGER, INTENT(IN) :: iw
252 :
253 0 : IF (iter == 1) THEN
254 : WRITE (iw, '(/," ",79("*"),/,T33,"Integral",T48,"Integral",/,T3,A,T16,A,T33,A,T46,A,T69,A/," ",79("*"))') &
255 0 : "Iteration", "Convergence", "rho diff.", "rho*v_xc[au]", "Energy[au]"
256 : END IF
257 0 : WRITE (iw, '(T3,I9,T15,G13.6,T30,G13.6,T46,G13.6,T61,F20.12)') iter, deps, atom%rho_diff_integral, &
258 0 : atom%energy%exc, atom%energy%etot
259 :
260 0 : END SUBROUTINE atom_print_zmp_iteration
261 :
262 : ! **************************************************************************************************
263 : !> \brief Print convergence information.
264 : !> \param iter current iteration number
265 : !> \param deps convergency
266 : !> \param etot total energy
267 : !> \param iw output file unit
268 : !> \par History
269 : !> * 08.2008 created [Juerg Hutter]
270 : ! **************************************************************************************************
271 9715 : SUBROUTINE atom_print_iteration(iter, deps, etot, iw)
272 : INTEGER, INTENT(IN) :: iter
273 : REAL(dp), INTENT(IN) :: deps, etot
274 : INTEGER, INTENT(IN) :: iw
275 :
276 9715 : IF (iter == 1) THEN
277 : WRITE (iw, '(/," ",79("*"),/,T19,A,T38,A,T70,A,/," ",79("*"))') &
278 2176 : "Iteration", "Convergence", "Energy [au]"
279 : END IF
280 9715 : WRITE (iw, '(T20,i8,T34,G14.6,T61,F20.12)') iter, deps, etot
281 :
282 9715 : END SUBROUTINE atom_print_iteration
283 :
284 : ! **************************************************************************************************
285 : !> \brief Print atomic basis set.
286 : !> \param atom_basis atomic basis set
287 : !> \param iw output file unit
288 : !> \param title header to print on top of the basis set
289 : !> \par History
290 : !> * 09.2008 created [Juerg Hutter]
291 : ! **************************************************************************************************
292 22 : SUBROUTINE atom_print_basis(atom_basis, iw, title)
293 : TYPE(atom_basis_type) :: atom_basis
294 : INTEGER, INTENT(IN) :: iw
295 : CHARACTER(len=*) :: title
296 :
297 : INTEGER :: i, j, l
298 :
299 22 : WRITE (iw, '(/,A)') TRIM(title)
300 39 : SELECT CASE (atom_basis%basis_type)
301 : CASE (GTO_BASIS)
302 17 : IF (atom_basis%geometrical) THEN
303 15 : WRITE (iw, '(/," ",21("*"),A,22("*"))') " Geometrical Gaussian Type Orbitals "
304 15 : WRITE (iw, '(A,F15.8,T41,A,F15.8)') " Initial exponent: ", atom_basis%aval, &
305 30 : " Proportionality factor: ", atom_basis%cval
306 : ELSE
307 2 : WRITE (iw, '(/," ",21("*"),A,21("*"))') " Uncontracted Gaussian Type Orbitals "
308 : END IF
309 119 : DO l = 0, lmat
310 119 : IF (atom_basis%nbas(l) > 0) THEN
311 14 : SELECT CASE (l)
312 : CASE DEFAULT
313 : WRITE (iw, '(/,T2,A,(T30,I5,T51,F30.8))') &
314 280 : "X Exponents: ", (i, atom_basis%am(i, l), i=1, atom_basis%nbas(l))
315 : CASE (0)
316 : WRITE (iw, '(/,T2,A,(T30,I5,T51,F30.8))') &
317 440 : "s Exponents: ", (i, atom_basis%am(i, 0), i=1, atom_basis%nbas(0))
318 : CASE (1)
319 : WRITE (iw, '(/,T2,A,(T30,I5,T51,F30.8))') &
320 408 : "p Exponents: ", (i, atom_basis%am(i, 1), i=1, atom_basis%nbas(1))
321 : CASE (2)
322 : WRITE (iw, '(/,T2,A,(T30,I5,T51,F30.8))') &
323 376 : "d Exponents: ", (i, atom_basis%am(i, 2), i=1, atom_basis%nbas(2))
324 : CASE (3)
325 : WRITE (iw, '(/,T2,A,(T30,I5,T51,F30.8))') &
326 395 : "f Exponents: ", (i, atom_basis%am(i, 3), i=1, atom_basis%nbas(3))
327 : END SELECT
328 : END IF
329 : END DO
330 17 : WRITE (iw, '(" ",79("*"))')
331 : CASE (CGTO_BASIS)
332 1 : WRITE (iw, '(/," ",22("*"),A,22("*"))') " Contracted Gaussian Type Orbitals "
333 7 : DO l = 0, lmat
334 7 : IF (atom_basis%nbas(l) > 0) THEN
335 2 : IF (l == 0) WRITE (iw, '(A)') " s Functions"
336 2 : IF (l == 1) WRITE (iw, '(A)') " p Functions"
337 2 : IF (l == 2) WRITE (iw, '(A)') " d Functions"
338 2 : IF (l == 3) WRITE (iw, '(A)') " f Functions"
339 2 : IF (l >= 3) WRITE (iw, '(A)') " x Functions"
340 11 : DO i = 1, atom_basis%nprim(l)
341 : WRITE (iw, '(F15.6,5(T21,6F10.6,/))') &
342 35 : atom_basis%am(i, l), (atom_basis%cm(i, j, l), j=1, atom_basis%nbas(l))
343 : END DO
344 : END IF
345 : END DO
346 1 : WRITE (iw, '(" ",79("*"))')
347 : CASE (STO_BASIS)
348 4 : WRITE (iw, '(/," ",28("*"),A,29("*"))') " Slater Type Orbitals "
349 28 : DO l = 0, lmat
350 39 : DO i = 1, atom_basis%nbas(l)
351 24 : SELECT CASE (l)
352 : CASE DEFAULT
353 0 : WRITE (iw, '(T10,I1,A,T40,F25.12)') atom_basis%ns(i, l), "X Exponent :", atom_basis%as(i, l)
354 : CASE (0)
355 8 : WRITE (iw, '(T10,I1,A,T40,F25.12)') atom_basis%ns(i, 0), "S Exponent :", atom_basis%as(i, 0)
356 : CASE (1)
357 3 : WRITE (iw, '(T10,I1,A,T40,F25.12)') atom_basis%ns(i, 1), "P Exponent :", atom_basis%as(i, 1)
358 : CASE (2)
359 0 : WRITE (iw, '(T10,I1,A,T40,F25.12)') atom_basis%ns(i, 2), "D Exponent :", atom_basis%as(i, 2)
360 : CASE (3)
361 11 : WRITE (iw, '(T10,I1,A,T40,F25.12)') atom_basis%ns(i, 3), "F Exponent :", atom_basis%as(i, 3)
362 : END SELECT
363 : END DO
364 : END DO
365 4 : WRITE (iw, '(" ",79("*"))')
366 : CASE (NUM_BASIS)
367 0 : CPABORT("")
368 : CASE DEFAULT
369 22 : CPABORT("")
370 : END SELECT
371 :
372 22 : END SUBROUTINE atom_print_basis
373 :
374 : ! **************************************************************************************************
375 : !> \brief Print the optimized atomic basis set into a file.
376 : !> \param atom_basis atomic basis set
377 : !> \param wfn ...
378 : !> \par History
379 : !> * 11.2016 revised output format [Matthias Krack]
380 : !> * 11.2011 Slater basis functions [Juerg Hutter]
381 : !> * 03.2011 created [Juerg Hutter]
382 : !> \note The basis set is stored as the file 'OPT_BASIS' inside the current working directory.
383 : !> It may be a good idea, however, to specify the name of this file via some input section.
384 : ! **************************************************************************************************
385 5 : SUBROUTINE atom_print_basis_file(atom_basis, wfn)
386 : TYPE(atom_basis_type) :: atom_basis
387 : REAL(KIND=dp), DIMENSION(:, :, 0:), OPTIONAL :: wfn
388 :
389 : INTEGER :: i, im, iw, l
390 : REAL(KIND=dp) :: expzet, prefac, zeta
391 :
392 5 : CALL open_file(file_name="OPT_BASIS", file_status="UNKNOWN", file_action="WRITE", unit_number=iw)
393 7 : SELECT CASE (atom_basis%basis_type)
394 : CASE (GTO_BASIS)
395 2 : IF (atom_basis%geometrical) THEN
396 0 : WRITE (iw, '(/," ",21("*"),A,22("*"))') " Geometrical Gaussian Type Orbitals "
397 0 : WRITE (iw, '(A,F15.8,T41,A,F15.8)') " Initial exponent: ", atom_basis%aval, &
398 0 : " Proportionality factor: ", atom_basis%cval
399 : ELSE
400 2 : WRITE (iw, '(T3,A)') "BASIS_TYPE GAUSSIAN"
401 : END IF
402 14 : DO l = 0, lmat
403 14 : IF (atom_basis%nbas(l) > 0) THEN
404 0 : SELECT CASE (l)
405 : CASE DEFAULT
406 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
407 0 : "X_EXPONENTS ", (atom_basis%am(i, l), i=1, atom_basis%nbas(l))
408 : CASE (0)
409 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
410 14 : "S_EXPONENTS ", (atom_basis%am(i, 0), i=1, atom_basis%nbas(0))
411 : CASE (1)
412 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
413 14 : "P_EXPONENTS ", (atom_basis%am(i, 1), i=1, atom_basis%nbas(1))
414 : CASE (2)
415 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
416 14 : "D_EXPONENTS ", (atom_basis%am(i, 2), i=1, atom_basis%nbas(2))
417 : CASE (3)
418 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
419 6 : "F_EXPONENTS ", (atom_basis%am(i, 3), i=1, atom_basis%nbas(3))
420 : END SELECT
421 : END IF
422 : END DO
423 : CASE (CGTO_BASIS)
424 0 : CPABORT("")
425 : CASE (STO_BASIS)
426 3 : WRITE (iw, '(T3,A)') "BASIS_TYPE SLATER"
427 21 : DO l = 0, lmat
428 21 : IF (atom_basis%nbas(l) > 0) THEN
429 0 : SELECT CASE (l)
430 : CASE DEFAULT
431 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
432 0 : "X_EXPONENTS ", (atom_basis%as(i, l), i=1, atom_basis%nbas(l))
433 : WRITE (iw, '(T3,A,60I3)') &
434 0 : "X_QUANTUM_NUMBERS ", (atom_basis%ns(i, l), i=1, atom_basis%nbas(l))
435 : CASE (0)
436 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
437 10 : "S_EXPONENTS ", (atom_basis%as(i, 0), i=1, atom_basis%nbas(0))
438 : WRITE (iw, '(T3,A,60I3)') &
439 10 : "S_QUANTUM_NUMBERS ", (atom_basis%ns(i, 0), i=1, atom_basis%nbas(0))
440 : CASE (1)
441 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
442 3 : "P_EXPONENTS ", (atom_basis%as(i, 1), i=1, atom_basis%nbas(1))
443 : WRITE (iw, '(T3,A,60I3)') &
444 3 : "P_QUANTUM_NUMBERS ", (atom_basis%ns(i, 1), i=1, atom_basis%nbas(1))
445 : CASE (2)
446 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
447 0 : "D_EXPONENTS ", (atom_basis%as(i, 2), i=1, atom_basis%nbas(2))
448 : WRITE (iw, '(T3,A,60I3)') &
449 0 : "D_QUANTUM_NUMBERS ", (atom_basis%ns(i, 2), i=1, atom_basis%nbas(2))
450 : CASE (3)
451 : WRITE (iw, '(T3,A,(T15,F20.8,:," \"))') &
452 0 : "F_EXPONENTS ", (atom_basis%as(i, 3), i=1, atom_basis%nbas(3))
453 : WRITE (iw, '(T3,A,60I3)') &
454 4 : "F_QUANTUM_NUMBERS ", (atom_basis%ns(i, 3), i=1, atom_basis%nbas(3))
455 : END SELECT
456 : END IF
457 : END DO
458 : CASE (NUM_BASIS)
459 0 : CPABORT("")
460 : CASE DEFAULT
461 5 : CPABORT("")
462 : END SELECT
463 :
464 5 : IF (PRESENT(wfn)) THEN
465 7 : SELECT CASE (atom_basis%basis_type)
466 : CASE DEFAULT
467 : CASE (GTO_BASIS)
468 5 : IF (.NOT. atom_basis%geometrical) THEN
469 2 : WRITE (iw, '(/,T3,A)') "ORBITAL COEFFICENTS (Quickstep normalization)"
470 2 : im = MIN(6, SIZE(wfn, 2))
471 14 : DO l = 0, lmat
472 14 : IF (atom_basis%nbas(l) > 0) THEN
473 6 : WRITE (iw, '(T3,A,I3)') "L Quantum Number:", l
474 : ! Quickstep normalization
475 6 : expzet = 0.25_dp*REAL(2*l + 3, dp)
476 6 : prefac = SQRT(rootpi/2._dp**(l + 2)*dfac(2*l + 1))
477 42 : DO i = 1, atom_basis%nbas(l)
478 36 : zeta = (2._dp*atom_basis%am(i, l))**expzet
479 78 : WRITE (iw, '(T5,F14.8,2x,6F12.8)') atom_basis%am(i, l), wfn(i, 1:im, l)*prefac/zeta
480 : END DO
481 : END IF
482 : END DO
483 : END IF
484 : END SELECT
485 : END IF
486 :
487 5 : CALL close_file(unit_number=iw)
488 :
489 5 : END SUBROUTINE atom_print_basis_file
490 :
491 : ! **************************************************************************************************
492 : !> \brief Print information about the electronic structure method in use.
493 : !> \param atom information about the atomic kind
494 : !> \param iw output file unit
495 : !> \par History
496 : !> * 09.2015 direct use of the LibXC Fortran interface [Andreas Gloess]
497 : !> * 10.2012 LibXC interface [Fabien Tran]
498 : !> * 02.2010 unrestricted KS and HF methods [Juerg Hutter]
499 : !> * 04.2009 print geometrical Gaussian type orbitals [Juerg Hutter]
500 : !> * 09.2008 new subroutine's prototype; print relativistic methods [Juerg Hutter]
501 : !> * 09.2008 created [Juerg Hutter]
502 : ! **************************************************************************************************
503 366 : SUBROUTINE atom_print_method(atom, iw)
504 : TYPE(atom_type) :: atom
505 : INTEGER, INTENT(IN) :: iw
506 :
507 : CHARACTER(len=160) :: shortform
508 : CHARACTER(LEN=20) :: tmpStr
509 366 : CHARACTER(len=:), ALLOCATABLE :: reference
510 : INTEGER :: ifun, il, meth, myfun, reltyp
511 : LOGICAL :: lsd
512 : TYPE(section_vals_type), POINTER :: xc_fun, xc_fun_section, xc_section
513 :
514 366 : NULLIFY (xc_fun, xc_fun_section, xc_section)
515 :
516 366 : meth = atom%method_type
517 :
518 366 : xc_section => atom%xc_section
519 366 : xc_fun_section => section_vals_get_subs_vals(xc_section, "XC_FUNCTIONAL")
520 0 : SELECT CASE (meth)
521 : CASE DEFAULT
522 0 : CPABORT("")
523 : CASE (do_rks_atom)
524 328 : CALL section_vals_val_get(xc_fun_section, "_SECTION_PARAMETERS_", i_val=myfun)
525 : CASE (do_uks_atom)
526 68 : CALL section_vals_val_get(xc_fun_section, "_SECTION_PARAMETERS_", i_val=myfun)
527 : CASE (do_rhf_atom)
528 34 : myfun = xc_none
529 : CASE (do_uhf_atom)
530 4 : myfun = xc_none
531 : CASE (do_rohf_atom)
532 366 : myfun = xc_none
533 : END SELECT
534 :
535 0 : SELECT CASE (meth)
536 : CASE DEFAULT
537 0 : CPABORT("")
538 : CASE (do_rks_atom)
539 294 : IF (iw > 0) WRITE (iw, fmt="(/,' METHOD | Restricted Kohn-Sham Calculation')")
540 : CASE (do_uks_atom)
541 34 : IF (iw > 0) WRITE (iw, fmt="(/,' METHOD | Unrestricted Kohn-Sham Calculation')")
542 : CASE (do_rhf_atom)
543 34 : IF (iw > 0) WRITE (iw, fmt="(/,' METHOD | Restricted Hartree-Fock Calculation')")
544 : CASE (do_uhf_atom)
545 4 : IF (iw > 0) WRITE (iw, fmt="(/,' METHOD | Unrestricted Hartree-Fock Calculation')")
546 : CASE (do_rohf_atom)
547 366 : IF (iw > 0) WRITE (iw, fmt="(/,' METHOD | Restricted Open-Shell Kohn-Sham Calculation')")
548 : END SELECT
549 :
550 : ! zmp
551 366 : IF (atom%do_zmp) THEN
552 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | Method on atomic radial density')")
553 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | Lambda : ',F5.1)") atom%lambda
554 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | Reading external density : ',A20)") atom%ext_file
555 0 : IF (atom%dm) THEN
556 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | The file is in the form of a density matrix')")
557 : ELSE
558 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | The file is in the form of a linear density')")
559 : END IF
560 0 : IF (atom%doread) THEN
561 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | Restarting calculation from ',A20,' file if present')") atom%zmp_restart_file
562 : END IF
563 366 : ELSE IF (atom%read_vxc) THEN
564 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | Calculating density from external V_xc')")
565 0 : IF (iw > 0) WRITE (iw, fmt="(' ZMP | Reading external v_xc file : ',A20)") atom%ext_vxc_file
566 : END IF
567 :
568 366 : IF (atom%pp_calc) THEN
569 78 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Nonrelativistic Calculation')")
570 : ELSE
571 288 : reltyp = atom%relativistic
572 :
573 0 : SELECT CASE (reltyp)
574 : CASE DEFAULT
575 0 : CPABORT("")
576 : CASE (do_nonrel_atom)
577 220 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Nonrelativistic Calculation')")
578 : CASE (do_zoramp_atom)
579 14 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using ZORA(MP)')")
580 : CASE (do_sczoramp_atom)
581 2 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using scaled ZORA(MP)')")
582 : CASE (do_dkh0_atom)
583 2 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using Douglas-Kroll 0th order')")
584 2 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using kietic energy scaling')")
585 : CASE (do_dkh1_atom)
586 2 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using Douglas-Kroll 1st order')")
587 2 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using Foldy-Wouthuysen transformation')")
588 : CASE (do_dkh2_atom)
589 16 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using Douglas-Kroll 2nd order')")
590 : CASE (do_dkh3_atom)
591 288 : IF (iw > 0) WRITE (iw, fmt="(' METHOD | Relativistic Calculation using Douglas-Kroll 3rd order')")
592 : END SELECT
593 : END IF
594 :
595 366 : lsd = (meth == do_uks_atom)
596 :
597 366 : IF (myfun /= xc_none) THEN
598 326 : CALL section_vals_val_get(xc_section, "FUNCTIONAL_ROUTINE", c_val=tmpStr)
599 326 : IF (iw > 0) WRITE (iw, fmt="(' FUNCTIONAL| ROUTINE=',a)") TRIM(tmpStr)
600 326 : CALL xc_functionals_expand(xc_fun_section, xc_section)
601 326 : IF (iw > 0) THEN
602 163 : ifun = 0
603 232 : DO
604 395 : ifun = ifun + 1
605 395 : xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun)
606 395 : IF (.NOT. ASSOCIATED(xc_fun)) EXIT
607 232 : IF (libxc_check_existence_in_libxc(xc_fun)) THEN
608 3 : ALLOCATE (CHARACTER(LEN=libxc_get_reference_length(xc_fun, lsd)) :: reference)
609 : ELSE
610 229 : ALLOCATE (CHARACTER(LEN=20*default_string_length) :: reference)
611 : END IF
612 232 : CALL xc_functional_get_info(xc_fun, lsd=lsd, reference=reference, shortform=shortform)
613 : WRITE (iw, fmt="(' FUNCTIONAL| ',a,':')") &
614 232 : TRIM(xc_fun%section%name)
615 630 : DO il = 1, LEN_TRIM(reference), 67
616 630 : WRITE (iw, fmt="(' FUNCTIONAL| ',a67)") reference(il:)
617 : END DO
618 395 : DEALLOCATE (reference)
619 : END DO
620 : END IF
621 : ELSE
622 40 : IF (iw > 0) WRITE (iw, fmt="(' FUNCTIONAL| NO EXCHANGE-CORRELATION FUNCTIONAL USED.')")
623 : END IF
624 :
625 366 : END SUBROUTINE atom_print_method
626 :
627 : ! **************************************************************************************************
628 : !> \brief Print information about the pseudo-potential.
629 : !> \param potential pseudo-potential
630 : !> \param iw output file unit
631 : !> \par History
632 : !> * 05.2017 SGP pseudo-potentials [Juerg Hutter]
633 : !> * 02.2016 pseudo-potential in Quantum Espresso UPF format [Juerg Hutter]
634 : !> * 01.2016 new confinement potential form [Juerg Hutter]
635 : !> * 03.2010 extension of GTH pseudo-potential definition [Juerg Hutter]
636 : !> * 05.2009 GTH pseudo-potential [Juerg Hutter]
637 : !> * 09.2008 created [Juerg Hutter]
638 : ! **************************************************************************************************
639 3 : SUBROUTINE atom_print_potential(potential, iw)
640 : TYPE(atom_potential_type) :: potential
641 : INTEGER, INTENT(IN) :: iw
642 :
643 : CHARACTER(len=60) :: pline
644 : INTEGER :: i, j, k, l
645 :
646 3 : SELECT CASE (potential%ppot_type)
647 : CASE (no_pseudo)
648 0 : WRITE (iw, '(/," ",28("*"),A,27("*"))') " All Electron Potential "
649 : CASE (gth_pseudo)
650 0 : WRITE (iw, '(/," ",29("*"),A,29("*"))') " GTH Pseudopotential "
651 0 : WRITE (iw, '(T10,A,T76,F5.1)') " Core Charge ", potential%gth_pot%zion
652 0 : WRITE (iw, '(T10,A,T66,F15.6)') " Rc ", potential%gth_pot%rc
653 0 : WRITE (pline, '(5F12.6)') (potential%gth_pot%cl(i), i=1, potential%gth_pot%ncl)
654 0 : WRITE (iw, '(T10,A,T21,A60)') " C1 C2 ... ", ADJUSTR(pline)
655 0 : IF (potential%gth_pot%lpotextended) THEN
656 0 : DO k = 1, potential%gth_pot%nexp_lpot
657 0 : WRITE (iw, '(T10,A,F10.6,T38,A,4F10.6)') " LPot: rc=", potential%gth_pot%alpha_lpot(k), &
658 0 : "CX=", (potential%gth_pot%cval_lpot(i, k), i=1, potential%gth_pot%nct_lpot(k))
659 : END DO
660 : END IF
661 0 : IF (potential%gth_pot%nlcc) THEN
662 0 : DO k = 1, potential%gth_pot%nexp_nlcc
663 0 : WRITE (iw, '(T10,A,F10.6,T38,A,4F10.6)') " LSDPot: rc=", potential%gth_pot%alpha_nlcc(k), &
664 0 : "CX=", (potential%gth_pot%cval_nlcc(i, k)*4.0_dp*pi, i=1, potential%gth_pot%nct_nlcc(k))
665 : END DO
666 : END IF
667 0 : IF (potential%gth_pot%lsdpot) THEN
668 0 : DO k = 1, potential%gth_pot%nexp_lsd
669 0 : WRITE (iw, '(T10,A,F10.6,T38,A,4F10.6)') " LSDPot: rc=", potential%gth_pot%alpha_lsd(k), &
670 0 : "CX=", (potential%gth_pot%cval_lsd(i, k), i=1, potential%gth_pot%nct_lsd(k))
671 : END DO
672 : END IF
673 0 : DO l = 0, lmat
674 0 : IF (potential%gth_pot%nl(l) > 0) THEN
675 0 : WRITE (iw, '(T10,A,T76,I5)') " Angular momentum ", l
676 0 : WRITE (iw, '(T10,A,T66,F15.6)') " Rcnl ", potential%gth_pot%rcnl(l)
677 0 : WRITE (iw, '(T10,A,T76,I5)') " Nl ", potential%gth_pot%nl(l)
678 0 : WRITE (pline, '(5F12.6)') (potential%gth_pot%hnl(1, j, l), j=1, potential%gth_pot%nl(l))
679 0 : WRITE (iw, '(T10,A,T21,A60)') " Hnl ", ADJUSTR(pline)
680 0 : DO i = 2, potential%gth_pot%nl(l)
681 0 : WRITE (pline, '(T21,5F12.6)') (potential%gth_pot%hnl(i, j, l), j=i, potential%gth_pot%nl(l))
682 0 : WRITE (iw, '(T21,A60)') ADJUSTR(pline)
683 : END DO
684 : END IF
685 : END DO
686 : CASE (upf_pseudo)
687 0 : WRITE (iw, '(/," ",29("*"),A,29("*"))') " UPF Pseudopotential "
688 0 : DO k = 1, potential%upf_pot%maxinfo
689 0 : WRITE (iw, '(A80)') potential%upf_pot%info(k)
690 : END DO
691 : CASE (sgp_pseudo)
692 0 : WRITE (iw, '(/," ",29("*"),A,29("*"))') " SGP Pseudopotential "
693 0 : WRITE (iw, '(T10,A,T76,F5.1)') " Core Charge ", potential%sgp_pot%zion
694 : CASE (ecp_pseudo)
695 3 : WRITE (iw, '(/," ",26("*"),A,27("*"))') " Effective Core Potential "
696 3 : WRITE (iw, '(T10,A,T76,F5.1)') " Core Charge ", potential%ecp_pot%zion
697 6 : DO k = 1, potential%ecp_pot%nloc
698 6 : IF (k == 1) THEN
699 3 : WRITE (iw, '(T10,A,T40,I3,T49,2F16.8)') " Local Potential ", potential%ecp_pot%nrloc(k), &
700 6 : potential%ecp_pot%bloc(k), potential%ecp_pot%aloc(k)
701 : ELSE
702 0 : WRITE (iw, '(T40,I3,T49,2F16.8)') potential%ecp_pot%nrloc(k), &
703 0 : potential%ecp_pot%bloc(k), potential%ecp_pot%aloc(k)
704 : END IF
705 : END DO
706 14 : DO l = 0, potential%ecp_pot%lmax
707 11 : WRITE (iw, '(T10,A,I3)') " ECP l-value ", l
708 29 : DO k = 1, potential%ecp_pot%npot(l)
709 15 : WRITE (iw, '(T40,I3,T49,2F16.8)') potential%ecp_pot%nrpot(k, l), &
710 41 : potential%ecp_pot%bpot(k, l), potential%ecp_pot%apot(k, l)
711 : END DO
712 : END DO
713 : CASE DEFAULT
714 3 : CPABORT("")
715 : END SELECT
716 3 : IF (potential%confinement) THEN
717 0 : IF (potential%conf_type == poly_conf) THEN
718 : WRITE (iw, '(/,T10,A,T51,F12.6," * (R /",F6.2,")**",F6.2)') &
719 0 : " Confinement Potential ", potential%acon, potential%rcon, potential%scon
720 0 : ELSE IF (potential%conf_type == barrier_conf) THEN
721 0 : WRITE (iw, '(/,T10,A)') " Confinement Potential s*F[(r-ron)/w] "
722 0 : WRITE (iw, '(T57,A,F12.6,A)') "s =", potential%acon, " Ha"
723 0 : WRITE (iw, '(T57,A,F12.6,A)') "w =", potential%rcon, " Bohr"
724 0 : WRITE (iw, '(T57,A,F12.6,A)') "ron =", potential%scon, " Bohr"
725 : ELSE
726 0 : CPABORT("")
727 : END IF
728 : ELSE
729 3 : WRITE (iw, '(/,T10,A)') " No Confinement Potential is applied "
730 : END IF
731 3 : WRITE (iw, '(" ",79("*"))')
732 :
733 3 : END SUBROUTINE atom_print_potential
734 :
735 : ! **************************************************************************************************
736 : !> \brief Print GTH pseudo-potential parameters.
737 : !> \param gthpot pseudo-potential
738 : !> \param iunit output file unit
739 : !> \par History
740 : !> * 09.2012 created [Juerg Hutter]
741 : !> \note The pseudo-potential is written into the 'iunit' file unit or as the file 'GTH-PARAMETER'
742 : !> inside the current working directory if the I/O unit is not given explicitly.
743 : ! **************************************************************************************************
744 37 : SUBROUTINE atom_write_pseudo_param(gthpot, iunit)
745 : TYPE(atom_gthpot_type), INTENT(INOUT) :: gthpot
746 : INTEGER, INTENT(IN), OPTIONAL :: iunit
747 :
748 : INTEGER :: i, iw, j, k, n
749 :
750 37 : IF (PRESENT(iunit)) THEN
751 2 : iw = iunit
752 : ELSE
753 35 : CALL open_file(file_name="GTH-PARAMETER", file_status="UNKNOWN", file_action="WRITE", unit_number=iw)
754 : END IF
755 37 : WRITE (iw, '(A2,A)') gthpot%symbol, ADJUSTL(TRIM(gthpot%pname))
756 37 : WRITE (iw, '(4I5)') gthpot%econf(0:3)
757 111 : WRITE (iw, '(F20.14,I8,5F20.14)') gthpot%rc, gthpot%ncl, (gthpot%cl(i), i=1, gthpot%ncl)
758 37 : IF (gthpot%lpotextended) THEN
759 0 : WRITE (iw, '(A,I5)') " LPOT", gthpot%nexp_lpot
760 0 : DO i = 1, gthpot%nexp_lpot
761 0 : WRITE (iw, '(F20.14,I8,5F20.14)') gthpot%alpha_lpot(i), gthpot%nct_lpot(i), &
762 0 : (gthpot%cval_lpot(j, i), j=1, gthpot%nct_lpot(i))
763 : END DO
764 : END IF
765 37 : IF (gthpot%lsdpot) THEN
766 0 : WRITE (iw, '(A,I5)') " LSD ", gthpot%nexp_lsd
767 0 : DO i = 1, gthpot%nexp_lsd
768 0 : WRITE (iw, '(F20.14,I8,5F20.14)') gthpot%alpha_lsd(i), gthpot%nct_lsd(i), &
769 0 : (gthpot%cval_lsd(j, i), j=1, gthpot%nct_lsd(i))
770 : END DO
771 : END IF
772 37 : IF (gthpot%nlcc) THEN
773 24 : WRITE (iw, '(A,I5)') " NLCC ", gthpot%nexp_nlcc
774 48 : DO i = 1, gthpot%nexp_nlcc
775 24 : WRITE (iw, '(F20.14,I8,5F20.14)') gthpot%alpha_nlcc(i), gthpot%nct_nlcc(i), &
776 96 : (gthpot%cval_nlcc(j, i)*4.0_dp*pi, j=1, gthpot%nct_nlcc(i))
777 : END DO
778 : END IF
779 37 : n = 0
780 201 : DO i = lmat, 0, -1
781 201 : IF (gthpot%nl(i) > 0) THEN
782 34 : n = i + 1
783 34 : EXIT
784 : END IF
785 : END DO
786 37 : WRITE (iw, '(I8)') n
787 95 : DO i = 0, n - 1
788 116 : WRITE (iw, '(F20.14,I8,5F20.14)') gthpot%rcnl(i), gthpot%nl(i), (gthpot%hnl(1, k, i), k=1, gthpot%nl(i))
789 37 : SELECT CASE (gthpot%nl(i))
790 : CASE (2)
791 0 : WRITE (iw, '(T49,F20.14)') gthpot%hnl(2, 2, i)
792 : CASE (3)
793 0 : WRITE (iw, '(T49,2F20.14)') gthpot%hnl(2, 2, i), gthpot%hnl(2, 3, i)
794 0 : WRITE (iw, '(T69,F20.14)') gthpot%hnl(3, 3, i)
795 : CASE DEFAULT
796 58 : DO j = 2, gthpot%nl(i)
797 58 : WRITE (iw, '(T29,5F20.14)') (gthpot%hnl(j, k, i), k=j, gthpot%nl(i))
798 : END DO
799 : END SELECT
800 : END DO
801 37 : IF (.NOT. PRESENT(iunit)) CALL close_file(unit_number=iw)
802 :
803 37 : END SUBROUTINE atom_write_pseudo_param
804 :
805 : ! **************************************************************************************************
806 : !> \brief Print atomic orbitals.
807 : !> \param atom information about the atomic kind
808 : !> \param iw output file unit
809 : !> \par History
810 : !> * 04.2013 created [Juerg Hutter]
811 : ! **************************************************************************************************
812 0 : SUBROUTINE atom_print_orbitals(atom, iw)
813 : TYPE(atom_type), POINTER :: atom
814 : INTEGER, INTENT(IN) :: iw
815 :
816 0 : SELECT CASE (atom%method_type)
817 : CASE DEFAULT
818 0 : CPABORT("")
819 : CASE (do_rks_atom)
820 0 : CALL atom_print_orbitals_helper(atom, atom%orbitals%wfn, "", iw)
821 : CASE (do_uks_atom)
822 0 : CALL atom_print_orbitals_helper(atom, atom%orbitals%wfna, "Alpha", iw)
823 0 : CALL atom_print_orbitals_helper(atom, atom%orbitals%wfnb, "Beta", iw)
824 : CASE (do_rhf_atom)
825 0 : CALL atom_print_orbitals_helper(atom, atom%orbitals%wfn, "", iw)
826 : CASE (do_uhf_atom)
827 0 : CALL atom_print_orbitals_helper(atom, atom%orbitals%wfna, "Alpha", iw)
828 0 : CALL atom_print_orbitals_helper(atom, atom%orbitals%wfnb, "Beta", iw)
829 : CASE (do_rohf_atom)
830 0 : CPABORT("")
831 : END SELECT
832 :
833 0 : END SUBROUTINE atom_print_orbitals
834 :
835 : ! **************************************************************************************************
836 : !> \brief Print atomic orbitals of the given spin.
837 : !> \param atom information about the atomic kind
838 : !> \param wfn atomic orbitals
839 : !> \param description description string
840 : !> \param iw output file unit
841 : !> \par History
842 : !> * 04.2013 created [Juerg Hutter]
843 : ! **************************************************************************************************
844 0 : SUBROUTINE atom_print_orbitals_helper(atom, wfn, description, iw)
845 : TYPE(atom_type), POINTER :: atom
846 : REAL(KIND=dp), DIMENSION(:, :, 0:), INTENT(INOUT) :: wfn
847 : CHARACTER(len=*), INTENT(IN) :: description
848 : INTEGER, INTENT(IN) :: iw
849 :
850 : INTEGER :: b, l, maxl, nb, nv, v
851 :
852 0 : WRITE (iw, '(/,A,A,A)') " Atomic orbital expansion coefficients [", description, "]"
853 :
854 0 : maxl = atom%state%maxl_calc
855 0 : DO l = 0, maxl
856 :
857 0 : nb = atom%basis%nbas(l)
858 0 : nv = atom%state%maxn_calc(l)
859 0 : IF (nb > 0 .AND. nv > 0) THEN
860 0 : nv = MIN(nv, SIZE(wfn, 2))
861 0 : DO v = 1, nv
862 0 : WRITE (iw, '(/," ORBITAL L = ",I1," State = ",I3)') l, v
863 0 : DO b = 1, nb
864 0 : WRITE (iw, '(" ",ES23.15)') wfn(b, v, l)
865 : END DO
866 : END DO
867 : END IF
868 : END DO
869 0 : END SUBROUTINE atom_print_orbitals_helper
870 :
871 : END MODULE atom_output
|
