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.

cdn/cdnval.F90

@@ -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

cmake/Files_and_Targets.txt

@@ -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})
 

eigen/eigen.F90

@@ -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
 

force/geo.f90

@@ -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

inpgen/inpgen.f90

@@ -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 

io/CMakeLists.txt

@@ -20,4 +20,5 @@ io/wrtdop.f90
 io/w_inpXML.f90
 io/xsf_io.f90
 io/xmlIntWrapFort.f90
+io/xmlOutput.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

juDFT/stop.F90

@@ -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"

main/fleur.F90

@@ -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

main/fleur_init.F90

@@ -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')

vgen/pot_mod.f90

@@ -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
 

wannier/wann_optional.f

@@ -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

wannier/wannier.F

@@ -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