Skip to content

GitLab

fleur
fleur
Commit dfec2957 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Introduce potden type to some files + some cleanup

parent 9b164562
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 888 additions and 955 deletions
global/types.F90
View file @ dfec2957
......@@ -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
......
optional/cdnsp.f90
View file @ dfec2957
......@@ -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
!
......
optional/flipcdn.f90
View file @ dfec2957
This diff is collapsed.
optional/pldngen.f90
View file @ dfec2957
This diff is collapsed.
optional/stden.f90
View file @ dfec2957
This diff is collapsed.
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