Commit d62d6cb0 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce potden type to even mor files

parent 008b67f2
...@@ -41,7 +41,7 @@ CONTAINS ...@@ -41,7 +41,7 @@ CONTAINS
! *************************************************** ! ***************************************************
! !
USE m_intgr , ONLY : intgr3 USE m_intgr , ONLY : intgr3
USE m_constants, ONLY : sfp_const USE m_constants
USE m_force_a4 USE m_force_a4
USE m_force_a3 USE m_force_a3
USE m_forcew USE m_forcew
...@@ -67,23 +67,24 @@ CONTAINS ...@@ -67,23 +67,24 @@ CONTAINS
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER,INTENT (IN) :: it INTEGER,INTENT (IN) :: it
! ..
! Local type instances
TYPE(t_potden) :: den
! .. Local Scalars .. ! .. Local Scalars ..
REAL rhs,totz, eigSum, fermiEnergyTemp REAL rhs,totz, eigSum, fermiEnergyTemp
INTEGER n,j,nt,iter,i, archiveType INTEGER n,j,nt,i, archiveType
LOGICAL l_qfix LOGICAL l_qfix
! .. Local Arrays .. ! .. Local Arrays ..
REAL vmd(atoms%ntype),zintn_r(atoms%ntype) REAL vmd(atoms%ntype),zintn_r(atoms%ntype)
REAL dpj(atoms%jmtd) REAL dpj(atoms%jmtd)
COMPLEX :: cdom(1),cdomvz(1,1),cdomvxy(1,1,1)
CHARACTER(LEN=20) :: attributes(3) 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),& CALL den%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_DEN)
qpw(stars%ng3,input%jspins),rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)) 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 (6,FMT=8000)
WRITE (16,FMT=8000) WRITE (16,FMT=8000)
...@@ -142,11 +143,11 @@ CONTAINS ...@@ -142,11 +143,11 @@ CONTAINS
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_CDN_const IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_CDN_const
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,& 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 ! 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 IF (input%l_f) THEN
! core contribution to force: needs TOTAL POTENTIAL and core charge ! core contribution to force: needs TOTAL POTENTIAL and core charge
...@@ -160,7 +161,7 @@ CONTAINS ...@@ -160,7 +161,7 @@ CONTAINS
IF (input%jspins.EQ.2) THEN IF (input%jspins.EQ.2) THEN
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
DO i = 1,atoms%jri(n) 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
ENDDO ENDDO
END IF END IF
...@@ -169,7 +170,7 @@ CONTAINS ...@@ -169,7 +170,7 @@ CONTAINS
! !
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
DO j = 1,atoms%jri(n) 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 ENDDO
CALL intgr3(dpj,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),rhs) CALL intgr3(dpj,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),rhs)
! !
...@@ -178,7 +179,7 @@ CONTAINS ...@@ -178,7 +179,7 @@ CONTAINS
zintn_r(n) = atoms%neq(n)*atoms%zatom(n)*sfp_const*rhs/2. zintn_r(n) = atoms%neq(n)*atoms%zatom(n)*sfp_const*rhs/2.
WRITE (6,FMT=8045) zintn_r(n) WRITE (6,FMT=8045) zintn_r(n)
WRITE (16,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%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)) vmd(n) = -atoms%neq(n)*atoms%zatom(n)*vmd(n)/ (2.*atoms%rmt(n))
WRITE (6,FMT=8050) n,vmd(n) WRITE (6,FMT=8050) n,vmd(n)
...@@ -265,7 +266,5 @@ CONTAINS ...@@ -265,7 +266,5 @@ CONTAINS
/,' ----> HF input%total electron energy=',t40,f20.10,' htr') /,' ----> HF input%total electron energy=',t40,f20.10,' htr')
8090 FORMAT (/,/,' ----> correction for lda+U =',t40,f20.10,' htr') 8090 FORMAT (/,/,' ----> correction for lda+U =',t40,f20.10,' htr')
DEALLOCATE (rho,rht,qpw,rhtxy)
END SUBROUTINE totale END SUBROUTINE totale
END MODULE m_totale END MODULE m_totale
...@@ -3,9 +3,10 @@ contains ...@@ -3,9 +3,10 @@ contains
SUBROUTINE bmt(& SUBROUTINE bmt(&
& stars,input,noco,atoms,sphhar,vacuum,& & stars,input,noco,atoms,sphhar,vacuum,&
& cell,sym,oneD) & cell,sym,oneD)
!
use m_types USE m_constants
use m_juDFT USE m_types
USE m_juDFT
USE m_cdn_io USE m_cdn_io
USE m_wrtdop USE m_wrtdop
IMPLICIT NONE IMPLICIT NONE
...@@ -19,18 +20,14 @@ contains ...@@ -19,18 +20,14 @@ contains
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER k,i,ivac ,it
TYPE(t_potden) :: den
INTEGER k,i,ivac
INTEGER type,typmag, archiveType INTEGER type,typmag, archiveType
REAL fermiEnergyTemp REAL fermiEnergyTemp
LOGICAL l_qfix LOGICAL l_qfix
CHARACTER(len=8) filename CHARACTER(len=8) filename
COMPLEX, ALLOCATABLE :: fpw(:,:),fzxy(:,:,:,:)
REAL, ALLOCATABLE :: fz(:,:,:),fr(:,:,:,:)
COMPLEX, ALLOCATABLE :: cdom(:),cdomvz(:,:),cdomvxy(:,:,:)
! ..
! ..
typmag= atoms%ntype typmag= atoms%ntype
! only muffin-tins with type <= typmag remain magnetic ! only muffin-tins with type <= typmag remain magnetic
...@@ -43,42 +40,46 @@ contains ...@@ -43,42 +40,46 @@ contains
!atoms%jmtd = maxval(atoms%jri(:)) !atoms%jmtd = maxval(atoms%jri(:))
!sphhar%nlhd = maxval(sphhar%nlh(:)) !sphhar%nlhd = maxval(sphhar%nlh(:))
ALLOCATE(fpw(stars%ng3,input%jspins),fzxy(vacuum%nmzxy,stars%ng2-1,2,input%jspins)) CALL den%init(stars,atoms,sphhar,vacuum,oneD,input%jspins,.FALSE.,POTDEN_TYPE_DEN)
ALLOCATE(fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),fz(vacuum%nmz,2,input%jspins)) IF(noco%l_noco) THEN
ALLOCATE(cdom(stars%ng3),cdomvz(vacuum%nmzd,2),cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)) ALLOCATE(den%cdom(stars%ng3))
ALLOCATE(den%cdomvz(vacuum%nmz,2),den%cdomvxy(vacuum%nmzxy,stars%ng2-1,2))
archiveType = CDN_ARCHIVE_TYPE_CDN1_const archiveType = CDN_ARCHIVE_TYPE_NOCO_const
IF (noco%l_noco) 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,& 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 IF ( typmag < atoms%ntype ) THEN
DO type= typmag+1,atoms%ntype DO type= typmag+1,atoms%ntype
DO k= 0,sphhar%nlhd DO k= 0,sphhar%nlhd
DO i= 1,atoms%jmtd DO i= 1,atoms%jmtd
fr(i,k,type,1)= ( fr(i,k,type,1) + fr(i,k,type,2) )/2. den%mt(i,k,type,1)= (den%mt(i,k,type,1) + den%mt(i,k,type,2))/2.
fr(i,k,type,2)= fr(i,k,type,1) den%mt(i,k,type,2)= den%mt(i,k,type,1)
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
ENDIF ENDIF
DO k= 1,stars%ng3 DO k= 1,stars%ng3
fpw(k,1)= ( fpw(k,1) + fpw(k,2) )/2. den%pw(k,1)= (den%pw(k,1) + den%pw(k,2))/2.0
fpw(k,2)= fpw(k,1) den%pw(k,2)= den%pw(k,1)
ENDDO ENDDO
IF (input%film) THEN IF (input%film) THEN
DO ivac= 1,vacuum%nvac DO ivac= 1,vacuum%nvac
DO i= 1,vacuum%nmz DO i= 1,vacuum%nmz
fz(i,ivac,1)= ( fz(i,ivac,1) + fz(i,ivac,2) )/2. den%vacz(i,ivac,1)= (den%vacz(i,ivac,1) + den%vacz(i,ivac,2))/2.0
fz(i,ivac,2)= fz(i,ivac,1) den%vacz(i,ivac,2)= den%vacz(i,ivac,1)
ENDDO ENDDO
DO k= 2,stars%ng2 DO k= 2,stars%ng2
DO i= 1,vacuum%nmzxy DO i= 1,vacuum%nmzxy
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
& ( fzxy(i,k-1,ivac,1) + fzxy(i,k-1,ivac,2) )/2. den%vacxy(i,k-1,ivac,2)= den%vacxy(i,k-1,ivac,1)
fzxy(i,k-1,ivac,2)= fzxy(i,k-1,ivac,1)
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -95,11 +96,8 @@ contains ...@@ -95,11 +96,8 @@ contains
CALL wrtdop(& CALL wrtdop(&
& stars,vacuum,atoms,sphhar,input,sym,& & stars,vacuum,atoms,sphhar,input,sym,&
& 98,& & 98,&
& it,fr,fpw,fz,fzxy) & den%iter,den%mt,den%pw,den%vacz,den%vacxy)
CLOSE(98) CLOSE(98)
DEALLOCATE(cdom,cdomvz,cdomvxy)
DEALLOCATE(fpw,fzxy,fr,fz)
END SUBROUTINE bmt END SUBROUTINE bmt
END MODULE m_bmt END MODULE m_bmt
...@@ -53,18 +53,14 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& ...@@ -53,18 +53,14 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
! .. Local Scalars .. ! .. Local Scalars ..
REAL :: tec,qint,fermiEnergyTemp,phi0,angss REAL :: tec,qint,fermiEnergyTemp,phi0,angss
INTEGER :: i,j,ix,iy,iz,jsp,na,nplo,iv,iflag,nfile 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 :: twodim,oldform,newform,l_qfix
LOGICAL :: cartesian,xsf,unwind,polar LOGICAL :: cartesian,xsf,unwind,polar
! .. Local Arrays .. ! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: qpw(:,:,:) TYPE(t_potden), ALLOCATABLE :: den(:)
COMPLEX, ALLOCATABLE :: rhtxy(:,:,:,:,:)
REAL, ALLOCATABLE :: rho(:,:,:,:,:)
REAL, ALLOCATABLE :: rht(:,:,:,:)
REAL, ALLOCATABLE :: xdnout(:) REAL, ALLOCATABLE :: xdnout(:)
REAL :: pt(3),vec1(3),vec2(3),vec3(3),zero(3),help(3),qssc(3) 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) INTEGER :: grid(3)
REAL :: rhocc(atoms%jmtd) REAL :: rhocc(atoms%jmtd)
REAL :: point(3) REAL :: point(3)
...@@ -117,11 +113,8 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& ...@@ -117,11 +113,8 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
numOutFiles = 1 numOutFiles = 1
END IF END IF
END IF END IF
ALLOCATE(den(numInFiles))
ALLOCATE(cdnFilenames(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 IF(PRESENT(cdnfname)) THEN
cdnFilenames(1) = cdnfname cdnFilenames(1) = cdnfname
ELSE ELSE
...@@ -141,18 +134,22 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& ...@@ -141,18 +134,22 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
! Read in charge/potential ! Read in charge/potential
DO i = 1, numInFiles 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 IF(TRIM(ADJUSTL(cdnFilenames(i))).EQ.'cdn1') THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,& 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),& CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den(i)%iter,den(i)%mt,den(i)%pw,&
rht(:,:,:,i),rhtxy(:,:,:,:,i),cdom,cdomvz,cdomvxy) den(i)%vacz,den(i)%vacxy,den(i)%cdom,den(i)%cdomvz,den(i)%cdomvxy)
ELSE IF(TRIM(ADJUSTL(cdnFilenames(i))).EQ.'cdn') THEN ELSE IF(TRIM(ADJUSTL(cdnFilenames(i))).EQ.'cdn') THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,& 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),& CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den(i)%iter,den(i)%mt,den(i)%pw,&
rht(:,:,:,i),rhtxy(:,:,:,:,i),cdom,cdomvz,cdomvxy) den(i)%vacz,den(i)%vacxy,den(i)%cdom,den(i)%cdomvz,den(i)%cdomvxy)
ELSE ELSE
OPEN(20,file = cdnFilenames(i),form='unformatted',status='old') OPEN(20,file = cdnFilenames(i),form='unformatted',status='old')
CALL loddop(stars,vacuum,atoms,sphhar,input,sym,20,& 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) CLOSE(20)
END IF END IF
...@@ -165,12 +162,12 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& ...@@ -165,12 +162,12 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
jm = atoms%jri(nt) jm = atoms%jri(nt)
READ (17) (rhocc(j),j=1,jm) READ (17) (rhocc(j),j=1,jm)
DO j = 1, atoms%jri(nt) 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 END DO
READ (17) tec READ (17) tec
END DO END DO
READ (17) qint 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 END DO
CLOSE (17) CLOSE (17)
ELSE IF (input%score) THEN ELSE IF (input%score) THEN
...@@ -295,8 +292,8 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& ...@@ -295,8 +292,8 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
DO i = 1, numInFiles DO i = 1, numInFiles
CALL outcdn(pt,nt,na,iv,iflag,jsp,sliceplot,stars,& CALL outcdn(pt,nt,na,iv,iflag,jsp,sliceplot,stars,&
vacuum,sphhar,atoms,sym,cell,oneD,& vacuum,sphhar,atoms,sym,cell,oneD,&
qpw(:,:,i),rhtxy(:,:,:,:,i),rho(:,0:,:,:,i),& den(i)%pw,den(i)%vacxy,den(i)%mt,&
rht(:,:,:,i),xdnout(i)) den(i)%vacz,xdnout(i))
END DO END DO
IF (na.NE.0) THEN IF (na.NE.0) THEN
...@@ -394,7 +391,7 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,& ...@@ -394,7 +391,7 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
END DO END DO
END IF END IF
DEALLOCATE(rho, qpw, rhtxy, rht, xdnout, cdnFilenames, outFilenames) DEALLOCATE(xdnout, cdnFilenames, outFilenames)
END SUBROUTINE plotdop 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