Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Print basis sets in CP2K format
10 : !> \par History
11 : !> \author JGH (12.2017)
12 : ! **************************************************************************************************
13 : MODULE basis_set_output
14 : USE basis_set_types, ONLY: get_gto_basis_set,&
15 : gto_basis_set_type
16 : USE cp2k_info, ONLY: compile_revision,&
17 : cp2k_version,&
18 : r_host_name,&
19 : r_timestamp,&
20 : r_user_name
21 : USE cp_files, ONLY: close_file,&
22 : open_file
23 : USE cp_log_handling, ONLY: cp_get_default_logger,&
24 : cp_logger_get_default_io_unit,&
25 : cp_logger_type
26 : USE input_section_types, ONLY: section_vals_type,&
27 : section_vals_val_get
28 : USE kinds, ONLY: default_string_length,&
29 : dp
30 : USE qs_environment_types, ONLY: get_qs_env,&
31 : qs_environment_type
32 : USE qs_kind_types, ONLY: get_qs_kind,&
33 : qs_kind_type
34 : #include "./base/base_uses.f90"
35 :
36 : IMPLICIT NONE
37 : PRIVATE
38 :
39 : ! Global parameters
40 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'basis_set_output'
41 : PUBLIC :: print_basis_set_file
42 :
43 : ! **************************************************************************************************
44 :
45 : CONTAINS
46 :
47 : ! **************************************************************************************************
48 : !> \brief ...
49 : !> \param qs_env ...
50 : !> \param base_section ...
51 : ! **************************************************************************************************
52 2 : SUBROUTINE print_basis_set_file(qs_env, base_section)
53 :
54 : TYPE(qs_environment_type), POINTER :: qs_env
55 : TYPE(section_vals_type), POINTER :: base_section
56 :
57 : CHARACTER(LEN=2) :: element_symbol
58 : CHARACTER(LEN=default_string_length) :: bname, filename
59 : INTEGER :: ikind, iunit, nkind, ounit
60 : INTEGER, SAVE :: ncalls = 0
61 : TYPE(cp_logger_type), POINTER :: logger
62 : TYPE(gto_basis_set_type), POINTER :: aux_fit_basis, lri_aux_basis, nuclear_basis, orb_basis, &
63 : p_lri_aux_basis, ri_aux_basis, ri_hfx_basis, ri_hxc_basis, ri_xas_basis, tda_hfx_basis
64 2 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
65 : TYPE(qs_kind_type), POINTER :: qs_kind
66 :
67 0 : IF (ncalls > 0) RETURN
68 2 : ncalls = ncalls + 1
69 :
70 2 : logger => cp_get_default_logger()
71 2 : ounit = cp_logger_get_default_io_unit(logger)
72 :
73 2 : CALL section_vals_val_get(base_section, "FILENAME", c_val=filename)
74 :
75 2 : IF (ounit > 0) THEN
76 1 : WRITE (UNIT=ounit, FMT='(/,(T2,A))') REPEAT("-", 79)
77 1 : WRITE (UNIT=ounit, FMT='((T2,A,A))') "Print Basis Set File: ", TRIM(filename)
78 1 : WRITE (UNIT=ounit, FMT='((T2,A))') REPEAT("-", 79)
79 1 : CALL open_file(filename, unit_number=iunit, file_status="UNKNOWN", file_action="WRITE")
80 : WRITE (UNIT=iunit, FMT="(A8,T11,A)") &
81 1 : "# TITLE ", "Basis set file created by "//TRIM(cp2k_version)//" (revision "//TRIM(compile_revision)//")", &
82 2 : "# AUTHOR", TRIM(r_user_name)//"@"//TRIM(r_host_name)//" "//r_timestamp(:19)
83 :
84 : END IF
85 :
86 2 : CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, nkind=nkind)
87 6 : DO ikind = 1, nkind
88 4 : qs_kind => qs_kind_set(ikind)
89 4 : CALL get_qs_kind(qs_kind, element_symbol=element_symbol)
90 4 : NULLIFY (orb_basis, ri_aux_basis, lri_aux_basis, p_lri_aux_basis, aux_fit_basis)
91 4 : CALL get_qs_kind(qs_kind, basis_set=orb_basis, basis_type="ORB")
92 4 : CALL get_qs_kind(qs_kind, basis_set=ri_aux_basis, basis_type="RI_AUX")
93 4 : CALL get_qs_kind(qs_kind, basis_set=ri_hxc_basis, basis_type="RI_HXC")
94 4 : CALL get_qs_kind(qs_kind, basis_set=ri_hfx_basis, basis_type="RI_HFX")
95 4 : CALL get_qs_kind(qs_kind, basis_set=lri_aux_basis, basis_type="LRI_AUX")
96 4 : CALL get_qs_kind(qs_kind, basis_set=p_lri_aux_basis, basis_type="P_LRI_AUX")
97 4 : CALL get_qs_kind(qs_kind, basis_set=aux_fit_basis, basis_type="AUX_FIT")
98 4 : CALL get_qs_kind(qs_kind, basis_set=ri_xas_basis, basis_type="RI_XAS")
99 4 : CALL get_qs_kind(qs_kind, basis_set=tda_hfx_basis, basis_type="TDA_HFX")
100 4 : CALL get_qs_kind(qs_kind, basis_set=nuclear_basis, basis_type="NUC")
101 6 : IF (ounit > 0) THEN
102 2 : IF (ASSOCIATED(orb_basis)) THEN
103 2 : bname = "local_orbital"
104 2 : CALL basis_out(orb_basis, element_symbol, bname, iunit)
105 : END IF
106 2 : IF (ASSOCIATED(ri_aux_basis)) THEN
107 0 : bname = "local_ri_aux"
108 0 : CALL basis_out(ri_aux_basis, element_symbol, bname, iunit)
109 : END IF
110 2 : IF (ASSOCIATED(ri_hxc_basis)) THEN
111 0 : bname = "local_ri_hxc"
112 0 : CALL basis_out(ri_hxc_basis, element_symbol, bname, iunit)
113 : END IF
114 2 : IF (ASSOCIATED(lri_aux_basis)) THEN
115 2 : bname = "local_lri_aux"
116 2 : CALL basis_out(lri_aux_basis, element_symbol, bname, iunit)
117 : END IF
118 2 : IF (ASSOCIATED(p_lri_aux_basis)) THEN
119 2 : bname = "local_p_lri_aux"
120 2 : CALL basis_out(p_lri_aux_basis, element_symbol, bname, iunit)
121 : END IF
122 2 : IF (ASSOCIATED(aux_fit_basis)) THEN
123 0 : bname = "local_aux_fit"
124 0 : CALL basis_out(aux_fit_basis, element_symbol, bname, iunit)
125 : END IF
126 2 : IF (ASSOCIATED(ri_xas_basis)) THEN
127 0 : bname = "local_ri_xas"
128 0 : CALL basis_out(ri_xas_basis, element_symbol, bname, iunit)
129 : END IF
130 2 : IF (ASSOCIATED(ri_hfx_basis)) THEN
131 0 : bname = "local_ri_hfx"
132 0 : CALL basis_out(ri_hfx_basis, element_symbol, bname, iunit)
133 : END IF
134 2 : IF (ASSOCIATED(tda_hfx_basis)) THEN
135 0 : bname = "local_tda_hfx"
136 0 : CALL basis_out(tda_hfx_basis, element_symbol, bname, iunit)
137 : END IF
138 2 : IF (ASSOCIATED(nuclear_basis)) THEN
139 0 : bname = "local_nuc"
140 0 : CALL basis_out(nuclear_basis, element_symbol, bname, iunit)
141 : END IF
142 : END IF
143 : END DO
144 :
145 2 : IF (ounit > 0) THEN
146 1 : CALL close_file(iunit)
147 : END IF
148 :
149 2 : END SUBROUTINE print_basis_set_file
150 :
151 : ! **************************************************************************************************
152 :
153 : ! **************************************************************************************************
154 : !> \brief ...
155 : !> \param basis ...
156 : !> \param element_symbol ...
157 : !> \param bname ...
158 : !> \param iunit ...
159 : ! **************************************************************************************************
160 12 : SUBROUTINE basis_out(basis, element_symbol, bname, iunit)
161 : TYPE(gto_basis_set_type), POINTER :: basis
162 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, bname
163 : INTEGER, INTENT(IN) :: iunit
164 :
165 : INTEGER :: ipgf, iset, ishell, ll, nset
166 : INTEGER, DIMENSION(0:9) :: lset
167 6 : INTEGER, DIMENSION(:), POINTER :: lmax, lmin, npgf, nshell
168 6 : INTEGER, DIMENSION(:, :), POINTER :: l, n
169 6 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: zet
170 6 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc
171 :
172 6 : WRITE (iunit, "(A1)") "#"
173 6 : WRITE (iunit, "(A2,T5,A)") element_symbol, ADJUSTL(TRIM(bname))
174 :
175 : CALL get_gto_basis_set(basis, nset=nset, npgf=npgf, lmax=lmax, lmin=lmin, &
176 : nshell=nshell, n=n, l=l, &
177 6 : gcc=gcc, zet=zet)
178 :
179 6 : WRITE (iunit, "(I5)") nset
180 58 : DO iset = 1, nset
181 52 : lset = 0
182 246 : DO ishell = 1, nshell(iset)
183 194 : ll = l(ishell, iset)
184 246 : lset(ll) = lset(ll) + 1
185 : END DO
186 52 : WRITE (iunit, "(I5,2I3,I5,2X,10(I3))") n(1, iset), lmin(iset), lmax(iset), npgf(iset), &
187 104 : (lset(ll), ll=lmin(iset), lmax(iset))
188 122 : DO ipgf = 1, npgf(iset)
189 116 : WRITE (iunit, "(F20.10,50(F15.10))") zet(ipgf, iset), (gcc(ipgf, ishell, iset), ishell=1, nshell(iset))
190 : END DO
191 : END DO
192 :
193 6 : END SUBROUTINE basis_out
194 :
195 : ! **************************************************************************************************
196 :
197 : END MODULE basis_set_output
|
