1!--------------------------------------------------------------------------------------------------!
2!  DFTB+: general package for performing fast atomistic simulations                                !
3!  Copyright (C) 2006 - 2019  DFTB+ developers group                                               !
4!                                                                                                  !
5!  See the LICENSE file for terms of usage and distribution.                                       !
6!--------------------------------------------------------------------------------------------------!
7
8!> Contains routines to convert HSD input for old parser to the current format.
9!> Note: parserVersion is set in parser.F90
10module dftbp_oldcompat
11  use dftbp_accuracy, only : dp
12  use dftbp_message
13  use dftbp_hsdutils
14  use dftbp_hsdutils2
15  use dftbp_charmanip
16  use dftbp_xmlutils
17  use dftbp_xmlf90
18  implicit None
19  private
20
21  public :: convertOldHSD
22
23contains
24
25
26  !> Converts an HSD input for an older parser to the current format
27  subroutine convertOldHSD(root, oldVersion, curVersion)
28
29    !> Root tag of the HSD-tree
30    type(fnode), pointer :: root
31
32    !> Version number of the old parser
33    integer, intent(in) :: oldVersion
34
35    !> Version number of the current parser
36    integer, intent(in) :: curVersion
37
38    integer :: version
39    type(fnode), pointer :: ch1, ch2, par
40
41    version = oldVersion
42    do while (version < curVersion)
43      select case(version)
44      case(1)
45        call convert_1_2(root)
46        version = 2
47      case(2)
48        call convert_2_3(root)
49        version = 3
50      case (3)
51        call convert_3_4(root)
52        version = 4
53      case (4)
54        call convert_4_5(root)
55        version = 5
56      case (5)
57        call convert_5_6(root)
58        version = 6
59      end select
60    end do
61
62    ! increase the parser version number in the tree - since the resulting dftb_pin would not work
63    ! with the old parser as the options have changed to the new parser by now
64    call getChildValue(root, "ParserOptions", ch1, "", child=par, &
65        &allowEmptyValue=.true.)
66    call getChildValue(par, "ParserVersion", version, child=ch2)
67    call setChildValue(ch2, "", curVersion, replace=.true.)
68
69  end subroutine convertOldHSD
70
71
72  !> Converts input from version 1 to 2. (Version 2 introcuded in August 2006)
73  subroutine convert_1_2(root)
74
75    !> Root tag of the HSD-tree
76    type(fnode), pointer :: root
77
78    type(fnode), pointer :: child1, child2
79
80    call getChild(root, "Geometry", child1, requested=.false.)
81    if (associated(child1)) then
82      call setUnprocessed(child1)
83      call getChild(child1, "SpeciesNames", child2, requested=.false.)
84      if (associated(child2)) then
85        call setUnprocessed(child2)
86        call setNodeName(child2, "TypeNames")
87      end if
88    end if
89
90  end subroutine convert_1_2
91
92
93  !> Converts input from version 2 to 3. (Version 3 introduced in Nov. 2006)
94  subroutine convert_2_3(root)
95
96    !> Root tag of the HSD-tree
97    type(fnode), pointer :: root
98
99    type(fnode), pointer :: ch1, ch2, par
100    logical :: tValue
101
102    call getDescendant(root, &
103        &"Driver/VelocityVerlet/Thermostat/Andersen/RescalingProbability", &
104        &ch1)
105    if (associated(ch1)) then
106      call detailedWarning(ch1, "Keyword renamed to 'ReselectProbability'.")
107      call setNodeName(ch1, "ReselectProbability")
108    end if
109
110    call getDescendant(root, &
111        &"Driver/VelocityVerlet/Thermostat/Andersen/RescaleIndividually", &
112        &ch1)
113    if (associated(ch1)) then
114      call detailedWarning(ch1, "Keyword renamed to 'ReselectIndividually'.")
115      call setNodeName(ch1, "ReselectIndividually")
116    end if
117
118    call getDescendant(root, "Hamiltonian/DFTB/Variational", ch1)
119    if (associated(ch1)) then
120      call getChildValue(ch1, "", tValue)
121      call setUnprocessed(ch1)
122      if (.not. tValue) then
123        call detailedError(ch1, "Sorry, non-variational energy calculation &
124            &is not supported any more!")
125      else
126        call detailedWarning(ch1, "Energy calculation is made only &
127            &variational, option removed.")
128        call destroyNode(ch1)
129      end if
130    end if
131
132    call getDescendant(root, "Hamiltonian/DFTB/SCC", ch1, parent=par)
133    if (associated(ch1)) then
134      call getChildValue(ch1, "", tValue)
135      call setUnprocessed(ch1)
136      if (tValue) then
137        call setChildValue(par, "OrbitalResolvedSCC", .true., child=ch2)
138        call setUnprocessed(ch2)
139        call detailedWarning(ch2, "Calculations are not orbital resolved &
140            &per default any more. Keyword 'OrbitalResolvedSCC' added.")
141      end if
142    end if
143
144    call getDescendant(root, "Options/PrintEigenvectors", ch1)
145    if (associated(ch1)) then
146      call detailedWarning(ch1, "Keyword converted to 'WriteEigenvectors'")
147      call setNodeName(ch1, "WriteEigenvectors")
148    end if
149
150    call getDescendant(root, "Options/WriteTaggedOut", ch1)
151    if (associated(ch1)) then
152      call detailedWarning(ch1, "Keyword converted to 'WriteAutotestTag'. &
153          &Output file name changed to 'autotest.out'")
154      call setNodeName(ch1, "WriteAutotestTag")
155    end if
156
157    call getDescendant(root, "Options/WriteBandDat", ch1)
158    if (associated(ch1)) then
159      call detailedWarning(ch1, "Keyword converted to 'WriteBandOut'. &
160          &Output file name changed to 'band.out'")
161      call setNodeName(ch1, "WriteBandOut")
162    end if
163
164  end subroutine convert_2_3
165
166
167  !> Converts input from version 3 to 4. (Version 4 introduced in Mar. 2010)
168  subroutine convert_3_4(root)
169
170    !> Root tag of the HSD-tree
171    type(fnode), pointer :: root
172
173    type(fnode),pointer :: node, node2, node3
174    type(fnodeList), pointer :: children
175    integer :: ii
176
177    ! Replace range operator with short start:end syntax
178    call getDescendant(root, "Driver/SteepestDescent/MovedAtoms", node)
179    call replaceRange(node)
180    call getDescendant(root, "Driver/ConjugateGradient/MovedAtoms", node)
181    call replaceRange(node)
182    call getDescendant(root, "Driver/SecondDerivatives/Atoms", node)
183    call replaceRange(node)
184    call getDescendant(root, "Driver/VelocityVerlet/MovedAtoms", node)
185    call replaceRange(node)
186    call getDescendant(root, "Hamiltonian/DFTB/SpinPolarisation/Colinear&
187        &/InitialSpin", node)
188    if (associated(node)) then
189      call getChildren(node, "AtomSpin", children)
190      do ii = 1, getLength(children)
191        call getItem1(children, ii, node2)
192        call getChild(node2, "Atoms", node3)
193        call replaceRange(node3)
194      end do
195      call destroyNodeList(children)
196    end if
197
198    call getDescendant(root, "Hamiltonian/DFTB/SpinPolarisation/Colinear&
199        &/InitialSpin", node)
200    if (associated(node)) then
201      call detailedWarning(node, "Keyword renamed to 'InitalSpins'.")
202      call setNodeName(node, "InitialSpins")
203    end if
204
205  end subroutine convert_3_4
206
207  !> Helper function for Range keyword in convert_3_4
208  subroutine replaceRange(node)
209
210    !> node to process
211    type(fnode), pointer :: node
212
213    type(fnode), pointer :: node2
214    integer :: bounds(2)
215
216    if (associated(node)) then
217      call getChild(node, "Range", node2, requested=.false.)
218      if (associated(node2)) then
219        call getChildValue(node2, "", bounds)
220        call removeChildNodes(node)
221        call setChildValue(node, "", &
222            &i2c(bounds(1)) // ":" // i2c(bounds(2)), replace=.true.)
223        call detailedWarning(node, "Specification 'Range { start end }' &
224            &not supported any more, using 'start:end' instead")
225      end if
226    end if
227
228  end subroutine replaceRange
229
230
231  !> Converts input from version 4 to 5. (Version 5 introduced in Dec. 2014)
232  subroutine convert_4_5(root)
233
234    !> Root tag of the HSD-tree
235    type(fnode), pointer :: root
236
237    type(fnode), pointer :: ch1, ch2, ch3, par, dummy
238    logical :: tVal
239
240    call getDescendant(root, "Hamiltonian/DFTB/Eigensolver/Standard", ch1)
241    if (associated(ch1)) then
242      call detailedWarning(ch1, "Keyword renamed to 'QR'.")
243      call setNodeName(ch1, "QR")
244    end if
245
246    call getDescendant(root, "Options/MullikenAnalysis", ch1, parent=par)
247    if (associated(ch1)) then
248      call getChildValue(ch1, "", tVal)
249      call detailedWarning(ch1, "Keyword moved to Analysis block.")
250      dummy => removeChild(par, ch1)
251      call destroyNode(ch1)
252      call getChildValue(root, "Analysis", dummy, "", child=ch1, list=.true., &
253          & allowEmptyValue=.true., dummyValue=.true.)
254      if (.not.associated(ch1)) then
255        call setChild(root, "Analysis", ch1)
256      end if
257      call setChildValue(ch1, "MullikenAnalysis", tVal)
258      call setUnprocessed(ch1)
259    end if
260
261    call getDescendant(root, "Options/AtomResolvedEnergies", ch1, parent=par)
262    if (associated(ch1)) then
263      call getChildValue(par, "AtomResolvedEnergies", tVal)
264      call detailedWarning(ch1, "Keyword moved to Analysis block.")
265      dummy => removeChild(par,ch1)
266      call destroyNode(ch1)
267      call getChildValue(root, "Analysis", dummy, "", child=ch1, list=.true., &
268          &allowEmptyValue=.true., dummyValue=.true.)
269      if (.not.associated(ch1)) then
270        call setChild(root, "Analysis", ch1)
271      end if
272      call setChildValue(ch1,"AtomResolvedEnergies",tVal)
273      call setUnprocessed(ch1)
274    end if
275
276    call getDescendant(root, "Options/WriteEigenvectors", ch1, parent=par)
277    if (associated(ch1)) then
278      call getChildValue(par, "WriteEigenvectors", tVal)
279      call detailedWarning(ch1, "Keyword moved to Analysis block.")
280      dummy => removeChild(par, ch1)
281      call destroyNode(ch1)
282      call getChildValue(root, "Analysis", dummy, "", child=ch1, list=.true., &
283          &allowEmptyValue=.true., dummyValue=.true.)
284      if (.not.associated(ch1)) then
285        call setChild(root, "Analysis", ch1)
286      end if
287      call setChildValue(ch1, "WriteEigenvectors", tVal)
288      call setUnprocessed(ch1)
289    end if
290
291    call getDescendant(root, "Options/WriteBandOut", ch1, parent=par)
292    if (associated(ch1)) then
293      call getChildValue(par, "WriteBandOut", tVal)
294      call detailedWarning(ch1, "Keyword moved to Analysis block.")
295      dummy => removeChild(par, ch1)
296      call destroyNode(ch1)
297      call getChildValue(root, "Analysis", dummy, "", child=ch1, list=.true., &
298          & allowEmptyValue=.true., dummyValue=.true.)
299      if (.not.associated(ch1)) then
300        call setChild(root, "Analysis", ch1)
301      end if
302      call setChildValue(ch1, "WriteBandOut", tVal)
303      call setUnprocessed(ch1)
304    end if
305
306    call getDescendant(root, "Options/CalculateForces", ch1, parent=par)
307    if (associated(ch1)) then
308      call getChildValue(par, "CalculateForces", tVal)
309      call detailedWarning(ch1, "Keyword moved to Analysis block.")
310      dummy => removeChild(par,ch1)
311      call destroyNode(ch1)
312      call getChildValue(root, "Analysis", dummy, "", child=ch1, list=.true., &
313          &allowEmptyValue=.true., dummyValue=.true.)
314      if (.not.associated(ch1)) then
315        call setChild(root, "Analysis", ch1)
316      end if
317      call setChildValue(ch1, "CalculateForces", tVal)
318      call setUnprocessed(ch1)
319    end if
320
321    call getDescendant(root, "Hamiltonian/DFTB", ch1, parent=par)
322    if (associated(ch1)) then
323      call setChild(ch1, "Differentiation", ch2)
324      call setChild(ch2, "FiniteDiff", ch3)
325      call setChildValue(ch3, "Delta", 1.0e-2_dp)
326      call detailedWarning(ch2, "Adding legacy step size for finite difference&
327          & differentiation")
328    end if
329
330    call getDescendant(root, "Hamiltonian/DFTB/SpinConstants", ch1, parent=par)
331    if (associated(ch1)) then
332      call setChildValue(ch1, "ShellResolvedSpin", .true.)
333    end if
334
335  end subroutine convert_4_5
336
337  !> Converts input from version 5 to 6. (Version 6 introduced in May. 2018)
338  subroutine convert_5_6(root)
339
340    !> Root tag of the HSD-tree
341    type(fnode), pointer :: root
342
343    type(fnode), pointer :: ch1, ch2, ch3, ch4, par, par2, dummy
344    logical :: tVal, tVal2
345    real(dp) :: rTmp
346
347    call getDescendant(root, "Analysis/Localise/PipekMezey/Tollerance", ch1)
348    if (associated(ch1)) then
349      call detailedWarning(ch1, "Keyword converted to 'Tolerance'.")
350      call setNodeName(ch1, "Tolerance")
351    end if
352
353    call getDescendant(root, "Analysis/Localise/PipekMezey/SparseTollerances", ch1)
354    if (associated(ch1)) then
355      call detailedWarning(ch1, "Keyword converted to 'SparseTollerances'.")
356      call setNodeName(ch1, "SparseTolerances")
357    end if
358
359    call getDescendant(root, "Hamiltonian/DFTB/DampXH", ch1, parent=par)
360    if (associated(ch1)) then
361      call getChildValue(par, "DampXH", tVal)
362      call getDescendant(root, "Hamiltonian/DFTB/DampXHExponent", ch2)
363      if (tVal .neqv. associated(ch2)) then
364        call error("Incompatible combinaton of DampXH and DampXHExponent")
365      end if
366      if (associated(ch2)) then
367        call getChildValue(par, "DampXHExponent", rTmp)
368      end if
369      call detailedWarning(ch1, "Keyword DampXH moved to HCorrection block")
370      dummy => removeChild(par,ch1)
371      call destroyNode(ch1)
372      dummy => removeChild(par,ch2)
373      call destroyNode(ch2)
374
375      ! clean out any HCorrection entry
376      call getDescendant(root, "Hamiltonian/DFTB/HCorrection", ch2, parent=par)
377      if (associated(ch2)) then
378        call detailedError(ch2, "HCorrection already present.")
379      end if
380
381      call getDescendant(root, "Hamiltonian/DFTB", ch2, parent=par)
382      call setChild(ch2, "HCorrection", ch3)
383      call setChild(ch3, "Damping", ch4)
384      call setChildValue(ch4, "Exponent", rTmp)
385      call detailedWarning(ch3, "Adding Damping to HCorrection")
386    end if
387
388  end subroutine convert_5_6
389
390end module dftbp_oldcompat
391