Commit 7b36fed8 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce wrapper for checkdop calls

parent c9f6719d
......@@ -53,8 +53,6 @@ CONTAINS
USE m_rhomtlo
USE m_rhonmtlo
USE m_mcdinit
USE m_sphpts
USE m_points
USE m_sympsi
USE m_enpara, ONLY : w_enpara,mix_enpara
USE m_eparas ! energy parameters and partial charges
......@@ -68,7 +66,7 @@ CONTAINS
USE m_forcea8
USE m_forcea12
USE m_forcea21
USE m_checkdop ! check continuity of density on MT radius R
USE m_checkdopall
USE m_int21 ! integrate (spin) off-diagonal radial functions
USE m_int21lo ! -"- for u_lo
USE m_rhomt21 ! calculate (spin) off-diagonal MT-density coeff's
......@@ -83,7 +81,6 @@ CONTAINS
USE m_Ekwritesl ! and write to file.
USE m_abcrot2
USE m_doswrite
USE m_cylpts
USE m_cdnread, ONLY : cdn_read0, cdn_read
USE m_corespec, only : l_cs ! calculation of core spectra (EELS)
USE m_corespec_io, only : corespec_init
......@@ -133,17 +130,17 @@ CONTAINS
! .. Local Scalars ..
TYPE(t_lapw):: lapw
INTEGER :: llpd
REAL wronk,sign,emcd_lo,emcd_up
REAL wronk,emcd_lo,emcd_up
INTEGER i,ie,iv,ivac,j,k,l,l1,lh ,n,ilo,isp,nat,&
nbands,noded,nodeu,noccbd,nslibd,na,&
ikpt,npd ,jsp_start,jsp_end,ispin
ikpt,jsp_start,jsp_end,ispin
INTEGER skip_t,skip_tt
INTEGER n_size,i_rec,n_rank ,ncored,n_start,n_end,noccbd_l
COMPLEX,parameter:: czero=(0.0,0.0)
LOGICAL l_fmpl,l_mcd,l_evp,l_orbcomprot
! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd),ncore(atoms%ntype)
REAL cartk(3),xp(3,dimension%nspd),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL cartk(3),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL eig(dimension%neigd)
REAL vz0(2)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
......@@ -967,48 +964,11 @@ CONTAINS
!---> check continuity of charge density
IF (input%cdinf) THEN
CALL timestart("cdnval: cdninf-stuff")
WRITE (6,FMT=8210) ispin
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
IF (input%film .AND. .NOT.oneD%odi%d1) THEN
!---> vacuum boundaries
npd = min(dimension%nspd,25)
CALL points(xp,npd)
DO ivac = 1,vacuum%nvac
sign = 3. - 2.*ivac
DO j = 1,npd
xp(3,j) = sign*cell%z1/cell%amat(3,3)
END DO
CALL checkdop(&
xp,npd,0,0,ivac,1,ispin,.true.,dimension,atoms,&
sphhar,stars,sym,&
vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
END DO
ELSE IF (oneD%odi%d1) THEN
!-odim
npd = min(dimension%nspd,25)
CALL cylpts(xp,npd,cell%z1)
CALL checkdop(&
xp,npd,0,0,ivac,1,ispin,.true.,dimension,atoms,&
sphhar,stars,sym,&
vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
!+odim
END IF
!---> m.t. boundaries
nat = 1
DO n = 1, atoms%ntype
CALL sphpts(xp,dimension%nspd,atoms%rmt(n),atoms%pos(1,atoms%nat))
CALL checkdop(&
xp,dimension%nspd,n,nat,0,-1,ispin,.true.,&
dimension,atoms,sphhar,stars,sym,&
vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
nat = nat + atoms%neq(n)
END DO
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,den,ispin)
CALL timestop("cdnval: cdninf-stuff")
END IF
!+for
!---> forces of equ. A8 of Yu et al.
......
......@@ -20,6 +20,7 @@ global/savewigner.f
set(fleur_F90 ${fleur_F90}
global/constants.f90
global/checkdop.F90
global/checkdopall.f90
global/chkmt.f90
global/convn.f90
global/enpara.f90
......
MODULE m_checkdop
CONTAINS
SUBROUTINE checkdop(&
& p,np,n,na,ivac,iflag,jsp,cdn,&
& p,np,n,na,ivac,iflag,jsp,&
& DIMENSION,atoms,sphhar,stars,sym,&
& vacuum,cell,oneD,&
& fpw,fr,fxy,fz)
& vacuum,cell,oneD,potden)
! ************************************************************
! subroutines checks the continuity of coulomb *
! potential or valence charge density *
......@@ -14,6 +13,7 @@
! YM: this routine doesn't really work in the vacuum in 1D case yet
! ************************************************************
USE m_juDFT
USE m_starf, ONLY : starf2,starf3
USE m_angle
USE m_ylm
......@@ -23,32 +23,37 @@
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
TYPE(t_dimension),INTENT(IN):: dimension
type(t_sphhar),intent(in):: sphhar
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN):: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dimension),INTENT(IN) :: dimension
type(t_sphhar),intent(in) :: sphhar
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: potden
INTEGER, INTENT (IN) :: iflag,ivac,n,na,np,jsp
LOGICAL, INTENT (IN) :: cdn
INTEGER, INTENT (IN) :: iflag,ivac,n,na,np,jsp
!-odim
!+odim
! .. Array Arguments ..
REAL, INTENT (IN) :: p(3,DIMENSION%nspd)
REAL, INTENT (IN) :: fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd),fz(vacuum%nmzd,2,DIMENSION%jspd)
COMPLEX, INTENT (IN) :: fpw(stars%ng3,DIMENSION%jspd),fxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd)
REAL, INTENT (IN) :: p(3,DIMENSION%nspd)
! ..
! .. Local Scalars ..
REAL av,dms,rms,s,ir2,help,phi
INTEGER i,j,k,lh,mem,nd,lm,ll1,nopa ,gz,m
COMPLEX ic
LOGICAL l_cdn
! ..
! .. Local Arrays ..
COMPLEX sf2(stars%ng2),sf3(stars%ng3),ylm( (atoms%lmaxd+1)**2 )
REAL rcc(3),v1(DIMENSION%nspd),v2(DIMENSION%nspd),x(3),ri(3)
l_cdn = .FALSE. ! By default we assume that the input is a potential.
IF (potden%potdenType.LE.0) CALL juDFT_error('unknown potden type', calledby='checkdop')
IF (potden%potdenType.GT.1000) l_cdn = .TRUE. ! potdenTypes > 1000 are reserved for densities
! ..
! ..
#ifdef __TOS_BGQ__
......@@ -75,11 +80,11 @@
ENDIF
v1(j) = 0.0
DO k = 1,stars%ng3
v1(j) = v1(j) + REAL(fpw(k,jsp)*sf3(k))*stars%nstr(k)
v1(j) = v1(j) + REAL(potden%pw(k,jsp)*sf3(k))*stars%nstr(k)
ENDDO
ENDDO
! ---> vacuum part
IF (cdn) THEN
IF (l_cdn) THEN
WRITE (6,FMT=9000) ivac
WRITE (16,FMT=9000) ivac
ELSE
......@@ -91,18 +96,18 @@
CALL starf2(&
& sym%nop2,stars%ng2,stars%kv2,sym%mrot,sym%symor,sym%tau,p(1,j),sym%invtab,&
& sf2)!keep
v2(j) = fz(1,ivac,jsp)
v2(j) = potden%vacz(1,ivac,jsp)
DO k = 2,stars%ng2
v2(j) = v2(j) + REAL(fxy(1,k-1,ivac,jsp)*sf2(k))*stars%nstr2(k)
v2(j) = v2(j) + REAL(potden%vacxy(1,k-1,ivac,jsp)*sf2(k))*stars%nstr2(k)
ENDDO
ELSE
!-odim
v2(j) = fz(1,ivac,jsp)
v2(j) = potden%vacz(1,ivac,jsp)
phi = angle(p(1,j),p(2,j))
DO k = 2,oneD%odi%nq2
m = oneD%odi%kv(2,k)
gz = oneD%odi%kv(1,k)
v2(j) = v2(j) + REAL(fxy(1,k-1,ivac,jsp)*&
v2(j) = v2(j) + REAL(potden%vacxy(1,k-1,ivac,jsp)*&
& EXP(ic*m*phi)*EXP(ic*cell%bmat(3,3)*gz*p(3,j)))*oneD%odi%nst2(k)
ENDDO
!+odim
......@@ -136,11 +141,11 @@
!
v1(j) = 0.0
DO k = 1,stars%ng3
v1(j) = v1(j) + REAL(fpw(k,jsp)*sf3(k))*stars%nstr(k)
v1(j) = v1(j) + REAL(potden%pw(k,jsp)*sf3(k))*stars%nstr(k)
ENDDO
ENDDO
! ----> m.t. part
IF (cdn) THEN
IF (l_cdn) THEN
WRITE (6,FMT=9010) n
WRITE (16,FMT=9010) n
ELSE
......@@ -148,7 +153,7 @@
WRITE (16,FMT=8010) n
ENDIF
ir2 = 1.0
IF (cdn) ir2 = 1.0 / ( atoms%rmt(n)*atoms%rmt(n) )
IF (l_cdn) ir2 = 1.0 / ( atoms%rmt(n)*atoms%rmt(n) )
nd = atoms%ntypsy(na)
nopa = atoms%ngopr(na)
IF (oneD%odi%d1) THEN
......@@ -190,7 +195,7 @@
lm = ll1 + sphhar%mlh(mem,lh,nd)
s = s + REAL( sphhar%clnu(mem,lh,nd)* ylm(lm) )
ENDDO
help = help + fr(atoms%jri(n),lh,n,jsp) * s
help = help + potden%mt(atoms%jri(n),lh,n,jsp) * s
ENDDO
v2(j) = help * ir2
IF (j.LE.8) THEN
......
MODULE m_checkdopall
CONTAINS
SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,potden,ispin)
USE m_sphpts
USE m_checkdop
USE m_types
USE m_cylpts
USE m_points
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_sphhar),intent(in) :: sphhar
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: potden
INTEGER, INTENT(IN) :: ispin
INTEGER :: npd, nat, n, ivac
REAL :: signum
REAL :: xp(3,dimension%nspd)
IF ((input%film).AND.(.NOT.oneD%odi%d1)) THEN
!---> vacuum boundaries
npd = min(dimension%nspd,25)
CALL points(xp,npd)
DO ivac = 1,vacuum%nvac
signum = 3.0 - 2.0*ivac
xp(3,:npd) = signum*cell%z1/cell%amat(3,3)
CALL checkdop(xp,npd,0,0,ivac,1,ispin,dimension,atoms,&
sphhar,stars,sym,vacuum,cell,oneD,potden)
END DO
ELSE IF (oneD%odi%d1) THEN
!-odim
npd = min(dimension%nspd,25)
CALL cylpts(xp,npd,cell%z1)
CALL checkdop(xp,npd,0,0,ivac,1,ispin,dimension,atoms,&
sphhar,stars,sym,vacuum,cell,oneD,potden)
!+odim
END IF
!---> m.t. boundaries
nat = 1
DO n = 1, atoms%ntype
CALL sphpts(xp,dimension%nspd,atoms%rmt(n),atoms%pos(1,atoms%nat))
CALL checkdop(xp,dimension%nspd,n,nat,0,-1,ispin,&
dimension,atoms,sphhar,stars,sym,vacuum,cell,oneD,potden)
nat = nat + atoms%neq(n)
END DO
END SUBROUTINE checkDOPAll
END MODULE m_checkdopall
......@@ -20,12 +20,11 @@ MODULE m_constants
REAL, PARAMETER :: eVac0Default_const = -0.25
CHARACTER(len=9), PARAMETER :: version_const = 'fleur 27'
INTEGER, PARAMETER :: POTDEN_TYPE_OTHER = 0
INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1
INTEGER, PARAMETER :: POTDEN_TYPE_OTHER = 0 ! POTDEN_TYPE <= 0 ==> undefined
INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1 ! 0 < POTDEN_TYPE <= 1000 ==> potential
INTEGER, PARAMETER :: POTDEN_TYPE_POTCOUL = 2
INTEGER, PARAMETER :: POTDEN_TYPE_POTX = 3
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/&
'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',&
......
......@@ -31,22 +31,19 @@ CONTAINS
USE m_vvacis
USE m_vvacxy
USE m_vintcz
USE m_checkdop
USE m_checkdopall
USE m_wrtdop
USE m_cdn_io
USE m_qfix
USE m_types
USE m_od_vvac
USE m_od_vvacis
USE m_cylpts
USE m_convol
USE m_xyavden
USE m_psqpw
USE m_potmod
USE m_intgr, ONLY : intgr3
USE m_cfft
USE m_sphpts
USE m_points
USE m_fleur_vdw
#ifdef CPP_MPI
USE m_mpi_bc_potden
......@@ -80,11 +77,11 @@ CONTAINS
! .. Local Scalars ..
COMPLEX vintcza,xint,rhobar
INTEGER i,i3,irec2,irec3,ivac,j,js,k,k3,lh,n,nzst1
INTEGER imz,imzxy,ichsmrg,ivfft,npd
INTEGER imz,imzxy,ichsmrg,ivfft
INTEGER ifftd,ifftd2, ifftxc3d,datend
INTEGER itypsym,itype,jsp,l,nat
! INTEGER i_sm,n_sm,i_sta,i_end
REAL ani,g3,signum,z,rhmn,mfie,fermiEnergyTemp
REAL ani,g3,z,rhmn,mfie,fermiEnergyTemp
REAL sig1dh,vz1dh,zat_l(atoms%ntype),rdum,dpdot ! ,delta,deltb,corr
LOGICAL l_pottot,l_vdw,l_qfix
LOGICAL exi
......@@ -93,7 +90,7 @@ CONTAINS
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: alphm(:,:)
COMPLEX, ALLOCATABLE :: excpw(:),excxy(:,:,:),vpw_w(:,:),psq(:)
REAL, ALLOCATABLE :: vbar(:),af1(:),bf1(:),xp(:,:)
REAL, ALLOCATABLE :: vbar(:),af1(:),bf1(:)
REAL, ALLOCATABLE :: rhoc(:,:,:),rhoc_vx(:)
REAL, ALLOCATABLE :: tec(:,:), qintc(:,:)
!.....potential
......@@ -128,7 +125,7 @@ CONTAINS
CALL vx%resetPotDen()
ALLOCATE ( alphm(stars%ng2,2),excpw(stars%ng3),excxy(vacuum%nmzxyd,oneD%odi%n2d-1,2),&
vbar(dimension%jspd),af1(3*stars%mx3),bf1(3*stars%mx3),xp(3,dimension%nspd),&
vbar(dimension%jspd),af1(3*stars%mx3),bf1(3*stars%mx3),&
vpw_exx(stars%ng3,dimension%jspd),vpw_wexx(stars%ng3,dimension%jspd),&
excz(vacuum%nmzd,2),excr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype),&
vpw_w(stars%ng3,dimension%jspd),vxpw_w(stars%ng3,dimension%jspd),psq(stars%ng3) )
......@@ -288,36 +285,8 @@ CONTAINS
IF (input%vchk) THEN
CALL timestart("checking")
! ----> vacuum boundaries
IF (input%film .AND. .NOT.oneD%odi%d1) THEN
npd = MIN(dimension%nspd,25)
CALL points(xp,npd)
DO ivac = 1,vacuum%nvac
signum = 3. - 2.*ivac
xp(3,:npd) = signum*cell%z1/cell%amat(3,3)
CALL checkdop(xp,npd,0,0,ivac,1,1,.FALSE.,dimension,atoms, sphhar,stars,sym,&
vacuum,cell,oneD, vTot%pw,vTot%mt,vTot%vacxy,vTot%vacz)
ENDDO
ELSEIF (oneD%odi%d1) THEN
!-odim
npd = MIN(dimension%nspd,25)
CALL cylpts(xp,npd,cell%z1)
! DO j = 1,npd
! xp(1,j) = xp(1,j)/amat(1,1)
! xp(2,j) = xp(2,j)/amat(2,2)
! ENDDO
CALL checkdop(xp,npd,0,0,vacuum%nvac,1,1,.FALSE.,dimension,atoms,&
sphhar,stars,sym, vacuum,cell,oneD, vTot%pw,vTot%mt,vTot%vacxy,vTot%vacz)
!+odim
END IF
! ----> m.t. boundaries
nat = 1
DO n = 1,atoms%ntype
CALL sphpts(xp,dimension%nspd,atoms%rmt(n),atoms%pos(1,nat))
CALL checkdop(xp,dimension%nspd,n,nat,0,-1,1,.FALSE.,dimension,atoms,&
sphhar,stars,sym, vacuum,cell,oneD, vTot%pw,vTot%mt,vTot%vacxy,vTot%vacz)
nat = nat + atoms%neq(n)
ENDDO
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,vTot,1)
CALL timestop("checking")
END IF
!
......@@ -619,39 +588,10 @@ CONTAINS
! ---> check continuity of total potential
IF (input%vchk) THEN
! ----> vacuum boundaries
IF (input%film .AND. .NOT.oneD%odi%d1) THEN
npd = MIN(dimension%nspd,25)
CALL points(xp,npd)
DO ivac = 1,vacuum%nvac
signum = 3. - 2.*ivac
xp(3,:npd) = signum*cell%z1/cell%amat(3,3)
CALL checkdop(xp,npd,0,0,ivac,1,1,.FALSE.,dimension,atoms, sphhar,stars,sym,&
vacuum,cell,oneD, vTot%pw,vTot%mt,vTot%vacxy,vTot%vacz)
ENDDO ! ivac = 1,vacuum%nvac
ELSEIF (oneD%odi%d1) THEN
!-odim
npd = MIN(dimension%nspd,25)
CALL cylpts(xp,npd,cell%z1)
! DO j = 1,npd
! xp(1,j) = xp(1,j)/amat(1,1)
! xp(2,j) = xp(2,j)/amat(2,2)
! ENDDO
CALL checkdop(xp,npd,0,0,vacuum%nvac,1,1,.FALSE.,dimension,atoms,&
sphhar,stars,sym, vacuum,cell,oneD, vTot%pw,vTot%mt,vTot%vacxy,vTot%vacz)
!+odim
END IF
! ----> m.t. boundaries
nat = 1
DO n = 1, atoms%ntype
CALL sphpts(xp,dimension%nspd,atoms%rmt(n),atoms%pos(1,nat))
CALL checkdop(xp,dimension%nspd,n,nat,0,-1,1,.FALSE.,dimension,&
atoms,sphhar,stars,sym, vacuum,cell,oneD, vTot%pw,vTot%mt,vTot%vacxy,vTot%vacz)
nat = nat + atoms%neq(n)
ENDDO ! n = 1, atoms%ntype
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,vTot,1)
END IF
CALL pot_mod(atoms,sphhar,vacuum,stars, input, vTot%mt,vTot%vacxy,vTot%vacz,vTot%pw,vpw_w)
!
!============TOTAL======================================
......
......@@ -15,19 +15,16 @@ CONTAINS
SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
input,cell,xcpot,obsolete,noco,oneD)
USE m_sphpts
USE m_constants
USE m_enpara, ONLY : w_enpara
USE m_xcall, ONLY : vxcall
USE m_qsf
USE m_checkdop
USE m_checkdopall
USE m_cdnovlp
USE m_cdn_io
USE m_qfix
USE m_atom2
USE m_types
USE m_cylpts
USE m_points
USE m_juDFT_init
IMPLICIT NONE
......@@ -52,14 +49,14 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
TYPE(t_xcpot) :: xcpot_dummy
! Local Scalars
REAL d,del,fix,h,r,rnot,sign,z,bm,qdel
REAL d,del,fix,h,r,rnot,z,bm,qdel
REAL denz1(1),vacxpot(1),vacpot(1)
INTEGER i,ivac,iza,j,jr,k,n,n1,npd,ispin
INTEGER i,ivac,iza,j,jr,k,n,n1,ispin
INTEGER nw,ilo,natot,nat
! Local Arrays
REAL, ALLOCATABLE :: vbar(:,:)
REAL, ALLOCATABLE :: xp(:,:),rat(:,:),eig(:,:,:),sigm(:)
REAL, ALLOCATABLE :: rat(:,:),eig(:,:,:),sigm(:)
REAL, ALLOCATABLE :: rh(:,:,:),rh1(:,:,:),rhoss(:,:)
REAL, ALLOCATABLE :: vacpar(:)
INTEGER lnum(DIMENSION%nstd,atoms%ntype),nst(atoms%ntype)
......@@ -74,7 +71,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
ALLOCATE ( xp(3,DIMENSION%nspd),rat(DIMENSION%msh,atoms%ntype),eig(DIMENSION%nstd,DIMENSION%jspd,atoms%ntype) )
ALLOCATE ( rat(DIMENSION%msh,atoms%ntype),eig(DIMENSION%nstd,DIMENSION%jspd,atoms%ntype) )
ALLOCATE ( rh(DIMENSION%msh,atoms%ntype,DIMENSION%jspd),rh1(DIMENSION%msh,atoms%ntype,DIMENSION%jspd) )
ALLOCATE ( enpara%ello0(atoms%nlod,atoms%ntype,input%jspins),vacpar(2) )
ALLOCATE ( enpara%el0(0:3,atoms%ntype,input%jspins))
......@@ -224,36 +221,8 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
IF (input%vchk) THEN
DO ispin = 1, input%jspins
WRITE (6,'(a8,i2)') 'spin No.',ispin
IF (input%film .AND. .NOT.oneD%odi%d1) THEN
! vacuum boundaries
npd = MIN(DIMENSION%nspd,25)
CALL points(xp,npd)
DO ivac = 1,vacuum%nvac
sign = 3. - 2.*ivac
DO j = 1,npd
xp(3,j) = sign*cell%z1/cell%amat(3,3)
END DO
CALL checkdop(xp,npd,0,0,ivac,1,ispin,.TRUE.,DIMENSION,atoms,&
sphhar,stars,sym,vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
END DO
ELSE IF (oneD%odi%d1) THEN
!-odim
npd = MIN(DIMENSION%nspd,25)
CALL cylpts(xp,npd,cell%z1)
CALL checkdop(xp,npd,0,0,vacuum%nvac,1,ispin,.TRUE.,DIMENSION,atoms,&
sphhar,stars,sym,vacuum,cell,oneD,den%pw,den%mt,den%vacxy,den%vacz)
!+odim
END IF
! m.t. boundaries
nat = 1
DO n = 1,atoms%ntype
CALL sphpts(xp,DIMENSION%nspd,atoms%rmt(n),atoms%pos(1,nat))
CALL checkdop(xp,DIMENSION%nspd,n,nat,0,-1,ispin,.TRUE.,&
dimension,atoms,sphhar,stars,sym,vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
nat = nat + atoms%neq(n)
END DO
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,den,ispin)
END DO ! ispin = 1, input%jspins
END IF ! input%vchk
......@@ -376,7 +345,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
CLOSE (40) ! enpara file
END IF
DEALLOCATE (xp,rat,eig,rh,rh1)
DEALLOCATE (rat,eig,rh,rh1)
DEALLOCATE (rhoss,vacpar,vbar,sigm)
DEALLOCATE (enpara%ello0,enpara%el0,enpara%lchange)
DEALLOCATE (enpara%skiplo,enpara%llochg,enpara%enmix,enpara%evac0)
......
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