Commit 900d82c0 authored by Gregor Michalicek's avatar Gregor Michalicek

Implemented writing out LDA+U density matrix to out.xml

parent 6b4fc4ed
...@@ -27,6 +27,8 @@ MODULE m_xmlOutput ...@@ -27,6 +27,8 @@ MODULE m_xmlOutput
PUBLIC startXMLOutput, endXMLOutput PUBLIC startXMLOutput, endXMLOutput
PUBLIC writeXMLElementFormPoly, writeXMLElementPoly PUBLIC writeXMLElementFormPoly, writeXMLElementPoly
PUBLIC writeXMLElementForm, writeXMLElement PUBLIC writeXMLElementForm, writeXMLElement
PUBLIC writeXMLElementMatrixPoly, writeXMLElementMatrixFormPoly
PUBLIC writeXMLElementMatrixForm
PUBLIC openXMLElementFormPoly, openXMLElementPoly PUBLIC openXMLElementFormPoly, openXMLElementPoly
PUBLIC openXMLElementForm, openXMLElement PUBLIC openXMLElementForm, openXMLElement
PUBLIC openXMLElementNoAttributes, closeXMLElement PUBLIC openXMLElementNoAttributes, closeXMLElement
...@@ -307,6 +309,167 @@ MODULE m_xmlOutput ...@@ -307,6 +309,167 @@ MODULE m_xmlOutput
END SUBROUTINE writeXMLElementForm END SUBROUTINE writeXMLElementForm
SUBROUTINE writeXMLElementMatrixPoly(elementName,attributeNames,attributeValues,matrix)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: elementName
CHARACTER(LEN=*), INTENT(IN) :: attributeNames(:)
CLASS(*), INTENT(IN) :: attributeValues(:)
CLASS(*), INTENT(IN) :: matrix(:,:)
INTEGER, ALLOCATABLE :: lengths(:,:)
INTEGER :: numDifferentMatrixElementLengths
numDifferentMatrixElementLengths = 1 ! At the moment nothing else is implemented.
! In principle one could think about an own
! length for each matrix element.
ALLOCATE(lengths(MAX(SIZE(attributeNames),numDifferentMatrixElementLengths),3))
lengths = 0
CALL writeXMLElementMatrixFormPoly(elementName,attributeNames,attributeValues,lengths,matrix)
DEALLOCATE(lengths)
END SUBROUTINE writeXMLElementMatrixPoly
SUBROUTINE writeXMLElementMatrixFormPoly(elementName,attributeNames,attributeValues,lengths,matrix)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: elementName
CHARACTER(LEN=*), INTENT(IN) :: attributeNames(:)
CLASS(*), INTENT(IN) :: attributeValues(:)
INTEGER, INTENT(IN) :: lengths(:,:)
CLASS(*), INTENT(IN) :: matrix(:,:)
CHARACTER(LEN= 30), ALLOCATABLE :: charAttributeValues(:)
CHARACTER(LEN= 50), ALLOCATABLE :: charMatrix(:,:)
INTEGER :: i, j
ALLOCATE(charAttributeValues(SIZE(attributeValues)))
ALLOCATE(charMatrix(SIZE(matrix,1),SIZE(matrix,2)))
charAttributeValues = ''
charMatrix = ''
DO i = 1, SIZE(attributeValues)
SELECT TYPE (attributeValues)
TYPE IS(INTEGER)
WRITE(charAttributeValues(i),'(i0)') attributeValues(i)
TYPE IS(REAL)
WRITE(charAttributeValues(i),'(f19.10)') attributeValues(i)
TYPE IS(LOGICAL)
WRITE(charAttributeValues(i),'(l1)') attributeValues(i)
#ifndef __PGI
TYPE IS(CHARACTER(LEN=*))
WRITE(charAttributeValues(i),'(a)') TRIM(ADJUSTL(attributeValues(i)))
CLASS DEFAULT
STOP 'Type of attributeValues not allowed'
#endif
END SELECT
END DO
DO j = 1, SIZE(matrix,2)
DO i = 1, SIZE(matrix,1)
SELECT TYPE(matrix)
TYPE IS(INTEGER)
WRITE(charMatrix(i,j),'(i0)') matrix(i,j)
TYPE IS(REAL)
WRITE(charMatrix(i,j),'(f19.10)') matrix(i,j)
TYPE IS(COMPLEX)
WRITE(charMatrix(i,j),'(a,f0.8,a,f0.8,a)') '(',REAL(matrix(i,j)),',', AIMAG(matrix(i,j)),')'
TYPE IS(LOGICAL)
WRITE(charMatrix(i,j),'(l1)') matrix(i,j)
#ifndef __PGI
TYPE IS(CHARACTER(LEN=*))
WRITE(charMatrix(i,j),'(a)') TRIM(ADJUSTL(matrix(i,j)))
CLASS DEFAULT
STOP 'Type of matrix not allowed'
#endif
END SELECT
END DO
END DO
CALL writeXMLElementMatrixForm(elementName,attributeNames,charAttributeValues,lengths,charMatrix)
DEALLOCATE(charMatrix,charAttributeValues)
END SUBROUTINE writeXMLElementMatrixFormPoly
SUBROUTINE writeXMLElementMatrixForm(elementName,attributeNames,attributeValues,lengths,matrix)
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: elementName
CHARACTER(LEN=*), INTENT(IN) :: attributeNames(:)
CHARACTER(LEN=*), INTENT(IN) :: attributeValues(:)
INTEGER, INTENT(IN) :: lengths(:,:)
CHARACTER(LEN=*), INTENT(IN) :: matrix(:,:)
CHARACTER(LEN=400), ALLOCATABLE :: matrixRows(:)
INTEGER, ALLOCATABLE :: bigLengths(:,:)
INTEGER :: i, j
CHARACTER(LEN=70) :: format
CHARACTER(LEN=400) :: outputString
INTEGER :: matrixRowLength, numMatrixRows
INTEGER :: overallListSize
INTEGER :: lengthsShape(2)
IF(SIZE(attributeNames).NE.SIZE(attributeValues)) THEN
WRITE(*,*) 'attributeNames', attributeNames
WRITE(*,*) 'attributeValues', attributeValues
STOP 'ERROR in writeXMLElementMatrixForm: SIZE(attributeNames).NE.SIZE(attributeValues)'
END IF
lengthsShape = SHAPE(lengths)
overallListSize = MAX(SIZE(attributeNames),1)
ALLOCATE(bigLengths(overallListSize,2))
bigLengths = 0
DO j = 1, 2
DO i = 1, MIN(overallListSize,lengthsShape(1))
bigLengths(i,j) = lengths(i,j)
END DO
END DO
outputString = '<'//TRIM(ADJUSTL(elementName))
DO i = 1, SIZE(attributeNames)
WRITE(format,'(a)') "(a,a,a"
IF (bigLengths(i,1).GT.0) WRITE(format,'(a,i0)') TRIM(ADJUSTL(format)),bigLengths(i,1)
WRITE(format,'(a,a)') TRIM(ADJUSTL(format)),",a,a"
IF (bigLengths(i,2).GT.0) WRITE(format,'(a,i0)') TRIM(ADJUSTL(format)),bigLengths(i,2)
WRITE(format,'(a,a)') TRIM(ADJUSTL(format)),",a)"
WRITE(outputString,format) TRIM(ADJUSTL(outputString)), ' ', TRIM(ADJUSTL(attributeNames(i))),&
'="', TRIM(ADJUSTL(attributeValues(i))), '"'
END DO
WRITE(format,'(a,i0,a)') "(a",3*(currentElementIndex+1),",a)"
matrixRowLength = SIZE(matrix,1)
numMatrixRows = SIZE(matrix,2)
ALLOCATE(matrixRows(numMatrixRows))
matrixRows = ''
DO i = 1, numMatrixRows
DO j = 1, matrixRowLength
WRITE(matrixRows(i),'(a,a1,a)') TRIM(ADJUSTL(matrixRows(i))),' ',TRIM(ADJUSTL(matrix(j,i)))
END DO
END DO
outputString = TRIM(ADJUSTL(outputString))//'>'
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
DO i = 1, numMatrixRows
WRITE(format,'(a,i0,a)') "(a",3*(currentElementIndex+2),",a)"
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(matrixRows(i)))
END DO
WRITE(format,'(a,i0,a)') "(a",3*(currentElementIndex+1),",a)"
outputString = '</'//TRIM(ADJUSTL(elementName))//'>'
WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
DEALLOCATE (bigLengths)
END SUBROUTINE writeXMLElementMatrixForm
SUBROUTINE writeXMLElement(elementName,attributeNames,attributeValues,contentList) SUBROUTINE writeXMLElement(elementName,attributeNames,attributeValues,contentList)
IMPLICIT NONE IMPLICIT NONE
......
...@@ -16,19 +16,21 @@ CONTAINS ...@@ -16,19 +16,21 @@ CONTAINS
USE m_types USE m_types
USE m_nmat_rot USE m_nmat_rot
! USE m_xmlOutput
! ... Arguments ! ... Arguments
USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER, INTENT (IN) :: jspins INTEGER, INTENT (IN) :: jspins
COMPLEX, INTENT (INOUT) :: n_mmp_new(-3:3,-3:3,atoms%n_u,jspins) COMPLEX, INTENT (INOUT) :: n_mmp_new(-3:3,-3:3,atoms%n_u,jspins)
! !
! ... Locals ... ! ... Locals ...
INTEGER j,k,iofl,l,itype,ios,i_u,lty(atoms%n_u) INTEGER j,k,iofl,l,itype,ios,i_u,jsp,lty(atoms%n_u)
REAL alpha,spinf,gam,del,sum1,sum2,mix_u REAL alpha,spinf,gam,del,sum1,sum2,mix_u, uParam, jParam
REAL theta(atoms%n_u),phi(atoms%n_u),zero(atoms%n_u) REAL theta(atoms%n_u),phi(atoms%n_u),zero(atoms%n_u)
LOGICAL n_exist LOGICAL n_exist
CHARACTER(LEN=20) :: attributes(6)
COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:),n_mmp_old(:,:,:,:) COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:),n_mmp_old(:,:,:,:)
! !
! check for possible rotation of n_mmp ! check for possible rotation of n_mmp
...@@ -51,6 +53,30 @@ CONTAINS ...@@ -51,6 +53,30 @@ CONTAINS
zero = 0.0 zero = 0.0
CALL nmat_rot(zero,-theta,-phi,3,atoms%n_u,jspins,lty,n_mmp_new) CALL nmat_rot(zero,-theta,-phi,3,atoms%n_u,jspins,lty,n_mmp_new)
END IF END IF
! Write out n_mmp_new to out.xml file
CALL openXMLElementNoAttributes('ldaUDensityMatrix')
DO jsp = 1, jspins
DO i_u = 1, atoms%n_u
l = atoms%lda_u(i_u)%l
itype = atoms%lda_u(i_u)%atomType
uParam = atoms%lda_u(i_u)%u
jParam = atoms%lda_u(i_u)%j
attributes = ''
WRITE(attributes(1),'(i0)') jsp
WRITE(attributes(2),'(i0)') itype
WRITE(attributes(3),'(i0)') i_u
WRITE(attributes(4),'(i0)') l
WRITE(attributes(5),'(f15.8)') uParam
WRITE(attributes(6),'(f15.8)') jParam
CALL writeXMLElementMatrixPoly('densityMatrixFor',&
(/'spin ','atomType','uIndex ','l ','U ','J '/),&
attributes,n_mmp_new(-l:l,-l:l,atoms%n_u,jsp))
END DO
END DO
CALL closeXMLElement('ldaUDensityMatrix')
! !
! check for LDA+U and open density-matrix - file ! check for LDA+U and open density-matrix - file
! !
......
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