diff --git a/force/geo.f90 b/force/geo.f90 index 8493fee612bdae283b86552edfe150d22b260b3a..5fa8a111c03b5a4a002e9c3156859cca67a771f1 100644 --- a/force/geo.f90 +++ b/force/geo.f90 @@ -85,6 +85,7 @@ CONTAINS TYPE(t_kpts) :: kpts_temp TYPE(t_hybrid) :: hybrid_temp TYPE(t_oneD) :: oneD_temp + TYPE(t_wann) :: wann_temp LOGICAL :: l_kpts_temp, l_gga_temp INTEGER :: numSpecies INTEGER :: div(3) @@ -233,7 +234,7 @@ CONTAINS ALLOCATE(xmlCoreOccs(1,1,1)) CALL r_inpXML(atoms_temp,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,& banddos_temp,dimension_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,Jij_temp,& - oneD_temp,hybrid_temp,kpts_temp,enpara_temp,noel_temp,& + oneD_temp,hybrid_temp,kpts_temp,enpara_temp,wann_temp,noel_temp,& namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,scale_temp,dtild_temp,xmlElectronStates,& xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,l_kpts_temp,l_gga_temp) numSpecies = SIZE(speciesRepAtomType) diff --git a/global/types.F90 b/global/types.F90 index de7f356f72618553d6efa5a66ab5881f24b7e72d..3cb3f163a22349cace0c69f77b533bd665507244 100644 --- a/global/types.F90 +++ b/global/types.F90 @@ -864,6 +864,7 @@ CHARACTER(len=20) :: param_file REAL,ALLOCATABLE :: param_vec(:,:) REAL,ALLOCATABLE :: param_alpha(:,:) + CHARACTER(LEN=20), ALLOCATABLE :: jobList(:) !---> gwf end type t_wann diff --git a/io/r_inpXML.F90 b/io/r_inpXML.F90 index 8841a3498b0b80808a67f4afffe2048b65377084..6ce87b9cfa1c43364d0d8a88d58a3720f61d82cb 100644 --- a/io/r_inpXML.F90 +++ b/io/r_inpXML.F90 @@ -16,7 +16,7 @@ MODULE m_rinpXML CONTAINS SUBROUTINE r_inpXML(& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,dimension,& - cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,enpara,& + cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,enpara,wann,& noel,namex,relcor,a1,a2,a3,scale,dtild,xmlElectronStates,& xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,& l_kpts,l_gga) @@ -58,6 +58,7 @@ SUBROUTINE r_inpXML(& TYPE(t_noco),INTENT(INOUT) :: noco TYPE(t_dimension),INTENT(OUT) :: dimension TYPE(t_enpara) ,INTENT(OUT) :: enpara + TYPE(t_wann) ,INTENT(INOUT) :: wann LOGICAL, INTENT(OUT) :: l_kpts, l_gga INTEGER, ALLOCATABLE, INTENT(INOUT) :: xmlElectronStates(:,:) INTEGER, ALLOCATABLE, INTENT(INOUT) :: atomTypeSpecies(:) @@ -113,7 +114,7 @@ SUBROUTINE r_inpXML(& REAL :: speciesXMLCoreOccs(2,29) LOGICAL :: speciesXMLPrintCoreStates(29) - INTEGER :: iType, iLO, iSpecies, lNumCount, nNumCount, iLLO, jsp, j, l, absSum + INTEGER :: iType, iLO, iSpecies, lNumCount, nNumCount, iLLO, jsp, j, l, absSum, numTokens INTEGER :: numberNodes, nodeSum, numSpecies, n2spg, n1, n2, ikpt, iqpt INTEGER :: atomicNumber, coreStates, gridPoints, lmax, lnonsphr, lmaxAPW INTEGER :: latticeDef, symmetryDef, nop48, firstAtomOfType, errorStatus @@ -1690,6 +1691,7 @@ SUBROUTINE r_inpXML(& banddos%band = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@band')) banddos%vacdos = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@vacdos')) sliceplot%slice = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@slice')) + input%l_wann = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@wannier')) ! Read in optional switches for checks @@ -1794,6 +1796,61 @@ SUBROUTINE r_inpXML(& WRITE(*,*) 'band="T" --> Overriding "dos" and "ndir"!' ENDIF + ! Read in optional Wannier functions parameters + + xPathA = '/fleurInput/output/wannier' + numberNodes = xmlGetNumberOfNodes(xPathA) + + IF ((input%l_wann).AND.(numberNodes.EQ.0)) THEN + CALL juDFT_error("wannier is true but Wannier parameters are not set!", calledby = "r_inpXML") + END IF + + IF (numberNodes.EQ.1) THEN + wann%l_ms = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@ms')) + wann%l_sgwf = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@sgwf')) + wann%l_socgwf = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@socgwf')) + wann%l_bs_comf = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@bsComf')) + wann%l_atomlist = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@atomList')) + END IF + + xPathA = '/fleurInput/output/wannier/bandSelection' + numberNodes = xmlGetNumberOfNodes(xPathA) + + IF (numberNodes.EQ.1) THEN + wann%l_byindex=.TRUE. + wann%band_min(1) = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@minSpinUp')) + wann%band_max(1) = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@maxSpinUp')) + xPathA = '/fleurInput/output/wannier/bandSelection/@minSpinDown' + numberNodes = xmlGetNumberOfNodes(xPathA) + IF (numberNodes.EQ.1) THEN + wann%band_min(2) = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA)))) + ELSE + wann%band_min(2) = wann%band_min(1) + END IF + xPathA = '/fleurInput/output/wannier/bandSelection/@maxSpinDown' + numberNodes = xmlGetNumberOfNodes(xPathA) + IF (numberNodes.EQ.1) THEN + wann%band_max(2) = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA)))) + ELSE + wann%band_max(2) = wann%band_max(1) + END IF + END IF + + xPathA = '/fleurInput/output/wannier/jobList' + numberNodes = xmlGetNumberOfNodes(xPathA) + + IF (numberNodes.EQ.1) THEN + xPathA = 'normalize-space(/fleurInput/output/wannier/jobList/text())[1]' + + ! Note: At the moment only 255 characters for the text in this node. Maybe this is not enough. + valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))) + numTokens = countStringTokens(valueString) + ALLOCATE(wann%jobList(numTokens)) + DO i = 1, numTokens + wann%jobList(i) = popFirstStringToken(valueString) + END DO + END IF + END IF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1941,4 +1998,31 @@ FUNCTION popFirstStringToken(line) RESULT(firstToken) END FUNCTION popFirstStringToken +FUNCTION countStringTokens(line) RESULT(tokenCount) + + IMPLICIT NONE + + CHARACTER(*), INTENT(IN) :: line + INTEGER :: tokenCount + + CHARACTER(LEN=LEN(line)) :: tempLine + INTEGER separatorIndex + + tokenCount = 0 + + tempLine = TRIM(ADJUSTL(line)) + + DO WHILE (tempLine.NE.'') + separatorIndex = 0 + separatorIndex = INDEX(tempLine,' ') + IF (separatorIndex.EQ.0) THEN + tempLine = '' + ELSE + tempLine = TRIM(ADJUSTL(tempLine(separatorIndex+1:))) + END IF + tokenCount = tokenCount + 1 + END DO + +END FUNCTION countStringTokens + END MODULE m_rinpXML diff --git a/main/fleur_init.F90 b/main/fleur_init.F90 index 05c3673ce8978187b973cb802ffb429e3184bd6e..67b89015352f041512d14eda4a4be6cf91faba9f 100644 --- a/main/fleur_init.F90 +++ b/main/fleur_init.F90 @@ -158,7 +158,7 @@ scale = 1.0 CALL r_inpXML(& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,DIMENSION,& - cell,sym,xcpot,noco,Jij,oneD,hybrid,kpts,enpara,& + cell,sym,xcpot,noco,Jij,oneD,hybrid,kpts,enpara,wann,& noel,namex,relcor,a1,a2,a3,scale,dtild,xmlElectronStates,& xmlPrintCoreStates,xmlCoreOccs,atomTypeSpecies,speciesRepAtomType,& l_kpts,l_gga)