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.
pseudo_dom.f90 in vendors/XMLF90/current/doc/Examples/dom – NEMO

source: vendors/XMLF90/current/doc/Examples/dom/pseudo_dom.f90 @ 1960

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

importing XMLF90 r_53 vendor

File size: 5.2 KB
Line 
1program pseudo_dom
2!
3! Move towards DOM-like routines
4! for the pseudo schema
5! See details in m_psdom.f90
6
7use m_pseudo_types
8use m_psdom
9
10! Module
11  use flib_dom
12
13type(pseudo_t), target :: pseudo
14type(grid_t)           :: global_grid
15!
16type(string)           :: s         ! to avoid memory leaks
17
18! Pointers to make it easier to manage the data
19!
20type(header_t),  pointer   :: hp
21type(vps_t),  pointer      :: pp
22
23  type(fnode), pointer          :: myDoc
24  type(fnode), pointer          :: myNode, np
25  type(fnodeList), pointer      :: myList
26
27  integer :: npseudos, i
28  character(len=200)  :: value      ! Could be larger, or made into a string
29
30! Parse
31! No constructor method - this is fortran !
32  myDoc => parsefile("pseudo.xml")  !  ,verbose=.true.)
33  print *, "Number of active nodes: ", getNumberofAllocatedNodes()
34
35!  call dumpTree(myDoc)
36  print *, "Normalizing...(can take long if big file --- not really needed)"
37  call normalize(myDoc)
38!  call dumpTree(myDoc)
39
40  print *, "Number of active nodes: ", getNumberofAllocatedNodes() 
41
42!---------------------------------------------------------- 
43
44  myList => getElementsByTagName(myDoc, "pseudo")
45  if (getLength(myList) == 0) then
46     call die("Did not found any pseudo elements...")
47  endif
48  myNode => item(myList, 0)
49
50  value = getAttribute(myNode,"version")
51  if (value == "0.5") then
52     print *, "Processing a PSEUDO version 0.5 XML file"
53     pseudo%npots = 0
54     global_grid%npts = 0
55  else
56     print *, "Can only work with PSEUDO version 0.5 XML files"
57     STOP
58  endif
59
60  global_grid%npts = 0          ! To flag absence of global grid info
61  myList => getChildNodes(myNode)
62  do i=0, getLength(myList) - 1
63     np => item(myList,i)
64     s = getNodeName(np)
65     if (s == "grid") then
66        print *, "This file has a global grid... "
67        call getGrid(np,global_grid)
68        exit
69     endif
70  enddo
71!
72! Header
73!
74  myList => getElementsByTagName(myDoc, "header")
75  if (getLength(myList) == 0) then
76     call die("Did not found any header elements...")
77  endif
78  myNode => item(myList, 0)
79  print *, "Processing header..."
80         hp => pseudo%header
81         
82         hp%symbol = getAttribute(myNode,"symbol")
83         if (hp%symbol == "" ) call die("Cannot determine atomic symbol")
84
85         value = getAttribute(myNode,"zval")
86         if (value == "") call die("Cannot determine zval")
87         read(unit=value,fmt=*) hp%zval
88!
89         hp%creator = getAttribute(myNode,"creator")
90         if (hp%creator == "" ) hp%creator="unknown"
91
92         hp%flavor = getAttribute(myNode,"flavor")
93         if (hp%flavor == "" ) hp%flavor="unknown"
94
95         value = getAttribute(myNode,"relativistic")
96         if (value == "") hp%relativistic = .false.
97         hp%relativistic = (value == "yes")
98
99         value = getAttribute(myNode,"polarized")
100         if (value == "") hp%polarized = .false.
101         hp%polarized = (value == "yes")
102
103         hp%core_corrections = getAttribute(myNode,"core-corrections")
104         if (hp%core_corrections == "" ) hp%core_corrections="nc"
105
106!
107!  Valence charge
108!
109  myList => getElementsByTagName(myDoc, "valence-charge")
110  if (getLength(myList) == 0) then
111     call die("Did not found the valence charge ...")
112  endif
113  np => item(myList,0)
114  if (associated(np)) then
115     print *, "Processing valence charge..."
116   !
117   !  Get the data (and possible private grid)
118   !
119     call getRadialFunction(np,global_grid,pseudo%valence_charge)
120  endif
121
122!  Core charge
123!
124  myList => getElementsByTagName(myDoc, "pseudocore-charge")
125     np => item(myList,0)
126     if (associated(np)) then
127        print *, "Processing core charge..."
128   !
129   !  Get the data (and possible private grid)
130   !
131     call getRadialFunction(np,global_grid,pseudo%core_charge)
132  endif
133
134!
135! Semilocal Pseudos
136!
137  myList => getElementsByTagName(myDoc, "semilocal")
138  if (getLength(myList) == 0) then
139     call die("Did not found the semilocal element...")
140  endif
141  np => item(myList, 0)
142  if (associated(np)) then
143        print *, "Processing semilocal..."
144
145         value = getAttribute(np,"npots-down")
146         if (value == "" ) call die("Cannot determine npots-down")
147         read(unit=value,fmt=*) pseudo%npots_down
148
149         value = getAttribute(np,"npots-up")
150         if (value == "" ) call die("Cannot determine npots-up")
151         read(unit=value,fmt=*) pseudo%npots_up
152
153  else
154     call die("Cannot find semilocal element")
155  endif
156
157  pseudo%npots = 0
158  myList => getElementsByTagName(np, "vps")
159  if (getLength(myList) == 0) then
160     call die("Did not found any vps elements...")
161  endif
162  npseudos = getLength(myList) 
163  do i = 0, npseudos - 1
164     print *, "Processing vps i = ", i , "---------------------"
165     myNode => item(myList, i)
166     pseudo%npots = pseudo%npots + 1
167     pp => pseudo%pot(pseudo%npots)
168     call getVps(myNode,global_grid,pp)
169  enddo
170
171!
172!  Show some of the information
173!
174call dump_pseudo(pseudo)
175
176CONTAINS
177
178!-----------------------------------------------------------------------
179      subroutine die(str)
180      character(len=*), intent(in), optional   :: str
181      if (present(str)) then
182         write(unit=0,fmt="(a)") trim(str)
183      endif
184      write(unit=0,fmt="(a)") "Stopping Program"
185      stop
186      end subroutine die
187
188
189end program pseudo_dom
Note: See TracBrowser for help on using the repository browser.