1module m_wcml_coma
2  ! Implements routines relating to the (currently unfinished)
3  ! CML Condensed Matter schema
4
5  use flib_wxml, only: xmlf_t
6  use flib_wxml, only: xml_NewElement, xml_AddAttribute
7  use flib_wxml, only: xml_EndElement
8  use flib_wstml, only: stmAddArray
9  use m_wxml_error
10
11  Implicit None
12
13  Private
14
15  integer, private, parameter ::  sp = selected_real_kind(6,30)
16  integer, private, parameter ::  dp = selected_real_kind(14,100)
17
18  public :: cmlAddBand
19  public :: cmlAddKpoint
20  public :: cmlStartBandList
21  public :: cmlEndBandList
22
23Contains
24
25  subroutine cmlAddKPoint(xf, coords, weight, kptfmt, wtfmt &
26       ,dictRef,convention,title,id,ref,label)
27    type(xmlf_t), intent(inout)             :: xf
28    real(kind=dp), dimension(3), intent(in) :: coords
29    real(kind=dp), intent(in), optional     :: weight
30    character(len=*), intent(in), optional   :: kptfmt
31    character(len=*), intent(in), optional   :: wtfmt
32    character(len=*), intent(in), optional :: dictRef
33    character(len=*), intent(in), optional :: convention
34    character(len=*), intent(in), optional :: title
35    character(len=*), intent(in), optional :: id
36    character(len=*), intent(in), optional :: ref
37    character(len=*), intent(in), optional :: label
38    call cmlStartKpoint(xf, coords, weight, kptfmt, wtfmt &
39         ,dictRef,convention,title,id,ref,label)
40    call cmlEndKpoint(xf)
41  end subroutine cmlAddKPoint
42
43  subroutine cmlStartKPoint(xf, coords, weight, kptfmt, wtfmt &
44       ,dictRef,convention,title,id,ref,label)
45    type(xmlf_t), intent(inout)              :: xf
46    real(kind=dp), dimension(3), intent(in)  :: coords
47    real(kind=dp), intent(in), optional      :: weight
48    character(len=*), intent(in), optional   :: kptfmt
49    character(len=*), intent(in), optional   :: wtfmt
50    character(len=*), intent(in), optional :: dictRef
51    character(len=*), intent(in), optional :: convention
52    character(len=*), intent(in), optional :: title
53    character(len=*), intent(in), optional :: id
54    character(len=*), intent(in), optional :: ref
55    character(len=*), intent(in), optional :: label
56
57    character(len=60) :: aux_str
58
59    call xml_NewElement(xf, "kpoint")
60    if (present(dictRef)) call xml_addAttribute(xf, "dictRef", dictRef)
61    if (present(convention)) call xml_addAttribute(xf, "convention", convention)
62    if (present(title)) call xml_addAttribute(xf, "title", title)
63    if (present(id)) call xml_addAttribute(xf, "id", id)
64    if (present(ref)) call xml_addAttribute(xf, "ref", ref)
65    if (present(label)) call xml_addAttribute(xf, "label", label)
66
67    if (present(kptfmt)) then
68       write(aux_str,fmt=kptfmt) coords
69    else
70       write(aux_str,fmt="(3f12.8)") coords
71    endif
72    call xml_AddAttribute(xf, "coords", trim(aux_str))
73
74
75    if (present(weight)) then
76       if (present(wtfmt)) then
77          write(aux_str,fmt=wtfmt) weight
78       else
79          write(aux_str,fmt="(f12.8)") weight
80       endif
81
82       call xml_AddAttribute(xf, "weight", trim(aux_str))
83    endif
84
85  end subroutine cmlStartKPoint
86
87  subroutine cmlEndKpoint(xf)
88    type(xmlf_t), intent(inout) :: xf
89    call xml_EndElement(xf, "kpoint")
90  end subroutine cmlEndKpoint
91
92  subroutine cmlAddBand(xf, kpoint, kweight, bands, kptfmt, eigfmt)
93
94    implicit none
95    type(xmlf_t), intent(inout)            :: xf
96    real(dp), intent(in) :: kpoint(3)
97    real(dp), intent(in) :: kweight
98    real(dp), intent(in) :: bands(:)
99    character(len=*), intent(in), optional :: kptfmt
100    character(len=*), intent(in), optional :: eigfmt
101
102    integer :: i, n
103    character(len=20) :: k_fmt
104    character(len=20) :: kp_c(3)
105
106    if (present(kptfmt)) then
107      if (len_trim(kptfmt) > 20) stop 'k-point format too long'
108      k_fmt=kptfmt
109    else
110      k_fmt='(f10.7)'
111    endif
112
113    n = size(bands)
114
115    do i = 1, 3
116      write(kp_c(i), k_fmt, err=100) kpoint(i)
117    enddo
118
119    call xml_NewElement(xf, 'band')
120    call xml_AddAttribute(xf, 'kpoint', trim(kp_c(1))//' '//trim(kp_c(2))//' '//trim(kp_c(3)))
121    call xml_AddAttribute(xf, 'weight', kweight)
122    call stmAddArray(xf, array=bands, nvalue=n, fmt=eigfmt)
123    call xml_EndElement(xf, 'band')
124
125    return
126
127100 call wxml_fatal('internal write failed in cmlAddBand')
128  end subroutine cmlAddBand
129
130
131  subroutine cmlStartBandList(xf, id, title, conv, dictref, ref, role)
132
133    implicit none
134    type(xmlf_t), intent(inout) :: xf
135    character(len=*), intent(in), optional :: id
136    character(len=*), intent(in), optional :: title
137    character(len=*), intent(in), optional :: conv
138    character(len=*), intent(in), optional :: dictref
139    character(len=*), intent(in), optional :: ref
140    character(len=*), intent(in), optional :: role
141
142    call xml_NewElement(xf, 'bandList')
143    if (present(id)) call xml_AddAttribute(xf, 'id', id)
144    if (present(title)) call xml_AddAttribute(xf, 'title', title)
145    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
146    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
147    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
148    if (present(role)) call xml_AddAttribute(xf, 'role', role)
149
150  end subroutine cmlStartBandList
151
152
153  subroutine cmlEndBandList(xf)
154
155    implicit none
156    type(xmlf_t), intent(inout) :: xf
157
158    Call xml_EndElement(xf, 'bandList')
159
160  end subroutine cmlEndBandList
161
162
163end module m_wcml_coma
164