Commit d35f39ad authored by Gregor Michalicek's avatar Gregor Michalicek

Opening and closing out.xml file

This commit also provides helper routines to write out data into out.xml.
Nothing is tested yet. The routines might be horribly wrong.
parent f02ffa2e
......@@ -973,9 +973,9 @@ enddo
!Note: no deallocation anymore, we rely on Fortran08 :-)
IF ((jsp_end.EQ.input%jspins)) THEN
IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK")
IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK",mpi%irank)
IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK")
IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK",mpi%irank)
ENDIF
END SUBROUTINE cdnval
END MODULE m_cdnval
......@@ -48,7 +48,7 @@ init/tetcon.f init/kvecon.f
set(inpgen_F90 io/xsf_io.f90
global/types.F90 global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 io/rw_inp.f90 juDFT/juDFT.F90
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90)
juDFT/stop.F90 juDFT/time.F90 juDFT/init.F90 io/w_inpXML.f90 init/julia.f90 io/xmlOutput.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
......@@ -649,7 +649,7 @@ CONTAINS
IF(l_file) CLOSE(1014)
INQUIRE(667,opened=l_file)
IF(l_file) CLOSE(667)
CALL juDFT_end("GW finished")
CALL juDFT_end("GW finished",mpi%irank)
ENDIF
ENDIF
......
......@@ -88,7 +88,7 @@ CONTAINS
& lconv)
IF (lconv) THEN
WRITE (6,'(a)') "Des woars!"
CALL juDFT_end(" GEO Des woars ")
CALL juDFT_end(" GEO Des woars ", 1) ! The 1 is temporarily. Should be mpi%irank.
ELSE
atoms_new=atoms
......
......@@ -213,6 +213,6 @@ PROGRAM inpgen
DEALLOCATE (vacuum%izlay)
DEALLOCATE ( atoms%taual,sym%mrot,sym%tau,atoms%neq,atoms%zatom,atoms%rmt,natmap,atoms%pos,idlist )
IF (inistop) CALL juDFT_end("Symmetry done")
IF (inistop) CALL juDFT_end("Symmetry done",1)
END
......@@ -20,4 +20,5 @@ io/wrtdop.f90
io/w_inpXML.f90
io/xsf_io.f90
io/xmlIntWrapFort.f90
io/xmlOutput.f90
)
MODULE m_xmlOutput
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!
!!! XML output service routines
!!!
!!! This module provides several subroutines that simplify the
!!! generation of the out.xml file.
!!! GM'16
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IMPLICIT NONE
INTEGER, SAVE :: currentElementIndex
INTEGER, SAVE :: maxNumElements
INTEGER, SAVE :: xmlOutputUnit
CHARACTER(LEN= 40), ALLOCATABLE :: elementList(:)
CONTAINS
SUBROUTINE startXMLOutput()
IMPLICIT NONE
maxNumElements = 10
ALLOCATE(elementList(maxNumElements))
elementList = ''
currentElementIndex = 0
xmlOutputUnit = 53
OPEN (xmlOutputUnit,file='out.xml',form='formatted',status='unknown')
WRITE (xmlOutputUnit,'(a)') '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'
WRITE (xmlOutputUnit,'(a)') '<fleurOutput fleurOutputVersion="0.27">'
! TODO: Write out standard stuff
END SUBROUTINE startXMLOutput
SUBROUTINE endXMLOutput()
IMPLICIT NONE
DO WHILE (currentElementIndex.NE.0)
CALL closeXMLElement(elementList(currentElementIndex))
END DO
DEALLOCATE(elementList)
WRITE (xmlOutputUnit,'(a)') '</fleurOutput>'
CLOSE(xmlOutputUnit)
END SUBROUTINE endXMLOutput
SUBROUTINE writeXMLElementPoly(elementName,attributeNames,attributeValues,contentList)
IMPLICIT NONE
CHARACTER(LEN= 40) :: elementName
CHARACTER(LEN= 40), INTENT(IN) :: attributeNames(:)
CLASS(*), INTENT(IN) :: attributeValues(:)
CLASS(*), INTENT(IN) :: contentList(:)
CHARACTER(LEN= 30), ALLOCATABLE :: charAttributeValues(:)
CHARACTER(LEN= 30), ALLOCATABLE :: charContentList(:)
INTEGER :: i
ALLOCATE(charAttributeValues(SIZE(attributeValues)))
ALLOCATE(charContentList(SIZE(contentList)))
charAttributeValues = ''
charContentList = ''
DO i = 1, SIZE(attributeValues)
SELECT TYPE (attributeValues)
TYPE IS(INTEGER)
WRITE(charAttributeValues(i),'(i0)'), attributeValues(i)
TYPE IS(REAL)
WRITE(charAttributeValues(i),'(f20.10)'), attributeValues(i)
TYPE IS(LOGICAL)
WRITE(charAttributeValues(i),'(l1)'), attributeValues(i)
CLASS DEFAULT
STOP 'Type of attributeValues not allowed'
END SELECT
END DO
DO i = 1, SIZE(contentList)
SELECT TYPE(contentList)
TYPE IS(INTEGER)
WRITE(charContentList(i),'(i0)'), contentList(i)
TYPE IS(REAL)
WRITE(charContentList(i),'(f20.10)'), contentList(i)
TYPE IS(LOGICAL)
WRITE(charContentList(i),'(l1)'), contentList(i)
CLASS DEFAULT
STOP 'Type of contentList not allowed'
END SELECT
END DO
CALL writeXMLElement(elementName,attributeNames,charAttributeValues,charContentList)
DEALLOCATE(charContentList,charAttributeValues)
END SUBROUTINE writeXMLElementPoly
SUBROUTINE writeXMLElement(elementName,attributeNames,attributeValues,contentList)
IMPLICIT NONE
!! Overloading for different types of attributes, data elements?
CHARACTER(LEN= 40) :: elementName
CHARACTER(LEN= 40), INTENT(IN) :: attributeNames(:)
CHARACTER(LEN= 30), INTENT(IN) :: attributeValues(:)
CHARACTER(LEN= 30), INTENT(IN) :: contentList(:)
CHARACTER(LEN=200), ALLOCATABLE :: contentLineList(:)
INTEGER :: i, contentLineLength, contentLineListSize
CHARACTER(LEN=70) :: format
CHARACTER(LEN=200) :: outputString
IF(SIZE(attributeNames).NE.SIZE(attributeValues)) THEN
WRITE(*,*) 'attributeNames', attributeNames
WRITE(*,*) 'attributeValues', attributeValues
STOP 'ERROR: SIZE(attributeNames).NE.SIZE(attributeValues)'
END IF
contentLineLength = 6 ! At most 6 data elements per line
contentLineListSize = SIZE(contentList) / contentLineLength
IF(contentLineListSize*contentLineLength.NE.SIZE(contentList)) THEN
contentLineListSize = contentLineListSize + 1
END IF
ALLOCATE(contentLineList(contentLineListSize))
CALL fillContentLineList(contentList,contentLineList,contentLineLength)
outputString = '<'//TRIM(ADJUSTL(elementName))
DO i = 1, SIZE(attributeNames)
outputString = TRIM(ADJUSTL(outputString))//' '//TRIM(ADJUSTL(attributeNames(i)))//'="'//TRIM(ADJUSTL(attributeValues(i)))//'"'
END DO
IF(SIZE(contentLineList).EQ.0) THEN
outputString = TRIM(ADJUSTL(outputString))//'/>'
ELSE IF(SIZE(contentLineList).EQ.1) THEN
outputString = TRIM(ADJUSTL(outputString))//'>'//contentLineList(1)//'</'//TRIM(ADJUSTL(elementName))//'>'
ELSE
outputString = TRIM(ADJUSTL(outputString))//'>'
END IF
WRITE(format,*) "'(a",3*(currentElementIndex+1),",a)'"
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
IF(SIZE(contentLineList).GT.1) THEN
WRITE(format,*) "'(a",3*(currentElementIndex+2),",a)'"
DO i = 1, SIZE(contentLineList)
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(contentLineList(i)))
END DO
WRITE(format,*) "'(a",3*(currentElementIndex+1),",a)'"
outputString = '</'//TRIM(ADJUSTL(elementName))//'>'
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
END IF
END SUBROUTINE writeXMLElement
SUBROUTINE fillContentLineList(contentList,contentLineList,contentLineLength)
IMPLICIT NONE
CHARACTER(LEN= 30), INTENT(IN) :: contentList(:)
CHARACTER(LEN=200), INTENT(INOUT) :: contentLineList(:)
INTEGER, INTENT(IN) :: contentLineLength
INTEGER :: i, j
contentLineList = ''
DO i = 1, SIZE(contentLineList)
DO j = 1, contentLineLength
IF((i-1)*contentLineLength+j.GT.SIZE(contentList)) THEN
RETURN
END IF
contentLineList(i) = TRIM(ADJUSTL(contentLineList(i)))//' '//TRIM(ADJUSTL(contentList((i-1)*contentLineLength+j)))
END DO
END DO
END SUBROUTINE fillContentLineList
SUBROUTINE openXMLElementPoly(elementName,attributeNames,attributeValues)
IMPLICIT NONE
CHARACTER(LEN= 40) :: elementName
CHARACTER(LEN= 40), INTENT(IN) :: attributeNames(:)
CLASS(*), INTENT(IN) :: attributeValues(:)
CHARACTER(LEN= 30), ALLOCATABLE :: charAttributeValues(:)
INTEGER :: i
ALLOCATE(charAttributeValues(SIZE(attributeValues)))
charAttributeValues = ''
DO i = 1, SIZE(attributeValues)
SELECT TYPE (attributeValues)
TYPE IS(INTEGER)
WRITE(charAttributeValues(i),'(i0)'), attributeValues(i)
TYPE IS(REAL)
WRITE(charAttributeValues(i),'(f20.10)'), attributeValues(i)
TYPE IS(LOGICAL)
WRITE(charAttributeValues(i),'(l1)'), attributeValues(i)
CLASS DEFAULT
STOP 'Type of attributeValues not allowed'
END SELECT
END DO
CALL openXMLElement(elementName,attributeNames,charAttributeValues)
DEALLOCATE(charAttributeValues)
END SUBROUTINE openXMLElementPoly
SUBROUTINE openXMLElement(elementName,attributeNames,attributeValues)
IMPLICIT NONE
CHARACTER(LEN= 40) :: elementName
CHARACTER(LEN= 40), INTENT(IN) :: attributeNames(:)
CHARACTER(LEN= 30), INTENT(IN) :: attributeValues(:)
INTEGER :: i
CHARACTER(LEN=70) :: format
CHARACTER(LEN=200) :: openingString
IF(SIZE(attributeNames).NE.SIZE(attributeValues)) THEN
WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
WRITE(*,*) 'attributeNames', attributeNames
WRITE(*,*) 'attributeValues', attributeValues
STOP 'ERROR: SIZE(attributeNames).NE.SIZE(attributeValues)'
END IF
IF(currentElementIndex.EQ.maxNumElements) THEN
WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
WRITE(*,*) 'attributeNames', attributeNames
WRITE(*,*) 'attributeValues', attributeValues
STOP 'ERROR: xml hierarchy too deep!'
END IF
currentElementIndex = currentElementIndex + 1
openingString = '<'//TRIM(ADJUSTL(elementName))
DO i = 1, SIZE(attributeNames)
openingString = TRIM(ADJUSTL(openingString))//' '//TRIM(ADJUSTL(attributeNames(i)))//'="'//TRIM(ADJUSTL(attributeValues(i)))//'"'
END DO
openingString = TRIM(ADJUSTL(openingString))//'>'
WRITE(format,*) "'(a",3*currentElementIndex,",a)'"
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(openingString))
END SUBROUTINE openXMLElement
SUBROUTINE closeXMLElement(elementName)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: elementName
INTEGER :: i
CHARACTER(LEN=70) :: format
CHARACTER(LEN=70) :: closingString
IF(TRIM(ADJUSTL(elementList(currentElementIndex))).NE.TRIM(ADJUSTL(elementName))) THEN
WRITE(*,*) 'elementList(currentElementIndex):', TRIM(ADJUSTL(elementList(currentElementIndex)))
WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
STOP 'ERROR: Closing xml element inconsistency!'
END IF
closingString = '</'//elementName//'>'
WRITE(format,*) "'(a",3*currentElementIndex,",a)'"
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(closingString))
currentElementIndex = currentElementIndex - 1
END SUBROUTINE closeXMLElement
END MODULE m_xmlOutput
......@@ -25,6 +25,7 @@
! Daniel Wortmann (2010)
!-----------------------------------------------
USE m_judft_time
USE m_xmlOutput
IMPLICIT NONE
PRIVATE
PUBLIC juDFT_error,juDFT_warn,juDFT_end
......@@ -117,13 +118,16 @@
END SUBROUTINE juDFT_warn
SUBROUTINE juDFT_END(message)
SUBROUTINE juDFT_END(message, irank)
IMPLICIT NONE
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER :: ierr
#endif
CHARACTER*(*) :: message
INTEGER, INTENT(IN) :: irank
IF (irank.EQ.0) CALL endXMLOutput()
WRITE(0,*) "*****************************************"
WRITE(0,*) "Run finished successfully"
......
......@@ -218,13 +218,13 @@
& xcpot,noco,oneD)
ENDIF
!
IF (sliceplot%iplot) CALL juDFT_end("density plot o.k.")
IF (input%strho) CALL juDFT_end("starting density generated")
IF (input%swsp) CALL juDFT_end("spin polarised density generated")
IF (input%lflip) CALL juDFT_end("magnetic moments flipped")
IF (obsolete%l_f2u) CALL juDFT_end("conversion to unformatted")
IF (obsolete%l_u2f) CALL juDFT_end("conversion to formatted")
IF (input%l_bmt) CALL juDFT_end('"cdnbmt" written')
IF (sliceplot%iplot) CALL juDFT_end("density plot o.k.",mpi%irank)
IF (input%strho) CALL juDFT_end("starting density generated",mpi%irank)
IF (input%swsp) CALL juDFT_end("spin polarised density generated",mpi%irank)
IF (input%lflip) CALL juDFT_end("magnetic moments flipped",mpi%irank)
IF (obsolete%l_f2u) CALL juDFT_end("conversion to unformatted",mpi%irank)
IF (obsolete%l_u2f) CALL juDFT_end("conversion to formatted",mpi%irank)
IF (input%l_bmt) CALL juDFT_end('"cdnbmt" written',mpi%irank)
#ifdef CPP_WANN
......@@ -565,7 +565,7 @@
IF(l_endit) CLOSE(1014)
INQUIRE(667,opened=l_endit)
IF(l_endit) CLOSE(667)
CALL juDFT_end("GW+SOC finished")
CALL juDFT_end("GW+SOC finished",mpi%irank)
ENDIF
ENDIF
CALL timestop("generation of hamiltonian and diagonalization (total)")
......@@ -751,7 +751,7 @@
!-t3e
IF (banddos%ndir.GT.0) THEN
CALL juDFT_end("NDIR")
CALL juDFT_end("NDIR",mpi%irank)
END IF
! ----> output potential and potential difference
IF (obsolete%disp) THEN
......@@ -845,7 +845,7 @@
!+fo
INQUIRE (file='inp_new',exist=l_endit)
IF (l_endit) THEN
CALL juDFT_end(" GEO new inp created ! ")
CALL juDFT_end(" GEO new inp created ! ",mpi%irank)
END IF
!-fo
IF ( hybrid%l_calhf ) ithf = ithf + 1
......@@ -859,7 +859,7 @@
END IF
80 CONTINUE
CALL juDFT_end("all done")
CALL juDFT_end("all done",mpi%irank)
END SUBROUTINE
END MODULE
......@@ -18,6 +18,7 @@
USE icorrkeys
USE m_ylm
USE m_InitParallelProcesses
USE m_xmlOutput
#ifdef CPP_MPI
USE m_mpi_bc_all, ONLY : mpi_bc_all
#endif
......@@ -73,6 +74,7 @@
input%gw_neigd = 0
!-t3e
IF (mpi%irank.EQ.0) THEN
CALL startXMLOutput()
#ifndef __TOS_BGQ__
!Do not open out-file on BlueGene
OPEN (6,file='out',form='formatted',status='unknown')
......
......@@ -163,7 +163,7 @@ CONTAINS
ENDDO
ENDIF
CLOSE(201)
CALL juDFT_end("B_xc is written to 'bxc'")
CALL juDFT_end("B_xc is written to 'bxc'",1) ! The 1 is temporarily. Should be mpi%irank.
ENDIF
......
......@@ -114,7 +114,7 @@ c-----if wannierize, then calculate polarization later (after wannierize)
wann%l_stopopt=.true.
endif
IF(wann%l_stopopt) CALL juDFT_end("wann_optional done")
IF(wann%l_stopopt) CALL juDFT_end("wann_optional done",1) ! The 1 is temporarily. Should be mpi%irank.
end subroutine wann_optional
end module m_wann_optional
......@@ -335,7 +335,7 @@ c endif
> volint,symor,pos,ef,0,l_soc, !irecl=0
> memd,lnonsph,clnu,lmplmd,mlh,nmem,llh,lo1l,
> theta,phi,soc_opt)
CALL juDFT_end("updown done")
CALL juDFT_end("updown done",irank)
endif
if(wann%l_byenergy.and.wann%l_byindex) CALL juDFT_error
......@@ -1649,7 +1649,7 @@ c#endif
#ifdef CPP_MPI
call MPI_BARRIER(mpi_comm,ierr)
#endif
if(.not.wann%l_ldauwan) CALL juDFT_end("wannier good")
if(.not.wann%l_ldauwan) CALL juDFT_end("wannier good",irank)
END SUBROUTINE wannier
END MODULE m_wannier
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment