1 | module m_psdom |
---|
2 | |
---|
3 | use m_pseudo_types |
---|
4 | use flib_dom |
---|
5 | |
---|
6 | private |
---|
7 | |
---|
8 | public :: getVps |
---|
9 | public :: getRadialFunction |
---|
10 | public :: getGrid |
---|
11 | |
---|
12 | CONTAINS |
---|
13 | |
---|
14 | subroutine getVps(np,global_grid,pp) |
---|
15 | type(fnode), pointer :: np |
---|
16 | type(vps_t), intent(inout) :: pp |
---|
17 | type(grid_t), intent(in) :: global_grid |
---|
18 | |
---|
19 | character(len=200) :: value |
---|
20 | |
---|
21 | value = getAttribute(np,"l") |
---|
22 | if (value == "" ) call die("Cannot determine l for Vps") |
---|
23 | read(unit=value,fmt=*) pp%l |
---|
24 | |
---|
25 | value = getAttribute(np,"principal-n") |
---|
26 | if (value == "" ) call die("Cannot determine n for Vps") |
---|
27 | read(unit=value,fmt=*) pp%n |
---|
28 | |
---|
29 | value = getAttribute(np,"cutoff") |
---|
30 | if (value == "" ) call die("Cannot determine cutoff for Vps") |
---|
31 | read(unit=value,fmt=*) pp%cutoff |
---|
32 | |
---|
33 | value = getAttribute(np,"occupation") |
---|
34 | if (value == "" ) call die("Cannot determine occupation for Vps") |
---|
35 | read(unit=value,fmt=*) pp%occupation |
---|
36 | |
---|
37 | value = getAttribute(np,"spin") |
---|
38 | if (value == "" ) call die("Cannot determine spin for Vps") |
---|
39 | read(unit=value,fmt=*) pp%spin |
---|
40 | |
---|
41 | call getRadialFunction(np,global_grid,pp%V) |
---|
42 | |
---|
43 | end subroutine getVps |
---|
44 | |
---|
45 | !----------------------------------------------------------------------- |
---|
46 | subroutine getRadialFunction(element,global_grid,rp) |
---|
47 | use m_converters, only: build_data_array |
---|
48 | ! |
---|
49 | ! Example of routine which packages parsing functionality for a |
---|
50 | ! common element. The <radfunc> element can appear under <vps>, |
---|
51 | ! <valence-charge>, and <pseudocore-charge> elements. |
---|
52 | ! In all cases the parsing steps are exactly the same. |
---|
53 | ! This routine accepts a pointer to the parent element and returns |
---|
54 | ! the data structure. |
---|
55 | ! |
---|
56 | type(fnode), pointer :: element |
---|
57 | type(grid_t), intent(in) :: global_grid |
---|
58 | type(radfunc_t), intent(out) :: rp |
---|
59 | |
---|
60 | type(fnode), pointer :: np, radfuncp |
---|
61 | type(fnodeList), pointer :: lp |
---|
62 | integer :: ndata |
---|
63 | type(string) :: pcdata, s |
---|
64 | |
---|
65 | s = getNodeName(element) |
---|
66 | print *, "Getting radfunc data from element ", char(s) |
---|
67 | lp => getElementsByTagName(element, "radfunc") |
---|
68 | radfuncp => item(lp,0) |
---|
69 | lp => getElementsByTagName(radfuncp, "grid") |
---|
70 | np => item(lp,0) |
---|
71 | if (associated(np)) then |
---|
72 | print *, " >> local grid found" |
---|
73 | call getGrid(np,rp%grid) |
---|
74 | else |
---|
75 | print *, " >> re-using global grid" |
---|
76 | rp%grid = global_grid |
---|
77 | endif |
---|
78 | |
---|
79 | lp => getElementsByTagName(radfuncp, "data") |
---|
80 | np => item(lp,0) |
---|
81 | if (associated(np)) then |
---|
82 | if (rp%grid%npts == 0) call die("Need grid information!") |
---|
83 | allocate(rp%data(rp%grid%npts)) |
---|
84 | ndata = 0 ! To start the build up |
---|
85 | np => getFirstChild(np) |
---|
86 | do |
---|
87 | if (.not. associated(np)) exit |
---|
88 | if (getNodeType(np) /= TEXT_NODE) exit |
---|
89 | pcdata = getNodeValue(np) ! text node |
---|
90 | call build_data_array(char(pcdata),rp%data,ndata) |
---|
91 | np => getNextSibling(np) |
---|
92 | enddo |
---|
93 | if (ndata /= size(rp%data)) STOP "npts mismatch" |
---|
94 | else |
---|
95 | call die("Cannot find data element") |
---|
96 | endif |
---|
97 | end subroutine getRadialFunction |
---|
98 | |
---|
99 | !----------------------------------------------------------------------- |
---|
100 | subroutine getGrid(element,grid) |
---|
101 | type(fnode), pointer :: element |
---|
102 | type(grid_t), intent(out) :: grid |
---|
103 | |
---|
104 | character(len=200) :: value |
---|
105 | |
---|
106 | grid%type = getAttribute(element,"type") |
---|
107 | if (grid%type == "" ) call die("Cannot determine grid type") |
---|
108 | |
---|
109 | value = getAttribute(element,"npts") |
---|
110 | if (value == "" ) call die("Cannot determine grid npts") |
---|
111 | read(unit=value,fmt=*) grid%npts |
---|
112 | |
---|
113 | value = getAttribute(element,"scale") |
---|
114 | if (value == "" ) call die("Cannot determine grid scale") |
---|
115 | read(unit=value,fmt=*) grid%scale |
---|
116 | |
---|
117 | value = getAttribute(element,"step") |
---|
118 | if (value == "" ) call die("Cannot determine grid step") |
---|
119 | read(unit=value,fmt=*) grid%step |
---|
120 | |
---|
121 | end subroutine getGrid |
---|
122 | |
---|
123 | !----------------------------------------------------------------------- |
---|
124 | subroutine die(str) |
---|
125 | character(len=*), intent(in), optional :: str |
---|
126 | if (present(str)) then |
---|
127 | write(unit=0,fmt="(a)") trim(str) |
---|
128 | endif |
---|
129 | write(unit=0,fmt="(a)") "Stopping Program" |
---|
130 | stop |
---|
131 | end subroutine die |
---|
132 | |
---|
133 | |
---|
134 | end module m_psdom |
---|
135 | |
---|