« back to all changes in this revision
Viewing changes to Util/pseudo-xml/m_pseudo.f90
- browse files at revision 483.3.14
- compare with another revision
- download diff
- download tarball
- view history from revision 483.3.14
- Committer: Alberto Garcia
- Date: 2016-06-23 10:02:59 UTC
- mto: (483.11.3 4.0-xc) (560.3.1 4.1-ag)
- mto: This revision was merged to the branch mainline in revision 525.
- Revision ID: albertog@icmab.es-20160623100259-mewju7fsd2toyp1r
Tags: 4.0-release, v4.0
Release of siesta-4.0
* Update Docs/release_notes.4.0
* Update list of contributors.
* Add some more documentation and comments, and clarify notes in
output for the recet electric-field/slab-dipole-correction fix.
* Remove Util/pseudo-xml
* Other minor changes in README files
* Update Docs/release_notes.4.0
* Update list of contributors.
* Add some more documentation and comments, and clarify notes in
output for the recet electric-field/slab-dipole-correction fix.
* Remove Util/pseudo-xml
* Other minor changes in README files
- files removed:
- Docs/Changelog-from-trunk-462.txt
- Util/pseudo-xml
- files renamed:
- Docs/release_notes.4.0-beta => Docs/release_notes.4.0
- files modified:
- Docs/CHANGES
added
removed
Util/pseudo-xml/m_pseudo.f90
1
! ---
2
! Copyright (C) 1996-2016 The SIESTA group
3
! This file is distributed under the terms of the
4
! GNU General Public License: see COPYING in the top directory
5
! or http://www.gnu.org/copyleft/gpl.txt .
6
! See Docs/Contributors.txt for a list of contributors.
7
! ---
8
module m_pseudo
9
!
10
! This module reads a pseudopotential file written in XML.
11
! A full example of the building up of a data structure using
12
! the SAX paradigm.
13
!
14
use flib_sax
15
use m_pseudo_types ! Data types
16
17
private
18
19
!
20
! It defines the routines that are called from xml_parser in response
21
! to particular events.
22
!
23
public :: begin_element, end_element, pcdata_chunk
24
private :: die
25
26
logical, private :: in_vps = .false. , in_radfunc = .false.
27
logical, private :: in_semilocal = .false. , in_header = .false.
28
logical, private :: in_coreCharge = .false. , in_data = .false.
29
logical, private :: in_valenceCharge = .false.
30
logical, private :: in_pseudowavefun = .false. , in_pswf = .false.
31
32
integer, private, save :: ndata
33
34
type(pseudo_t), public, target, save :: pseudo
35
type(grid_t), private, save :: grid
36
type(grid_t), private, save :: global_grid
37
!
38
! Pointers to make it easier to manage the data
39
!
40
type(header_t), private, pointer :: hp
41
type(vps_t), private, pointer :: pp
42
type(pswf_t), private, pointer :: pw
43
type(radfunc_t), private, pointer :: rp
44
45
CONTAINS !===========================================================
46
47
!----------------------------------------------------------------------
48
subroutine begin_element(name,attributes)
49
character(len=*), intent(in) :: name
50
type(dictionary_t), intent(in) :: attributes
51
52
character(len=100) :: value
53
integer :: status
54
55
56
select case(name)
57
58
case ("pseudo")
59
pseudo%npots = 0
60
pseudo%npswfs = 0
61
global_grid%npts = 0
62
! call get_value(attributes,"version",value,status)
63
! if (value == "0.5") then
64
! print *, "Processing a PSEUDO version 0.5 XML file"
65
! pseudo%npots = 0
66
! pseudo%npswfs = 0
67
! global_grid%npts = 0
68
! else
69
! print *, "Can only work with PSEUDO version 0.5 XML files"
70
! STOP
71
! endif
72
73
case ("header")
74
in_header = .true.
75
hp => pseudo%header
76
77
call get_value(attributes,"symbol",hp%symbol,status)
78
if (status /= 0 ) call die("Cannot determine atomic symbol")
79
80
call get_value(attributes,"zval",value,status)
81
if (status /= 0 ) call die("Cannot determine zval")
82
read(unit=value,fmt=*) hp%zval
83
84
call get_value(attributes,"xc-functional-parametrization", &
85
hp%xcfunctionalparametrization,status)
86
if (status /= 0 ) &
87
call die("Cannot determine xc-functional-parametrization ")
88
89
call get_value(attributes,"creator",hp%creator,status)
90
if (status /= 0 ) hp%creator="unknown"
91
92
call get_value(attributes,"date",hp%date,status)
93
if (status /= 0 ) hp%date="unknown"
94
95
call get_value(attributes,"flavor",hp%flavor,status)
96
if (status /= 0 ) hp%flavor="unknown"
97
98
call get_value(attributes,"relativistic",value,status)
99
if (status /= 0 ) value = "no"
100
hp%relativistic = (value == "yes")
101
102
call get_value(attributes,"polarized",value,status)
103
if (status /= 0 ) value = "no"
104
hp%polarized = (value == "yes")
105
106
call get_value(attributes,"core-corrections", &
107
hp%core_corrections,status)
108
if (status /= 0 ) hp%core_corrections = "nc"
109
110
case ("vps")
111
in_vps = .true.
112
113
pseudo%npots = pseudo%npots + 1
114
pp => pseudo%pot(pseudo%npots)
115
rp => pp%V ! Pointer to radial function
116
117
call get_value(attributes,"l",pp%l,status)
118
if (status /= 0 ) call die("Cannot determine l for Vps")
119
120
call get_value(attributes,"principal-n",value,status)
121
if (status /= 0 ) call die("Cannot determine n for Vps")
122
read(unit=value,fmt=*) pp%n
123
124
call get_value(attributes,"cutoff",value,status)
125
if (status /= 0 ) call die("Cannot determine cutoff for Vps")
126
read(unit=value,fmt=*) pp%cutoff
127
128
call get_value(attributes,"occupation",value,status)
129
if (status /= 0 ) call die("Cannot determine occupation for Vps")
130
read(unit=value,fmt=*) pp%occupation
131
132
call get_value(attributes,"spin",value,status)
133
if (status /= 0 ) call die("Cannot determine spin for Vps")
134
read(unit=value,fmt=*) pp%spin
135
136
case ("grid")
137
138
call get_value(attributes,"type",grid%type,status)
139
if (status /= 0 ) call die("Cannot determine grid type")
140
141
call get_value(attributes,"npts",value,status)
142
if (status /= 0 ) call die("Cannot determine grid npts")
143
read(unit=value,fmt=*) grid%npts
144
145
call get_value(attributes,"scale",value,status)
146
if (status /= 0 ) call die("Cannot determine grid scale")
147
read(unit=value,fmt=*) grid%scale
148
149
call get_value(attributes,"step",value,status)
150
if (status /= 0 ) call die("Cannot determine grid step")
151
read(unit=value,fmt=*) grid%step
152
153
!
154
! In this way we allow for a private grid for each radfunc,
155
! or for a global grid specification
156
!
157
if (in_radfunc) then
158
rp%grid = grid
159
else
160
global_grid = grid
161
endif
162
163
case ("data")
164
in_data = .true.
165
if (rp%grid%npts == 0) STOP "Grid not specified correctly"
166
allocate(rp%data(rp%grid%npts))
167
ndata = 0 ! To start the build up
168
169
case ("radfunc")
170
in_radfunc = .true.
171
rp%grid = global_grid ! Might be empty
172
! There should then be a local grid element
173
! read later
174
175
case ("pseudocore-charge")
176
in_coreCharge = .true.
177
rp => pseudo%core_charge
178
179
case ("valence-charge")
180
in_valenceCharge = .true.
181
rp => pseudo%valence_charge
182
183
case ("semilocal")
184
in_semilocal = .true.
185
186
call get_value(attributes,"npots-down",value,status)
187
if (status /= 0 ) call die("Cannot determine npots-down")
188
read(unit=value,fmt=*) pseudo%npots_down
189
190
call get_value(attributes,"npots-up",value,status)
191
if (status /= 0 ) call die("Cannot determine npots-up")
192
read(unit=value,fmt=*) pseudo%npots_up
193
194
case ("pseudowave-functions")
195
in_pseudowavefun = .true.
196
197
case ("pswf")
198
in_pswf = .true.
199
200
pseudo%npswfs = pseudo%npswfs + 1
201
202
pw => pseudo%pswf(pseudo%npswfs)
203
rp => pw%V ! Pointer to radial function
204
205
call get_value(attributes,"l",pw%l,status)
206
if (status /= 0 ) call die("Cannot determine l for Vps")
207
208
call get_value(attributes,"principal-n",value,status)
209
if (status /= 0 ) call die("Cannot determine n for Vps")
210
read(unit=value,fmt=*) pw%n
211
212
call get_value(attributes,"spin",value,status)
213
if (status /= 0 ) call die("Cannot determine spin for Vps")
214
read(unit=value,fmt=*) pw%spin
215
216
end select
217
218
end subroutine begin_element
219
!----------------------------------------------------------------------
220
221
subroutine end_element(name)
222
character(len=*), intent(in) :: name
223
224
select case(name)
225
226
case ("vps")
227
in_vps = .false.
228
229
case ("radfunc")
230
in_radfunc = .false.
231
232
case ("data")
233
!
234
! We are done filling up the radfunc data
235
! Check that we got the advertised number of items
236
!
237
in_data = .false.
238
if (ndata /= size(rp%data)) STOP "npts mismatch"
239
240
case ("pseudocore-charge")
241
in_coreCharge = .false.
242
243
case ("valence-charge")
244
in_valenceCharge = .false.
245
246
case ("semilocal")
247
in_semilocal = .false.
248
249
case ("pseudowave-functions")
250
in_pseudowavefun = .false.
251
252
case ("pswf")
253
in_pswf = .false.
254
255
case ("pseudo")
256
! call dump_pseudo(pseudo)
257
258
end select
259
260
end subroutine end_element
261
!----------------------------------------------------------------------
262
263
subroutine pcdata_chunk(chunk)
264
character(len=*), intent(in) :: chunk
265
266
267
if (len_trim(chunk) == 0) RETURN ! skip empty chunk
268
269
if (in_data) then
270
!
271
! Note that we know where we need to put it through the pointer rp...
272
!
273
call build_data_array(chunk,rp%data,ndata)
274
275
else if (in_header) then
276
!
277
! There should not be any pcdata in header in this version...
278
279
print *, "Header data:"
280
print *, trim(chunk)
281
282
endif
283
284
end subroutine pcdata_chunk
285
!----------------------------------------------------------------------
286
287
subroutine die(str)
288
character(len=*), intent(in), optional :: str
289
if (present(str)) then
290
write(unit=0,fmt="(a)") trim(str)
291
endif
292
write(unit=0,fmt="(a)") "Stopping Program"
293
stop
294
end subroutine die
295
296
297
end module m_pseudo
298
299
300
301
302
303
304
305
306
307
308
309
Loggerhead is a web-based interface for Breezy
Version: 2.0.1