[1967] | 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 | |
---|