Commit 2d564403 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 517ce4d8 d62d6cb0
......@@ -986,11 +986,11 @@ CONTAINS
ALLOCATE(pd%vacxy(nmzxyd,n2d-1,2,jsp),stat=err(4))
ENDIF
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
pd%pw=0.0
pd%pw=CMPLX(0.0,0.0)
pd%mt=0.0
IF (PRESENT(nmzd)) THEN
pd%vacz=0.0
pd%vacxy=0.0
pd%vacxy=CMPLX(0.0,0.0)
ENDIF
END SUBROUTINE init_potden_simple
......
......@@ -163,6 +163,7 @@
banddos%sig_dos = 0.015 ; vacuum%tworkf = 0.0 ; scale = 1.0 ; scpos = 1.0
zc = 0.0 ; vacuum%locx(:) = 0.0 ; vacuum%locy(:) = 0.0
kpts%numSpecialPoints = 0
input%ldauLinMix = .FALSE. ; input%ldauMixParam = -1.0 ; input%ldauSpinf = 1.0
!+odim
oneD%odd%mb = 0 ; oneD%odd%M = 0 ; oneD%odd%m_cyl = 0 ; oneD%odd%chi = 0 ; oneD%odd%rot = 0
......
......@@ -183,7 +183,8 @@ SUBROUTINE r_inpXML(&
! Check version of inp.xml
versionString = xmlGetAttributeValue('/fleurInput/@fleurInputVersion')
IF((TRIM(ADJUSTL(versionString)).NE.'0.27').AND.(TRIM(ADJUSTL(versionString)).NE.'0.28')) THEN
IF((TRIM(ADJUSTL(versionString)).NE.'0.27').AND.(TRIM(ADJUSTL(versionString)).NE.'0.28').AND.&
(TRIM(ADJUSTL(versionString)).NE.'0.29')) THEN
STOP 'version number of inp.xml file is not compatible with this fleur version'
END IF
......@@ -478,7 +479,7 @@ SUBROUTINE r_inpXML(&
l_kpts = .TRUE.
numberNodes = xmlGetNumberOfNodes('/fleurInput/calculationSetup/bzIntegration/kPointList/kPoint')
kpts%nkpt = numberNodes
kpts%nkpt = numberNodes
kpts%l_gamma = .FALSE.
ALLOCATE(kpts%bk(3,kpts%nkpt))
ALLOCATE(kpts%wtkpt(kpts%nkpt))
kpts%bk = 0.0
......@@ -639,6 +640,18 @@ SUBROUTINE r_inpXML(&
END IF
END IF
! Read in optional general LDA+U parameters
IF (TRIM(ADJUSTL(versionString)).EQ.'0.29') THEN
xPathA = '/fleurInput/calculationSetup/ldaU'
numberNodes = xmlGetNumberOfNodes(xPathA)
IF (numberNodes.EQ.1) THEN
input%ldauLinMix = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@l_linMix'))
input%ldauMixParam = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@mixParam'))
input%ldauSpinf = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@spinf'))
END IF
END IF
! Read in optional q point mesh for spin spirals
xPathA = '/fleurInput/calculationSetup/spinSpiralQPointMesh'
......
......@@ -154,7 +154,7 @@ SUBROUTINE w_inpXML(&
REWIND (fileNum)
WRITE (fileNum,'(a)') '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'
WRITE (fileNum,'(a)') '<fleurInput fleurInputVersion="0.28">'
WRITE (fileNum,'(a)') '<fleurInput fleurInputVersion="0.29">'
END IF
IF(PRESENT(name_opt)) THEN
......@@ -232,6 +232,11 @@ SUBROUTINE w_inpXML(&
ELSE IF(input%tria) THEN
bzIntMode = 'tria'
END IF
! <ldaU l_linMix="F" mixParam="0.05" spinf="1.0" />
195 FORMAT(' <ldaU l_linMix="',l1,'" mixParam="',f0.6,'" spinf="',f0.6,'"/>')
WRITE (fileNum,195) input%ldauLinMix,input%ldauMixParam,input%ldauSpinf
! <bzIntegration valenceElectrons="8.00000" mode="hist" fermiSmearingEnergy="0.00100">
200 FORMAT(' <bzIntegration valenceElectrons="',f0.8,'" mode="',a,'" fermiSmearingEnergy="',f0.8,'">')
WRITE (fileNum,200) input%zelec,TRIM(ADJUSTL(bzIntMode)),input%tkb
......
This diff is collapsed.
......@@ -57,8 +57,8 @@ CONTAINS
! set up e-e- interaction matrix
ALLOCATE (u(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,&
-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
ALLOCATE (n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
ALLOCATE (n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
n_mmp(:,:,:,:) = inDen%mmpMat(:,:,:,:)
DO ispin = 1, 1 ! input%jspins
f0(:,1) = (f0(:,1) + f0(:,input%jspins) ) / 2
......
......@@ -133,11 +133,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL prp_qfft_map(stars,sym, input, igq2_fft,igq_fft)
!LDA+U: initialise density-matrix if needed
IF (atoms%n_u.GT.0) THEN
ALLOCATE (outDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
ELSE
ALLOCATE (outDen%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,input%jspins))
END IF
ALLOCATE (outDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
outDen%mmpMat(:,:,:,:) = CMPLX(0.0,0.0)
......
......@@ -215,13 +215,8 @@ CONTAINS
CALL vCoul%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTCOUL)
CALL vx%init(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_POTX)
CALL vTemp%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTTOT)
IF ((atoms%n_u.GT.0)) THEN
ALLOCATE(vTot%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
ALLOCATE(vTemp%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
ELSE
ALLOCATE(vTot%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2))
ALLOCATE(vTemp%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2))
ENDIF
ALLOCATE(vTot%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
ALLOCATE(vTemp%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
! Initialize potentials (end)
DO WHILE (l_cont)
......
......@@ -60,7 +60,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
REAL dist(6)
REAL, ALLOCATABLE :: sm(:), fsm(:)
CHARACTER(LEN=20) :: attributes(2)
COMPLEX :: n_mmpTemp(-3:3,-3:3,atoms%n_u,input%jspins)
COMPLEX :: n_mmpTemp(-3:3,-3:3,MAX(1,atoms%n_u),input%jspins)
!External functions
REAL CPP_BLAS_sdot
......
......@@ -41,7 +41,7 @@ CONTAINS
! ***************************************************
!
USE m_intgr , ONLY : intgr3
USE m_constants, ONLY : sfp_const
USE m_constants
USE m_force_a4
USE m_force_a3
USE m_forcew
......@@ -67,23 +67,24 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER,INTENT (IN) :: it
! ..
! Local type instances
TYPE(t_potden) :: den
! .. Local Scalars ..
REAL rhs,totz, eigSum, fermiEnergyTemp
INTEGER n,j,nt,iter,i, archiveType
INTEGER n,j,nt,i, archiveType
LOGICAL l_qfix
! .. Local Arrays ..
REAL vmd(atoms%ntype),zintn_r(atoms%ntype)
REAL dpj(atoms%jmtd)
COMPLEX :: cdom(1),cdomvz(1,1),cdomvxy(1,1,1)
CHARACTER(LEN=20) :: attributes(3)
!.....density
REAL, ALLOCATABLE :: rho(:,:,:,:),rht(:,:,:)
COMPLEX, ALLOCATABLE :: qpw(:,:),rhtxy(:,:,:,:)
ALLOCATE (rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),rht(vacuum%nmzd,2,input%jspins),&
qpw(stars%ng3,input%jspins),rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins))
CALL den%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_DEN)
ALLOCATE (den%cdom(1),den%cdomvz(1,1),den%cdomvxy(1,1,1))
ALLOCATE (den%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
den%mmpMat = CMPLX(0.0,0.0)
WRITE (6,FMT=8000)
WRITE (16,FMT=8000)
......@@ -142,11 +143,11 @@ CONTAINS
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_CDN_const
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
! CLASSICAL HELLMAN-FEYNMAN FORCE
CALL force_a3(atoms,sphhar, input, rho,vCoul%mt, results%force)
CALL force_a3(atoms,sphhar, input, den%mt,vCoul%mt, results%force)
IF (input%l_f) THEN
! core contribution to force: needs TOTAL POTENTIAL and core charge
......@@ -160,7 +161,7 @@ CONTAINS
IF (input%jspins.EQ.2) THEN
DO n = 1,atoms%ntype
DO i = 1,atoms%jri(n)
rho(i,0,n,1) = rho(i,0,n,1) + rho(i,0,n,input%jspins)
den%mt(i,0,n,1) = den%mt(i,0,n,1) + den%mt(i,0,n,input%jspins)
ENDDO
ENDDO
END IF
......@@ -169,7 +170,7 @@ CONTAINS
!
DO n = 1,atoms%ntype
DO j = 1,atoms%jri(n)
dpj(j) = rho(j,0,n,1)/atoms%rmsh(j,n)
dpj(j) = den%mt(j,0,n,1)/atoms%rmsh(j,n)
ENDDO
CALL intgr3(dpj,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),rhs)
!
......@@ -178,7 +179,7 @@ CONTAINS
zintn_r(n) = atoms%neq(n)*atoms%zatom(n)*sfp_const*rhs/2.
WRITE (6,FMT=8045) zintn_r(n)
WRITE (16,FMT=8045) zintn_r(n)
CALL intgr3(rho(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),totz)
CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),totz)
vmd(n) = atoms%rmt(n)*atoms%vr0(n)/sfp_const + atoms%zatom(n) - totz*sfp_const
vmd(n) = -atoms%neq(n)*atoms%zatom(n)*vmd(n)/ (2.*atoms%rmt(n))
WRITE (6,FMT=8050) n,vmd(n)
......@@ -265,7 +266,5 @@ CONTAINS
/,' ----> HF input%total electron energy=',t40,f20.10,' htr')
8090 FORMAT (/,/,' ----> correction for lda+U =',t40,f20.10,' htr')
DEALLOCATE (rho,rht,qpw,rhtxy)
END SUBROUTINE totale
END MODULE m_totale
......@@ -89,7 +89,8 @@ CONTAINS
! mix here straight with given mixing factors
ALLOCATE (n_mmp(-3:3,-3:3,atoms%n_u,input%jspins))
ALLOCATE (n_mmp(-3:3,-3:3,MAX(1,atoms%n_u),input%jspins))
n_mmp = CMPLX(0.0,0.0)
alpha = input%ldauMixParam
spinf = input%ldauSpinf
......
......@@ -51,15 +51,9 @@ CONTAINS
END IF
END IF
IF((mpi%irank.NE.0).AND.l_denMatAlloc) THEN
IF ((atoms%n_u.GT.0)) THEN
IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
ALLOCATE(potDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
END IF
ELSE
IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
ALLOCATE(potDen%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2))
END IF
ENDIF
IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
ALLOCATE(potDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
END IF
END IF
n = stars%ng3 * input%jspins
......
......@@ -3,9 +3,10 @@ contains
SUBROUTINE bmt(&
& stars,input,noco,atoms,sphhar,vacuum,&
& cell,sym,oneD)
!
use m_types
use m_juDFT
USE m_constants
USE m_types
USE m_juDFT
USE m_cdn_io
USE m_wrtdop
IMPLICIT NONE
......@@ -19,18 +20,14 @@ contains
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER k,i,ivac ,it
TYPE(t_potden) :: den
INTEGER k,i,ivac
INTEGER type,typmag, archiveType
REAL fermiEnergyTemp
LOGICAL l_qfix
CHARACTER(len=8) filename
COMPLEX, ALLOCATABLE :: fpw(:,:),fzxy(:,:,:,:)
REAL, ALLOCATABLE :: fz(:,:,:),fr(:,:,:,:)
COMPLEX, ALLOCATABLE :: cdom(:),cdomvz(:,:),cdomvxy(:,:,:)
! ..
! ..
CHARACTER(len=8) filename
typmag= atoms%ntype
! only muffin-tins with type <= typmag remain magnetic
......@@ -43,42 +40,46 @@ contains
!atoms%jmtd = maxval(atoms%jri(:))
!sphhar%nlhd = maxval(sphhar%nlh(:))
ALLOCATE(fpw(stars%ng3,input%jspins),fzxy(vacuum%nmzxy,stars%ng2-1,2,input%jspins))
ALLOCATE(fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),fz(vacuum%nmz,2,input%jspins))
ALLOCATE(cdom(stars%ng3),cdomvz(vacuum%nmzd,2),cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
CALL den%init(stars,atoms,sphhar,vacuum,oneD,input%jspins,.FALSE.,POTDEN_TYPE_DEN)
IF(noco%l_noco) THEN
ALLOCATE(den%cdom(stars%ng3))
ALLOCATE(den%cdomvz(vacuum%nmz,2),den%cdomvxy(vacuum%nmzxy,stars%ng2-1,2))
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE
ALLOCATE (den%cdom(1),den%cdomvz(1,1),den%cdomvxy(1,1,1))
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
END IF
ALLOCATE (den%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
den%mmpMat = CMPLX(0.0,0.0)
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,it,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
IF ( typmag < atoms%ntype ) THEN
DO type= typmag+1,atoms%ntype
DO k= 0,sphhar%nlhd
DO i= 1,atoms%jmtd
fr(i,k,type,1)= ( fr(i,k,type,1) + fr(i,k,type,2) )/2.
fr(i,k,type,2)= fr(i,k,type,1)
den%mt(i,k,type,1)= (den%mt(i,k,type,1) + den%mt(i,k,type,2))/2.
den%mt(i,k,type,2)= den%mt(i,k,type,1)
ENDDO
ENDDO
ENDDO
ENDIF
DO k= 1,stars%ng3
fpw(k,1)= ( fpw(k,1) + fpw(k,2) )/2.
fpw(k,2)= fpw(k,1)
den%pw(k,1)= (den%pw(k,1) + den%pw(k,2))/2.0
den%pw(k,2)= den%pw(k,1)
ENDDO
IF (input%film) THEN
DO ivac= 1,vacuum%nvac
DO i= 1,vacuum%nmz
fz(i,ivac,1)= ( fz(i,ivac,1) + fz(i,ivac,2) )/2.
fz(i,ivac,2)= fz(i,ivac,1)
den%vacz(i,ivac,1)= (den%vacz(i,ivac,1) + den%vacz(i,ivac,2))/2.0
den%vacz(i,ivac,2)= den%vacz(i,ivac,1)
ENDDO
DO k= 2,stars%ng2
DO i= 1,vacuum%nmzxy
fzxy(i,k-1,ivac,1)= &
& ( fzxy(i,k-1,ivac,1) + fzxy(i,k-1,ivac,2) )/2.
fzxy(i,k-1,ivac,2)= fzxy(i,k-1,ivac,1)
den%vacxy(i,k-1,ivac,1)= (den%vacxy(i,k-1,ivac,1) + den%vacxy(i,k-1,ivac,2))/2.0
den%vacxy(i,k-1,ivac,2)= den%vacxy(i,k-1,ivac,1)
ENDDO
ENDDO
ENDDO
......@@ -95,11 +96,8 @@ contains
CALL wrtdop(&
& stars,vacuum,atoms,sphhar,input,sym,&
& 98,&
& it,fr,fpw,fz,fzxy)
& den%iter,den%mt,den%pw,den%vacz,den%vacxy)
CLOSE(98)
DEALLOCATE(cdom,cdomvz,cdomvxy)
DEALLOCATE(fpw,fzxy,fr,fz)
END SUBROUTINE bmt
END MODULE m_bmt
......@@ -18,7 +18,7 @@
& stars,sym,oneD,cell,DIMENSION)
USE m_intgr, ONLY : intgr3
USE m_constants, ONLY : pi_const
USE m_constants
USE m_cdn_io
USE m_types
IMPLICIT NONE
......@@ -32,19 +32,19 @@
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dimension),INTENT(IN) :: DIMENSION
! ..
! local type instances
TYPE(t_potden) :: den
! .. Local Scalars ..
REAL dummy,p,pp,qtot1,qtot2,spmtot,qval,sfp,fermiEnergyTemp
INTEGER i,iter,ivac,j,k,lh,n,na,jsp_new
INTEGER i,ivac,j,k,lh,n,na,jsp_new
INTEGER ios
LOGICAL n_exist,l_qfix
! ..
! .. Local Arrays ..
REAL rhoc(atoms%jmtd,atoms%ntype,dimension%jspd)
REAL tec(atoms%ntype,dimension%jspd),qintc(atoms%ntype,dimension%jspd)
COMPLEX :: cdom(1),cdomvz(1,1),cdomvxy(1,1,1)
COMPLEX, ALLOCATABLE :: qpw(:,:),rhtxy(:,:,:,:)
REAL , ALLOCATABLE :: rho(:,:,:,:),rht(:,:,:)
CHARACTER(len=140), ALLOCATABLE :: clines(:)
CHARACTER(len=140) :: lineread
! ..
......@@ -54,13 +54,17 @@
IF (input%jspins/=2) CALL juDFT_error&
& ("cdnsp: set jspins = 2 and remove fl7para!",calledby&
& ="cdnsp")
ALLOCATE ( rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),qpw(stars%ng3,input%jspins) )
ALLOCATE ( rhtxy(vacuum%nmzxy,stars%ng2-1,2,input%jspins),rht(vacuum%nmz,2,input%jspins) )
CALL den%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_DEN)
ALLOCATE (den%cdom(1),den%cdomvz(1,1),den%cdomvxy(1,1,1))
ALLOCATE (den%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
den%mmpMat = CMPLX(0.0,0.0)
input%jspins=1
CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc)
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den%iter,den%mt,den%pw,den%vacz,&
den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
input%jspins=2
qval = 0.
......@@ -71,45 +75,46 @@
!
DO n = 1,atoms%ntype
DO j = 1,atoms%jri(n)
rho(j,0,n,1) = rho(j,0,n,1) - rhoc(j,n,1)/sfp
den%mt(j,0,n,1) = den%mt(j,0,n,1) - rhoc(j,n,1)/sfp
ENDDO
! WRITE (16,FMT='(8f10.4)') (rho(i,0,n,1),i=1,16)
CALL intgr3(rho(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qval)
! WRITE (16,FMT='(8f10.4)') (den%mt(i,0,n,1),i=1,16)
CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qval)
p = (atoms%bmu(n)+sfp*qval)/ (2.*sfp*qval)
pp = 1. - p
DO j = 1,atoms%jri(n)
rho(j,0,n,jsp_new) = pp*rho(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
rho(j,0,n,1) = p*rho(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
den%mt(j,0,n,jsp_new) = pp*den%mt(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
den%mt(j,0,n,1) = p*den%mt(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
ENDDO
DO lh = 1,sphhar%nlh(atoms%ntypsy(na))
DO j = 1,atoms%jri(n)
rho(j,lh,n,jsp_new) = pp*rho(j,lh,n,1)
rho(j,lh,n,1) = p*rho(j,lh,n,1)
den%mt(j,lh,n,jsp_new) = pp*den%mt(j,lh,n,1)
den%mt(j,lh,n,1) = p*den%mt(j,lh,n,1)
ENDDO
ENDDO
na = na + atoms%neq(n)
ENDDO
DO k = 1,stars%ng3
qpw(k,jsp_new) = 0.5 * qpw(k,1)
qpw(k,1) = qpw(k,jsp_new)
den%pw(k,jsp_new) = 0.5 * den%pw(k,1)
den%pw(k,1) = den%pw(k,jsp_new)
ENDDO
IF (input%film) THEN
DO ivac = 1,vacuum%nvac
DO j = 1, vacuum%nmz
rht(j,ivac,jsp_new) = 0.5 * rht(j,ivac,1)
rht(j,ivac,1) = rht(j,ivac,jsp_new)
den%vacz(j,ivac,jsp_new) = 0.5 * den%vacz(j,ivac,1)
den%vacz(j,ivac,1) = den%vacz(j,ivac,jsp_new)
ENDDO
DO k = 2, stars%ng2
DO j = 1,vacuum%nmzxy
rhtxy(j,k-1,ivac,jsp_new) = 0.5 * rhtxy(j,k-1,ivac,1)
rhtxy(j,k-1,ivac,1) = rhtxy(j,k-1,ivac,jsp_new)
den%vacxy(j,k-1,ivac,jsp_new) = 0.5 * den%vacxy(j,k-1,ivac,1)
den%vacxy(j,k-1,ivac,1) = den%vacxy(j,k-1,ivac,jsp_new)
ENDDO
ENDDO
ENDDO
ENDIF
! ----> write the spin-polarized density
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
CDN_INPUT_DEN_const,0,-1.0,0.0,.FALSE.,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
CDN_INPUT_DEN_const,0,-1.0,0.0,.FALSE.,den%iter,den%mt,den%pw,den%vacz,den%vacxy,&
den%cdom,den%cdomvz,den%cdomvxy)
!
! -----> This part is only used for testing th e magnetic moment in
! -----> each sphere
......@@ -117,8 +122,8 @@
DO n = 1,atoms%ntype
qtot1=0.00
qtot2=0.00
CALL intgr3(rho(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot1)
CALL intgr3(rho(1,0,n,jsp_new),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot2)
CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot1)
CALL intgr3(den%mt(1,0,n,jsp_new),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot2)
spmtot=sfp*(qtot1-qtot2)
WRITE (6,'('' moment in sphere '',2x,'':'',f8.4)') spmtot
ENDDO
......@@ -150,7 +155,7 @@
WRITE (40,'(a)') TRIM(clines(i))
ENDDO
DEALLOCATE (clines,rho,qpw,rhtxy,rht)
DEALLOCATE (clines)
CLOSE(40)
ENDIF
!
......
This diff is collapsed.
This diff is collapsed.
......@@ -53,18 +53,14 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
! .. Local Scalars ..
REAL :: tec,qint,fermiEnergyTemp,phi0,angss
INTEGER :: i,j,ix,iy,iz,jsp,na,nplo,iv,iflag,nfile
INTEGER :: nplot,nt,jm,jspin,iter,numInFiles,numOutFiles
INTEGER :: nplot,nt,jm,jspin,numInFiles,numOutFiles
LOGICAL :: twodim,oldform,newform,l_qfix
LOGICAL :: cartesian,xsf,unwind,polar
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: qpw(:,:,:)
COMPLEX, ALLOCATABLE :: rhtxy(:,:,:,:,:)
REAL, ALLOCATABLE :: rho(:,:,:,:,:)
REAL, ALLOCATABLE :: rht(:,:,:,:)
TYPE(t_potden), ALLOCATABLE :: den(:)
REAL, ALLOCATABLE :: xdnout(:)
REAL :: pt(3),vec1(3),vec2(3),vec3(3),zero(3),help(3),qssc(3)
COMPLEX :: cdom(1),cdomvz(1,1),cdomvxy(1,1,1)
INTEGER :: grid(3)
REAL :: rhocc(atoms%jmtd)
REAL :: point(3)
......@@ -117,11 +113,8 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
numOutFiles = 1
END IF
END IF
ALLOCATE(den(numInFiles))
ALLOCATE(cdnFilenames(numInFiles))
ALLOCATE(qpw(stars%ng3,input%jspins,numInFiles))
ALLOCATE(rhtxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins,numInFiles))
ALLOCATE(rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins,numInFiles))
ALLOCATE(rht(vacuum%nmzd,2,input%jspins,numInFiles))
IF(PRESENT(cdnfname)) THEN
cdnFilenames(1) = cdnfname
ELSE
......@@ -141,18 +134,22 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
! Read in charge/potential
DO i = 1, numInFiles
CALL den(i)%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_DEN)
ALLOCATE (den(i)%cdom(1),den(i)%cdomvz(1,1),den(i)%cdomvxy(1,1,1))
ALLOCATE (den(i)%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
den(i)%mmpMat = CMPLX(0.0,0.0)
IF(TRIM(ADJUSTL(cdnFilenames(i))).EQ.'cdn1') THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,iter,rho(:,0:,:,:,i),qpw(:,:,i),&
rht(:,:,:,i),rhtxy(:,:,:,:,i),cdom,cdomvz,cdomvxy)
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den(i)%iter,den(i)%mt,den(i)%pw,&
den(i)%vacz,den(i)%vacxy,den(i)%cdom,den(i)%cdomvz,den(i)%cdomvxy)
ELSE IF(TRIM(ADJUSTL(cdnFilenames(i))).EQ.'cdn') THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,&
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,iter,rho(:,0:,:,:,i),qpw(:,:,i),&
rht(:,:,:,i),rhtxy(:,:,:,:,i),cdom,cdomvz,cdomvxy)
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den(i)%iter,den(i)%mt,den(i)%pw,&
den(i)%vacz,den(i)%vacxy,den(i)%cdom,den(i)%cdomvz,den(i)%cdomvxy)
ELSE
OPEN(20,file = cdnFilenames(i),form='unformatted',status='old')
CALL loddop(stars,vacuum,atoms,sphhar,input,sym,20,&
iter,rho(:,0:,:,:,i),qpw(:,:,i),rht(:,:,:,i),rhtxy(:,:,:,:,i))
den(i)%iter,den(i)%mt,den(i)%pw,den(i)%vacz,den(i)%vacxy)
CLOSE(20)
END IF
......@@ -165,12 +162,12 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
jm =