New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
i.pseudo.f90 in vendors/XMLF90/current/doc/Examples/dom – NEMO

source: vendors/XMLF90/current/doc/Examples/dom/i.pseudo.f90 @ 1963

Last change on this file since 1963 was 1963, checked in by flavoni, 14 years ago

importing XMLF90 r_53 vendor

File size: 8.6 KB
Line 
1program pseudoread
2
3use m_pseudo_types
4
5! Module
6  use flib_dom
7
8type(pseudo_t), target :: pseudo
9type(grid_t)           :: global_grid
10!
11type(string)           :: s         ! to avoid memory leaks
12
13! Pointers to make it easier to manage the data
14!
15type(header_t),  pointer   :: hp
16type(vps_t),  pointer      :: pp
17
18  type(fnode), pointer          :: myDoc
19  type(fnode), pointer          :: myNode, np
20  type(fnodeList), pointer      :: myList
21
22  integer :: npseudos, i
23  character(len=200)  :: value      ! Could be larger, or made into a string
24
25! Parse
26! No constructor method - this is fortran !
27  myDoc => parsefile("pseudo.xml")  !  ,verbose=.true.)
28  print *, "Number of active nodes: ", getNumberofAllocatedNodes()
29
30!  call dumpTree(myDoc)
31  print *, "Normalizing...(can take long if big file --- not really needed)"
32  call normalize(myDoc)
33!  call dumpTree(myDoc)
34
35  print *, "Number of active nodes: ", getNumberofAllocatedNodes() 
36
37!---------------------------------------------------------- 
38
39  myList => getElementsByTagName(myDoc, "pseudo")
40  if (getLength(myList) == 0) then
41     call die("Did not found any pseudo elements...")
42  endif
43  myNode => item(myList, 0)
44
45  value = getAttribute(myNode,"version")
46  if (value == "0.5") then
47     print *, "Processing a PSEUDO version 0.5 XML file"
48     pseudo%npots = 0
49     global_grid%npts = 0
50  else
51     print *, "Can only work with PSEUDO version 0.5 XML files"
52     STOP
53  endif
54
55  global_grid%npts = 0          ! To flag absence of global grid info
56  myList => getChildNodes(myNode)
57  do i=0, getLength(myList) - 1
58     np => item(myList,i)
59     s = getNodeName(np)
60     if (s == "grid") then
61        print *, "This file has a global grid... "
62        call get_grid_data(np,global_grid)
63        exit
64     endif
65  enddo
66!
67! Header
68!
69  myList => getElementsByTagName(myDoc, "header")
70  if (getLength(myList) == 0) then
71     call die("Did not found any header elements...")
72  endif
73  myNode => item(myList, 0)
74  print *, "Processing header..."
75         hp => pseudo%header
76         
77         hp%symbol = getAttribute(myNode,"symbol")
78         if (hp%symbol == "" ) call die("Cannot determine atomic symbol")
79
80         value = getAttribute(myNode,"zval")
81         if (value == "") call die("Cannot determine zval")
82         read(unit=value,fmt=*) hp%zval
83!
84         hp%creator = getAttribute(myNode,"creator")
85         if (hp%creator == "" ) hp%creator="unknown"
86
87         hp%flavor = getAttribute(myNode,"flavor")
88         if (hp%flavor == "" ) hp%flavor="unknown"
89
90         value = getAttribute(myNode,"relativistic")
91         if (value == "") hp%relativistic = .false.
92         hp%relativistic = (value == "yes")
93
94         value = getAttribute(myNode,"polarized")
95         if (value == "") hp%polarized = .false.
96         hp%polarized = (value == "yes")
97
98         hp%core_corrections = getAttribute(myNode,"core-corrections")
99         if (hp%core_corrections == "" ) hp%core_corrections="nc"
100
101!
102!  Valence charge
103!
104  myList => getElementsByTagName(myDoc, "valence-charge")
105  if (getLength(myList) == 0) then
106     call die("Did not found the valence charge ...")
107  endif
108  np => item(myList,0)
109  if (associated(np)) then
110     print *, "Processing valence charge..."
111   !
112   !  Get the data (and possible private grid)
113   !
114     call get_radfunc_data(np,global_grid,pseudo%valence_charge)
115  endif
116
117!  Core charge
118!
119  myList => getElementsByTagName(myDoc, "pseudocore-charge")
120     np => item(myList,0)
121     if (associated(np)) then
122        print *, "Processing core charge..."
123   !
124   !  Get the data (and possible private grid)
125   !
126     call get_radfunc_data(np,global_grid,pseudo%core_charge)
127  endif
128
129!
130! Semilocal Pseudos
131!
132  myList => getElementsByTagName(myDoc, "semilocal")
133  if (getLength(myList) == 0) then
134     call die("Did not found the semilocal element...")
135  endif
136  np => item(myList, 0)
137  if (associated(np)) then
138        print *, "Processing semilocal..."
139
140         value = getAttribute(np,"npots-down")
141         if (value == "" ) call die("Cannot determine npots-down")
142         read(unit=value,fmt=*) pseudo%npots_down
143
144         value = getAttribute(np,"npots-up")
145         if (value == "" ) call die("Cannot determine npots-up")
146         read(unit=value,fmt=*) pseudo%npots_up
147
148  else
149     call die("Cannot find semilocal element")
150  endif
151
152  pseudo%npots = 0
153  myList => getElementsByTagName(np, "vps")
154  if (getLength(myList) == 0) then
155     call die("Did not found any vps elements...")
156  endif
157  npseudos = getLength(myList) 
158  do i = 0, npseudos - 1
159     print *, "Processing vps i = ", i , "---------------------"
160     myNode => item(myList, i)
161     pseudo%npots = pseudo%npots + 1
162     pp => pseudo%pot(pseudo%npots)
163
164         value = getAttribute(myNode,"l")
165         if (value == "" ) call die("Cannot determine l for Vps")
166         read(unit=value,fmt=*) pp%l
167
168         value = getAttribute(myNode,"principal-n")
169         if (value == "" ) call die("Cannot determine n for Vps")
170         read(unit=value,fmt=*) pp%n
171
172         value = getAttribute(myNode,"cutoff")
173         if (value == "" ) call die("Cannot determine cutoff for Vps")
174         read(unit=value,fmt=*) pp%cutoff
175
176         value = getAttribute(myNode,"occupation")
177         if (value == "" ) call die("Cannot determine occupation for Vps")
178         read(unit=value,fmt=*) pp%occupation
179
180         value = getAttribute(myNode,"spin")
181         if (value == "" ) call die("Cannot determine spin for Vps")
182         read(unit=value,fmt=*) pp%spin
183
184         call get_radfunc_data(myNode,global_grid,pp%V)
185
186  enddo
187
188!
189!  Show some of the information
190!
191call dump_pseudo(pseudo)
192
193CONTAINS
194
195!-----------------------------------------------------------------------
196subroutine get_radfunc_data(element,global_grid,rp)
197use m_converters, only: build_data_array
198!
199! Example of routine which packages parsing functionality for a
200! common element. The <radfunc> element can appear under <vps>,
201! <valence-charge>, and <pseudocore-charge> elements.
202! In all cases the parsing steps are exactly  the same.
203! This routine accepts a pointer to the parent element and returns
204! the data structure.
205!
206type(fnode), pointer      :: element
207type(grid_t), intent(in)     :: global_grid
208type(radfunc_t), intent(out) :: rp
209
210type(fnode), pointer      :: np, radfuncp
211type(fnodeList), pointer  :: lp
212integer                   :: ndata
213type(string)              :: pcdata, s
214
215  s = getNodeName(element)
216  print *, "Getting radfunc data from element ", char(s)
217  lp => getElementsByTagName(element, "radfunc")
218  radfuncp => item(lp,0)
219  lp => getElementsByTagName(radfuncp, "grid")
220  np => item(lp,0)
221      if (associated(np))  then
222         print *, " >> local grid found"
223         call get_grid_data(np,rp%grid)
224      else
225         print *, " >> re-using global grid"
226         rp%grid = global_grid
227      endif
228
229  lp => getElementsByTagName(radfuncp, "data")
230  np => item(lp,0)
231      if (associated(np))  then
232         if (rp%grid%npts == 0) call die("Need grid information!")
233         allocate(rp%data(rp%grid%npts))
234         ndata = 0             ! To start the build up
235         np => getFirstChild(np)
236         do
237            if (.not. associated(np)) exit
238            if (getNodeType(np) /= TEXT_NODE) exit
239            pcdata = getNodeValue(np)               ! text node
240            call build_data_array(char(pcdata),rp%data,ndata)
241            np => getNextSibling(np)
242         enddo
243         if (ndata /= size(rp%data)) STOP "npts mismatch"
244      else
245         call die("Cannot find data element")
246      endif
247end subroutine get_radfunc_data
248!-----------------------------------------------------------------------
249subroutine get_grid_data(element,grid)
250type(fnode), pointer  :: element
251type(grid_t), intent(out)       :: grid
252
253character(len=100)  :: value
254
255         grid%type = getAttribute(element,"type")
256         if (grid%type == "" ) call die("Cannot determine grid type")
257
258         value = getAttribute(element,"npts")
259         if (value == "" ) call die("Cannot determine grid npts")
260         read(unit=value,fmt=*) grid%npts
261
262         value = getAttribute(element,"scale")
263         if (value == "" ) call die("Cannot determine grid scale")
264         read(unit=value,fmt=*) grid%scale
265
266         value = getAttribute(element,"step")
267         if (value == "" ) call die("Cannot determine grid step")
268         read(unit=value,fmt=*) grid%step
269
270end subroutine get_grid_data
271
272!-----------------------------------------------------------------------
273      subroutine die(str)
274      character(len=*), intent(in), optional   :: str
275      if (present(str)) then
276         write(unit=0,fmt="(a)") trim(str)
277      endif
278      write(unit=0,fmt="(a)") "Stopping Program"
279      stop
280      end subroutine die
281
282
283end program pseudoread
Note: See TracBrowser for help on using the repository browser.