Commit 8880aa02 authored by Daniel Wortmann's avatar Daniel Wortmann

Made fleur compile and link

parent ef0ca40a
cmake_minimum_required(VERSION 3.0)
project(FLEUR LANGUAGES Fortran)
set(FLEURINPUT_COMPILEOPTS "-r8")
add_library(fleurinput STATIC
types_coreSpecInput.f90 types_hybrid.f90 types_noco.f90 types_vacuum.f90 fleurinput_read_xml.f90
types_banddos.f90 types_fleurinput_base.f90 types_input.f90 types_oneD.f90 types_wannier.f90
types_cell.f90 types_kpts.f90 types_fleurinput.f90 types_sliceplot.f90 types_sym.f90
types_atoms.F90 types_econfig.F90 types_field.F90 types_xcpot.F90 types_enparaXML.f90 types_forcetheo_data.f90
types_xml.f90 calculator.f constants.f90 mpi_bc_tool.F90
types_xml.f90 calculator.f constants.f90 mpi_bc_tool.F90 ../io/xml/inputSchema.h ../io/xml/dropInputSchema.c ../io/xml/xmlInterfaceWrapper.c
)
#Set module directories
include_directories("${CMAKE_CURRENT_BINARY_DIR}/modules/fleurinput")
if (DEFINED FLEURINPUT_COMPILEOPTS )
target_compile_options(fleurinput PRIVATE ${FLEURINPUT_COMPILEOPTS})
endif()
target_link_libraries(fleurinput juDFT)
set_target_properties(fleurinput PROPERTIES Fortran_MODULE_DIRECTORY modules/fleurinput)
......@@ -206,7 +206,7 @@ MODULE m_types_atoms
SUBROUTINE read_xml_atoms(this,xml)
USE m_types_xml
IMPLICIT NONE
CLASS(t_atoms),INTENT(OUT):: this
CLASS(t_atoms),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200):: xpaths,xpathg,xpath,valueString,lstring,nstring,core,valence
......@@ -301,8 +301,8 @@ MODULE m_types_atoms
END IF
lString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@l')
nString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/@n')
CALL getIntegerSequenceFromString(TRIM(ADJUSTL(lString)), lNumbers, lNumCount)
CALL getIntegerSequenceFromString(TRIM(ADJUSTL(nString)), nNumbers, nNumCount)
CALL xml%getIntegerSequenceFromString(TRIM(ADJUSTL(lString)), lNumbers, lNumCount)
CALL xml%getIntegerSequenceFromString(TRIM(ADJUSTL(nString)), nNumbers, nNumCount)
IF(lNumCount.NE.nNumCount) THEN
CALL judft_error('Error in LO input: l quantum number count does not equal n quantum number count')
END IF
......
......@@ -34,7 +34,7 @@ MODULE m_types_banddos
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_banddos),INTENT(OUT)::this
CLASS(t_banddos),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml
INTEGER::numberNodes
......
......@@ -114,7 +114,7 @@ CONTAINS
SUBROUTINE read_xml_cell(this,xml)
use m_types_xml
class(t_cell),intent(out)::this
class(t_cell),intent(INout)::this
type(t_xml),intent(in) ::xml
! Read in lattice parameters
......
......@@ -32,7 +32,7 @@ MODULE m_types_coreSpecInput
CONTAINS
SUBROUTINE read_xml_corespecinput(This,xml)
USE m_types_xml
CLASS(t_coreSpecInput),INTENT(OUT)::this
CLASS(t_coreSpecInput),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml
......
......@@ -26,7 +26,7 @@ CONTAINS
SUBROUTINE read_xml_enpara(this,xml)
use m_types_xml
CLASS(t_enparaXML),INTENT(OUT):: this
CLASS(t_enparaXML),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
LOGICAL :: l_enpara,film
......
......@@ -20,7 +20,7 @@ MODULE m_types_fleurinput_base
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_fleurinput_base),INTENT(OUT):: this
CLASS(t_fleurinput_base),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
END SUBROUTINE read_xml
SUBROUTINE mpi_bc(this,mpi_comm,irank)
......
......@@ -38,7 +38,7 @@ MODULE m_types_forcetheo_data
CONTAINS
SUBROUTINE read_xml_forcetheo_data(this,xml)
USE m_types_xml
CLASS(t_forcetheo_data),INTENT(OUT):: this
CLASS(t_forcetheo_data),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200)::str
......
......@@ -56,7 +56,7 @@ MODULE m_types_hybrid
CONTAINS
SUBROUTINE read_xml_hybrid(this,xml)
USE m_types_xml
CLASS(t_hybrid),INTENT(out):: this
CLASS(t_hybrid),INTENT(INout):: this
TYPE(t_xml),INTENT(in) :: xml
......
......@@ -154,7 +154,7 @@ CONTAINS
SUBROUTINE read_xml_input(this,xml)
USE m_types_xml
use m_constants
CLASS(t_input),INTENT(out):: this
CLASS(t_input),INTENT(inout):: this
TYPE(t_xml),intent(in) :: xml
CHARACTER(len=100):: valueString,xpathA,xpathB
......
......@@ -42,7 +42,7 @@ CONTAINS
SUBROUTINE read_xml_kpts(this,xml)
USE m_types_xml
USE m_calculator
CLASS(t_kpts),INTENT(out):: this
CLASS(t_kpts),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=10) ::name !TODO
......@@ -54,11 +54,11 @@ CONTAINS
number_sets = xml%GetNumberOfNodes('/fleurInput/calculationSetup/bzIntegration/kPointList')
DO n=1,number_sets
DO n=number_sets,1,-1
WRITE(path,"(a,i0,a)") '/fleurInput/calculationSetup/bzIntegration/kPointList[',n,']'
IF(TRIM(ADJUSTL(name))==xml%GetAttributeValue(TRIM(path)//'/@name')) EXIT
enddo
IF (n>number_sets) CALL judft_error(("No kpoints named:"//TRIM(name)//" found"))
IF (n==0) CALL judft_error(("No kpoints named:"//TRIM(name)//" found"))
this%nkpt=evaluateFirstOnly(xml%GetAttributeValue(TRIM(path)//'/@count'))
this%numSpecialPoints=xml%GetNumberOfNodes(TRIM(path)//"specialPoint")
......
......@@ -38,7 +38,7 @@ MODULE m_types_noco
CONTAINS
SUBROUTINE read_xml_noco(this,xml)
USE m_types_xml
CLASS(t_noco),INTENT(out):: this
CLASS(t_noco),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
INTEGER:: numberNodes,ntype,itype
......
......@@ -79,11 +79,11 @@ MODULE m_types_oneD
contains
procedure :: read_xml=>read_xml_oneD
END TYPE t_oneD
PUBLIC::t_oneD
PUBLIC::t_oneD,od_dim,od_inp,od_gga,od_lda,od_sym
CONTAINS
SUBROUTINE read_xml_oneD(this,xml)
use m_types_xml
class(t_oned),intent(out)::this
class(t_oned),intent(inout)::this
type(t_xml),intent(in) ::xml
......
......@@ -25,7 +25,7 @@ MODULE m_types_sliceplot
CONTAINS
SUBROUTINE read_xml_sliceplot(this,xml)
USE m_types_xml
CLASS(t_sliceplot),INTENT(OUT)::this
CLASS(t_sliceplot),INTENT(inOUT)::this
TYPE(t_xml),INTENT(IN)::xml
CHARACTER(len=200)::xpatha
......
......@@ -49,7 +49,7 @@ MODULE m_types_sym
PROCEDURE :: init
PROCEDURE :: print_xml
PROCEDURE :: closure
PROCEDURE :: read_xml
PROCEDURE :: read_xml=>read_xml_sym
PROCEDURE :: mpi_bc => mpi_bc_sym
PROCEDURE,PRIVATE :: check_close
END TYPE t_sym
......@@ -87,10 +87,10 @@ CONTAINS
end subroutine mpi_bc_sym
SUBROUTINE read_xml(this,xml)
SUBROUTINE read_xml_sym(this,xml)
USE m_types_xml
USE m_calculator
CLASS(t_sym),INTENT(out):: this
CLASS(t_sym),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
INTEGER:: number_sets,n
......@@ -110,7 +110,7 @@ CONTAINS
str=xml%GetAttributeValue(TRIM(path)//'/row-3')
READ(str,*) this%mrot(3,:,n),this%tau(3,n)
ENDDO
END SUBROUTINE read_xml
END SUBROUTINE read_xml_sym
SUBROUTINE print_xml(sym,fh,filename)
......@@ -139,7 +139,7 @@ CONTAINS
SUBROUTINE init(sym,cell,film)
!Generates missing symmetry info.
!tau,mrot and nop have to be specified already
!tau,mrot and nop have to be specified alread
!USE m_dwigner
USE m_types_cell
CLASS(t_sym),INTENT(INOUT):: sym
......
......@@ -35,7 +35,7 @@ MODULE m_types_vacuum
CONTAINS
SUBROUTINE read_xml(this,xml)
USE m_types_xml
CLASS(t_vacuum),INTENT(OUT)::this
CLASS(t_vacuum),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml
CHARACTER(len=100)::xpatha
......
......@@ -137,7 +137,7 @@ MODULE m_types_wannier
CONTAINS
SUBROUTINE read_xml_wannier(this,xml)
USE m_types_xml
CLASS(t_wann),INTENT(out):: this
CLASS(t_wann),INTENT(inout):: this
TYPE(t_xml),INTENT(in) :: xml
! Read in optional Wannier functions parameters
......
......@@ -57,6 +57,8 @@ MODULE m_types_xcpot
PROCEDURE :: get_exchange_weight => xcpot_get_exchange_weight
PROCEDURE :: get_vxc => xcpot_get_vxc
PROCEDURE :: get_exc => xcpot_get_exc
PROCEDURE,NOPASS :: alloc_gradients => xcpot_alloc_gradients
END TYPE t_xcpot
CONTAINS
......@@ -201,4 +203,4 @@ MODULE m_types_xcpot
ALLOCATE(grad%gggrd(ngrid),grad%grgru(ngrid),grad%grgrd(ngrid))
END SUBROUTINE xcpot_alloc_gradients
END MODULE m_types_xcpot
End MODULE m_types_xcpot
......@@ -23,6 +23,7 @@ MODULE m_types_xml
PROCEDURE,NOPASS :: GetNumberOfNodes
PROCEDURE,NOPASS :: SetAttributeValue
PROCEDURE,NOPASS :: GetAttributeValue
PROCEDURE,NOPASS :: getIntegerSequenceFromString
PROCEDURE :: read_q_list
PROCEDURE,NOPASS :: popFirstStringToken
PROCEDURE,NOPASS :: countStringTokens
......@@ -34,7 +35,8 @@ MODULE m_types_xml
PROCEDURE :: get_ntype
PROCEDURE :: posPath
END TYPE t_xml
PUBLIC t_xml,evaluateFirstOnly,EvaluateFirst,evaluateFirstBool,evaluateFirstBoolOnly,evaluateFirstInt,evaluateFirstIntOnly
PUBLIC t_xml,evaluateFirstOnly,EvaluateFirst,evaluateFirstBool,evaluateFirstBoolOnly,evaluateFirstInt,evaluateFirstIntOnly,&
evaluateList
CONTAINS
SUBROUTINE init(xml)
......@@ -61,11 +63,11 @@ CONTAINS
schemaFilename = "FleurInputSchema.xsd"//C_NULL_CHAR
docFilename = "inp.xml"//C_NULL_CHAR
CALL xmlInitInterface()
CALL xmlParseSchema(schemaFilename)
CALL xmlParseDoc(docFilename)
CALL xmlValidateDoc()
CALL xmlInitXPath()
CALL InitInterface()
CALL ParseSchema(schemaFilename)
CALL ParseDoc(docFilename)
CALL ValidateDoc()
CALL InitXPath()
! Check version of inp.xml
versionString = xml%GetAttributeValue('/fleurInput/@fleurInputVersion')
......@@ -75,7 +77,7 @@ CONTAINS
! Read in constants
xPathA = '/fleurInput/constants/constant'
numberNodes = xmlGetNumberOfNodes(xPathA)
numberNodes = xml%GetNumberOfNodes(xPathA)
DO i = 1, numberNodes
WRITE(xPathB,*) TRIM(ADJUSTL(xPathA)), '[',i,']'
tempReal = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathB))//'/@value'))
......@@ -204,6 +206,99 @@ CONTAINS
END FUNCTION popFirstStringToken
SUBROUTINE getIntegerSequenceFromString(string, sequence, count)
IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: string
INTEGER, ALLOCATABLE, INTENT(OUT) :: sequence(:)
INTEGER, INTENT(OUT) :: count
INTEGER :: i, length, start, lastNumber, currentNumber, index
LOGICAL singleNumber, comma, dash
! 3 cases: 1. a single number
! 2. number - number
! 3. comma separated numbers
length = LEN(string)
count = 0
start = 1
singleNumber = .TRUE.
comma = .FALSE.
dash = .FALSE.
lastNumber = 0
count = 0
! 1. Determine number count
DO i = 1, length
SELECT CASE (string(i:i))
CASE ('0':'9')
CASE (',')
IF ((start.EQ.i).OR.(dash)) THEN
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END IF
singleNumber = .FALSE.
comma = .TRUE.
READ(string(start:i-1),*) lastNumber
count = count + 1
start = i+1
CASE ('-')
IF ((start.EQ.i).OR.(dash).OR.(comma)) THEN
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END IF
singleNumber = .FALSE.
dash = .TRUE.
READ(string(start:i-1),*) lastNumber
start = i+1
CASE DEFAULT
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END SELECT
END DO
IF(start.GT.length) THEN
STOP 'String has wrong syntax (in getIntegerSequenceFromString)'
END IF
READ(string(start:length),*) currentNumber
IF (dash) THEN
count = currentNumber - lastNumber + 1
ELSE
count = count + 1
END IF
IF (ALLOCATED(sequence)) THEN
DEALLOCATE(sequence)
END IF
ALLOCATE(sequence(count))
! 2. Read in numbers iff comma separation ...and store numbers in any case
IF (singleNumber) THEN
sequence(1) = currentNumber
ELSE IF (dash) THEN
DO i = 1, count
sequence(i) = lastNumber + i - 1
END DO
ELSE
index = 1
start = 1
DO i = 1, length
SELECT CASE (string(i:i))
CASE (',')
comma = .TRUE.
READ(string(start:i-1),*) lastNumber
start = i+1
sequence(index) = lastNumber
index = index + 1
END SELECT
END DO
sequence(index) = currentNumber
END IF
END SUBROUTINE getIntegerSequenceFromString
FUNCTION countStringTokens(line) RESULT(tokenCount)
IMPLICIT NONE
......
......@@ -20,7 +20,7 @@ CONTAINS
USE m_types_atoms
USE m_radsra
USE m_differ
!Use m_xmlOutput
Use m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
......@@ -38,7 +38,7 @@ CONTAINS
USE m_types_atoms
USE m_radsra
USE m_differ
!USE m_xmlOutput
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
......@@ -155,7 +155,7 @@ CONTAINS
USE m_types_atoms
USE m_radsra
USE m_differ
!USE m_xmlOutput
USE m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
......
......@@ -54,7 +54,7 @@ CONTAINS
!The total nucleii charge
zc=SUM(atoms%neq(:)*atoms%zatom(:))
zc = zc + 2*input%sigma
!zc = zc + 2*input%sigma !TODO : reactivate fields
IF (fixtotal) THEN
!-roa
......
......@@ -74,7 +74,7 @@ SUBROUTINE exchange_valence_hf(nk,kpts,nkpt_EIBZ,sym,atoms,hybrid,cell,dimension
#endif
USE m_io_hybrid
USE m_kp_perturbation
use m_juDFT
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
......@@ -519,7 +519,7 @@ SUBROUTINE calc_divergence(cell,kpts,divergence)
USE m_util, ONLY: cerf
USE m_types
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_cell), INTENT(IN) :: cell
......
......@@ -10,7 +10,7 @@
! M.Betzinger (09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_symm_hf
use m_juDFT
#define irreps .false.
CONTAINS
......@@ -19,7 +19,7 @@ SUBROUTINE symm_hf_init(sym,kpts,nk,nsymop,rrot,psym)
USE m_types
USE m_util ,ONLY: modulo1
USE m_juDFT
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
......
......@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE m_trafo
use m_judft
CONTAINS
SUBROUTINE waveftrafo_symm(cmt_out,z_out,cmt,l_real,z_r,z_c,bandi,ndb,&
......
......@@ -36,7 +36,8 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
USE m_nocoInputCheck
USE m_types_forcetheo_extended
USE m_relaxio
USE m_prpqfftmap
IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi
......@@ -357,7 +358,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
! Dimensioning of stars
IF (input%film.OR.(sym%namgrp.ne.'any ')) THEN
IF (input%film) THEN
CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2,oneD%odd)
......@@ -492,7 +493,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
! Generate stars
CALL timestart("strgn")
IF (input%film.OR.(sym%namgrp.NE.'any ')) THEN
IF (input%film) THEN
CALL strgn1(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
IF (oneD%odd%d1) THEN
CALL od_strgn1(xcpot,cell,sym,oneD)
......
......@@ -35,7 +35,7 @@ MODULE m_cdnpot_io_common
l_same = .TRUE.
IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
!IF(ABS(stars%gmaxInit-refStars%gmaxInit).GT.1e-10) l_same = .FALSE.
IF(stars%ng3.NE.refStars%ng3) l_same = .FALSE.
IF(stars%ng2.NE.refStars%ng2) l_same = .FALSE.
IF(stars%mx1.NE.refStars%mx1) l_same = .FALSE.
......
......@@ -149,7 +149,7 @@ SUBROUTINE w_inpXML(&
! <cutoffs Kmax="3.60000" Gmax="11.000000" GmaxXC="9.200000" numbands="0"/>
110 FORMAT(' <cutoffs Kmax="',f0.8,'" Gmax="',f0.8,'" GmaxXC="',f0.8,'" numbands="',i0,'"/>')
WRITE (fileNum,110) input%rkmax,stars%gmaxInit,xcpot%gmaxxc,input%gw_neigd
WRITE (fileNum,110) input%rkmax,input%gmax,xcpot%gmaxxc,input%gw_neigd
! <scfLoop itmax="9" maxIterBroyd="99" imix="Anderson" alpha="0.05" preconditioning_param="0.0" spinf="2.00"/>
120 FORMAT(' <scfLoop itmax="',i0,'" minDistance="',f0.8,'" maxIterBroyd="',i0,'" imix="',a,'" alpha="',f0.8,'" preconditioning_param="',f3.1,'" spinf="',f0.8,'"/>')
......@@ -433,7 +433,7 @@ SUBROUTINE w_inpXML(&
END DO
IF (.not.input%film) tempTaual(3,na) = tempTaual(3,na)*scpos(3)
IF (input%film) THEN
tempTaual(3,na) = cell%amat(3,3)*tempTaual(3,na)/input%scaleCell
tempTaual(3,na) = cell%amat(3,3)*tempTaual(3,na)
END IF
!+odim in 1D case all the coordinates are given in cartesian YM
IF (oneD%odd%d1) THEN
......
......@@ -4,46 +4,10 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_types_kpts
MODULE m_kpoints_init
USE m_judft
USE m_types_fleurinput_base
use m_types_fleurinput
IMPLICIT NONE
PRIVATE
TYPE,EXTENDS(t_fleurinput_base):: t_kpts
character(len=20) :: name="default"
INTEGER :: nkpt=0
INTEGER :: ntet=0
LOGICAL :: l_gamma=.FALSE.
!(3,nkpt) k-vectors internal units
REAL,ALLOCATABLE :: bk(:,:)
!(nkpts) weights
REAL,ALLOCATABLE :: wtkpt(:)
INTEGER :: nkptf=0 !<k-vectors in full BZ
REAL ,ALLOCATABLE :: bkf(:,:)
INTEGER,ALLOCATABLE :: bkp(:)
INTEGER,ALLOCATABLE :: bksym(:)
INTEGER :: numSpecialPoints=0
INTEGER, ALLOCATABLE :: specialPointIndices(:)
CHARACTER(LEN=50),ALLOCATABLE :: specialPointNames(:)
REAL ,ALLOCATABLE :: specialPoints(:,:)
INTEGER,ALLOCATABLE :: ntetra(:,:)
REAL ,ALLOCATABLE :: voltet(:)
REAL ,ALLOCATABLE :: sc_list(:,:) !list for all information about folding of bandstructure (need for unfoldBandKPTS)((k(x,y,z),K(x,y,z),m(g1,g2,g3)),(nkpt),k_original(x,y,z))
CONTAINS
PROCEDURE :: init
PROCEDURE :: init_defaults
PROCEDURE :: init_by_density
PROCEDURE :: init_by_number
PROCEDURE :: init_by_grid
PROCEDURE :: init_special
PROCEDURE :: init_by_kptsfile
!procedure :: read_xml
PROCEDURE :: add_special_line
PROCEDURE :: print_xml
PROCEDURE :: read_xml
ENDTYPE t_kpts
PUBLIC :: t_kpts
CONTAINS
SUBROUTINE init(kpts,cell,sym,film)
......@@ -152,76 +116,6 @@ CONTAINS
END IF
END SUBROUTINE read_xml
SUBROUTINE print_xml(kpts,fh,filename)
CLASS(t_kpts),INTENT(in ):: kpts
INTEGER,INTENT(in) :: fh
CHARACTER(len=*),INTENT(in),OPTIONAL::filename
INTEGER :: n
LOGICAL :: l_exist
IF (PRESENT(filename)) THEN
INQUIRE(file=filename,exist=l_exist)
IF (l_exist) THEN
OPEN(fh,file=filename,action="write",position="append")
ELSE
OPEN(fh,file=filename,action="write")
END IF
ENDIF
205 FORMAT(' <kPointList name="',a,'" count="',i0,'">')
WRITE(fh,205) adjustl(trim(kpts%name)),kpts%nkpt
IF (kpts%numSpecialPoints<2) THEN
DO n=1,kpts%nkpt
206 FORMAT(' <kPoint weight="',f12.6,'">',f12.6,' ',f12.6,' ',f12.6,'</kPoint>')
WRITE (fh,206) kpts%wtkpt(n), kpts%bk(:,n)
END DO
IF (kpts%ntet>0) THEN
WRITE(fh,207) kpts%ntet
207 FORMAT(' <tetraeder ntet="',i0,'">')
DO n=1,kpts%ntet
208 FORMAT(' <tet vol="',f12.6,'">',i0,' ',i0,' ',i0,' ',i0,'</tet>')
WRITE(fh,208) kpts%voltet(n),kpts%ntetra(:,n)
END DO