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