Commit d62d6cb0 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce potden type to even mor files

parent 008b67f2
......@@ -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
......@@ -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
......@@ -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 = atoms%jri(nt)
READ (17) (rhocc(j),j=1,jm)
DO j = 1, atoms%jri(nt)
rho(j,0,nt,jspin,i) = rho(j,0,nt,jspin,i) - rhocc(j)/2.0/SQRT(pi_const)
den(i)%mt(j,0,nt,jspin) = den(i)%mt(j,0,nt,jspin) - rhocc(j)/2.0/SQRT(pi_const)
END DO
READ (17) tec
END DO
READ (17) qint
qpw(1,jspin,i) = qpw(1,jspin,i) - qint/cell%volint
den(i)%pw(1,jspin) = den(i)%pw(1,jspin) - qint/cell%volint
END DO
CLOSE (17)
ELSE IF (input%score) THEN
......@@ -295,8 +292,8 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
DO i = 1, numInFiles
CALL outcdn(pt,nt,na,iv,iflag,jsp,sliceplot,stars,&
vacuum,sphhar,atoms,sym,cell,oneD,&
qpw(:,:,i),rhtxy(:,:,:,:,i),rho(:,0:,:,:,i),&
rht(:,:,:,i),xdnout(i))
den(i)%pw,den(i)%vacxy,den(i)%mt,&
den(i)%vacz,xdnout(i))
END DO
IF (na.NE.0) THEN
......@@ -394,7 +391,7 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
END DO
END IF
DEALLOCATE(rho, qpw, rhtxy, rht, xdnout, cdnFilenames, outFilenames)
DEALLOCATE(xdnout, cdnFilenames, outFilenames)
END SUBROUTINE plotdop
......
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