Skip to content

GitLab

fleur
fleur
Commit 45b7d160 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Major change! Should compile but not tested at all yet! 

Removed preprocessor switches CPP_SOC, CPP_INVERSION, CPP_APW, CPP_CORE.
Only a single fleur executable is built.
parent 9b5d4531
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 4642 additions and 5298 deletions
cdn/cdnval.F90
View file @ 45b7d160
......@@ -164,11 +164,8 @@ CONTAINS
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) ,kveclo(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, ALLOCATABLE :: z(:,:)
#else
REAL, ALLOCATABLE :: z(:,:)
#endif
COMPLEX, ALLOCATABLE :: z_c(:,:)
REAL, ALLOCATABLE :: z_r(:,:)
REAL, ALLOCATABLE :: aclo(:,:,:),acnmt(:,:,:,:,:)
REAL, ALLOCATABLE :: bclo(:,:,:),bcnmt(:,:,:,:,:)
REAL, ALLOCATABLE :: cclo(:,:,:,:),ccnmt(:,:,:,:,:),we(:)
......@@ -196,6 +193,9 @@ CONTAINS
TYPE (t_mt21), ALLOCATABLE :: mt21(:,:)
TYPE (t_lo21), ALLOCATABLE :: lo21(:,:)
TYPE (t_usdus):: usdus
LOGICAL :: l_real
l_real=sym%invs.or.noco%l_soc
! ..
! ..
llpd=(atoms%lmaxd*(atoms%lmaxd+3))/2
......@@ -521,14 +521,25 @@ CONTAINS
n_end = noccbd
END IF
END IF
IF (.NOT.ALLOCATED(z)) ALLOCATE (z(dimension%nbasfcn,dimension%neigd))
z = 0
CALL cdn_read(&
IF (l_real) THEN
IF (.NOT.ALLOCATED(z_r)) ALLOCATE (z_r(dimension%nbasfcn,dimension%neigd))
z_r = 0
CALL cdn_read(&
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
ikpt,jspin,dimension%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
lapw%nmat,lapw%nv,ello,evdu,epar,kveclo,&
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,z_r)
ELSE
IF (.NOT.ALLOCATED(z_c)) ALLOCATE (z_c(dimension%nbasfcn,dimension%neigd))
z_c = 0
CALL cdn_read(&
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
ikpt,jspin,dimension%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
lapw%nmat,lapw%nv,ello,evdu,epar,kveclo,&
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,z)
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,z_c)
endif
!IF (l_evp.AND.(isize.GT.1)) THEN
! eig(1:noccbd) = eig(n_start:n_end)
!ENDIF
......@@ -564,7 +575,11 @@ CONTAINS
nslibd = nslibd + 1
eig(nslibd) = eig(i)
we(nslibd) = we(i)
z(:,nslibd) = z(:,i)
if (l_real) THEN
z_r(:,nslibd) = z_r(:,i)
else
z_c(:,nslibd) = z_c(:,i)
endif
END IF
END DO
IF (mpi%irank==0) WRITE (16,'(a,i3)') ' eigenvalues in sliceplot%slice:',nslibd
......@@ -576,14 +591,22 @@ CONTAINS
nslibd = nslibd + 1
eig(nslibd) = eig(sliceplot%nnne)
we(nslibd) = we(sliceplot%nnne)
z(:,nslibd) = z(:,sliceplot%nnne)
if (l_real) Then
z_r(:,nslibd) = z_r(:,sliceplot%nnne)
else
z_c(:,nslibd) = z_c(:,sliceplot%nnne)
endif
ELSE
DO i = 1,nbands
IF (eig(i).GE.sliceplot%e1s .AND. eig(i).LE.sliceplot%e2s) THEN
nslibd = nslibd + 1
eig(nslibd) = eig(i)
we(nslibd) = we(i)
z(:,nslibd) = z(:,i)
if (l_real) THEN
z_r(:,nslibd) = z_r(:,i)
else
z_c(:,nslibd) = z_c(:,i)
endif
END IF
END DO
IF (mpi%irank==0) WRITE (16,FMT='(a,i3)')' eigenvalues in sliceplot%slice:',nslibd
......@@ -608,13 +631,8 @@ CONTAINS
! ----> valence density in the interstitial region
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: pwden")
CALL pwden(&
stars,kpts,banddos,oneD,&
input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,&
igq_fft,we,z,&
eig,bkpt,&
qpw,cdom,qis,results%force,f_b8)
CALL pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,igq_fft,we, eig,bkpt,qpw,cdom,qis,results%force,f_b8,z_r,z_c,l_real)
CALL timestop("cdnval: pwden")
END IF
!+new
......@@ -623,14 +641,10 @@ CONTAINS
!
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL q_int_sl(&
jspin,stars,atoms,sym,&
volsl,volintsl,&
cell,&
z,noccbd,lapw,&
nsl,zsl,nmtsl,oneD,&
qintsl(:,:))
!
CALL q_int_sl(jspin,stars,atoms,sym, volsl,volintsl,&
cell,noccbd,lapw, nsl,zsl,nmtsl,oneD, qintsl(:,:),z_r,z_c,l_real)
!
END IF
END IF
!-new c
......@@ -638,16 +652,9 @@ CONTAINS
IF (input%film) THEN
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden")
CALL vacden(&
vacuum,dimension,stars,oneD,&
kpts,input,&
cell,atoms,noco,banddos,&
gvac1d,gvac2d,&
we,ikpt,jspin,vz,vz0,&
noccbd,z,bkpt,lapw,&
evac,eig,&
rhtxy,rht,qvac,qvlay,&
qstars,cdomvz,cdomvxy)
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,bkpt,lapw, evac,eig,&
rhtxy,rht,qvac,qvlay, qstars,cdomvz,cdomvxy,z_r,z_c,l_real)
CALL timestop("cdnval: vacden")
END IF
!---> perform Brillouin zone integration and summation over the
......@@ -684,16 +691,15 @@ CONTAINS
aveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%natd),&
bveccof(3,noccbd,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%natd),&
cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%natd) )
CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,bkpt, z,noccbd,eig,usdus,&
kveclo,ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof)
CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,bkpt,noccbd,eig,usdus,&
kveclo,ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,z_r,z_c,l_real)
CALL timestop("cdnval: to_pulay")
ELSE
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,noccbd,sym, cell, bkpt,lapw,noccbd,z, usdus, noco,ispin,kveclo,oneD,&
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin))
CALL abcof(input,atoms,noccbd,sym, cell, bkpt,lapw,noccbd,usdus, noco,ispin,kveclo,oneD,&
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),z_r,z_c,l_real)
CALL timestop("cdnval: abcof")
END IF
......@@ -822,7 +828,7 @@ CONTAINS
cartk=matmul(bkpt,cell%bmat)
IF (banddos%ndir.GT.0) THEN
CALL sympsi(bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),&
lapw%k3(:,jspin),sym,dimension,nbands,cell, z,eig,noco, ksym,jsym)
lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,z_r,z_c,l_real)
END IF
!
!--dw now write k-point data to tmp_dos
......@@ -836,7 +842,11 @@ CONTAINS
END IF
!---> end of loop over PE's
DEALLOCATE (z)
IF (l_real) THEN
DEALLOCATE (z_r)
else
DEALLOCATE (z_c)
endif
END IF ! --> end "IF ((mod(i_rec-1,mpi%isize).EQ.mpi%irank).OR.l_evp) THEN"
END DO !---> end of k-point loop
DEALLOCATE (we,f,g,usdus%us,usdus%dus,usdus%duds,usdus%uds,usdus%ddn)
......
cdn/pwden.F90
View file @ 45b7d160
This diff is collapsed.
cdn/q_int_sl.F90
View file @ 45b7d160
......@@ -2,7 +2,7 @@ MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,stars,atoms,sym, volsl,volintsl, cell,&
z,ne,lapw, nsl,zsl,nmtsl,oneD, qintslk)
ne,lapw, nsl,zsl,nmtsl,oneD, qintslk,z_r,z_c,realdata)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
......@@ -29,11 +29,9 @@ CONTAINS
REAL, INTENT (IN) :: volintsl(atoms%natd)
REAL, INTENT (IN) :: zsl(2,atoms%natd) ,volsl(atoms%natd)
REAL, INTENT (OUT):: qintslk(:,:)!(nsl,dimension%neigd)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
REAL, INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#else
COMPLEX, INTENT (IN) :: z(:,:)
#endif
REAL, OPTIONAL, INTENT (IN) :: z_r(:,:)!(dimension%nbasfcn,dimension%neigd)
COMPLEX,OPTIONAL, INTENT (IN) :: z_c(:,:)
LOGICAL,OPTIONAL, INTENT (IN) :: realdata
! ..
! .. Local Scalars ..
REAL q1,zsl1,zsl2,qi,volsli,volintsli
......@@ -42,11 +40,13 @@ CONTAINS
! ..
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: stfunint(:,:),z_z(:)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
REAL, ALLOCATABLE :: z_h(:,:)
#else
COMPLEX, ALLOCATABLE :: z_h(:,:)
#endif
LOGICAL :: l_real
IF (PRESENT(realdata)) THEN
l_real=realdata
ELSE
l_real=PRESENT(z_r)
ENDIF
! ..
IF (oneD%odi%d1) CALL juDFT_error("well, does not work with 1D. Not clear how to define a layer.",calledby ="q_int_sl")
!
......@@ -77,13 +77,15 @@ CONTAINS
DO n = 1,ne
z_z(:) = CMPLX(0.0,0.0)
q1 = 0.0
DO i = 1,lapw%nv(isp)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
q1 = q1 + z(i,n)*z(i,n)
#else
q1 = q1 + REAL(z(i,n)*CONJG(z(i,n)))
#endif
ENDDO
IF (l_real) THEN
DO i = 1,lapw%nv(isp)
q1 = q1 + z_r(i,n)*z_r(i,n)
ENDDO
ELSE
DO i = 1,lapw%nv(isp)
q1 = q1 + REAL(z_c(i,n)*CONJG(z_c(i,n)))
ENDDO
ENDIF
z_z(1) = q1/cell%omtil
!
! ----> g.ne.0 stars
......@@ -101,13 +103,13 @@ CONTAINS
IF (ind.EQ.0 .OR. indp.EQ.0) CYCLE
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
z_z(ind) = z_z(ind) + z(j,n)*z(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + z(i,n)*z(j,n)*REAL(phasep)
#else
z_z(ind) = z_z(ind) +z(j,n)*CONJG(z(i,n))*phase
z_z(indp)= z_z(indp)+z(i,n)*CONJG(z(j,n))*phasep
#endif
IF (l_real) THEN
z_z(ind) = z_z(ind) + z_r(j,n)*z_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + z_r(i,n)*z_r(j,n)*REAL(phasep)
ELSE
z_z(ind) = z_z(ind) +z_c(j,n)*CONJG(z_c(i,n))*phase
z_z(indp)= z_z(indp)+z_c(i,n)*CONJG(z_c(j,n))*phasep
ENDIF
ENDDO
ENDDO
! ----> calculate a charge in the layer interstitial region of the film
......
cdn/vacden.F90
View file @ 45b7d160
......@@ -10,9 +10,9 @@ CONTAINS
kpts,input,cell,atoms,noco,banddos,&
gvac1,gvac2,&
we,ikpt,jspin,vz,vz0,&
ne,z,bkpt,lapw,&
ne,bkpt,lapw,&
evac,eig,rhtxy,rht,qvac,qvlay,&
stcoeff,cdomvz,cdomvxy)
stcoeff,cdomvz,cdomvxy,z_r,z_c,realdata)
!***********************************************************************
! ****** change vacden(....,q) for vacuum density of states shz Jan.96
......@@ -73,23 +73,22 @@ CONTAINS
! .. Array Arguments ..
REAL, INTENT (IN) :: bkpt(3)
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, INTENT (IN):: z(DIMENSION%nbasfcn,DIMENSION%neigd)
#else
REAL, INTENT (IN):: z(DIMENSION%nbasfcn,DIMENSION%neigd)
#endif
COMPLEX,OPTIONAL, INTENT (IN):: z_c(DIMENSION%nbasfcn,DIMENSION%neigd)
REAL, OPTIONAL, INTENT (IN):: z_r(DIMENSION%nbasfcn,DIMENSION%neigd)
COMPLEX, INTENT (INOUT):: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd)
REAL, INTENT (INOUT):: rht(vacuum%nmzd,2,DIMENSION%jspd)
REAL, INTENT (OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkptd,DIMENSION%jspd)
REAL qvac(DIMENSION%neigd,2,kpts%nkptd,DIMENSION%jspd),we(dimension%neigd),vz(vacuum%nmzd,2),vz0(2)
REAL qvac(DIMENSION%neigd,2,kpts%nkptd,DIMENSION%jspd),we(DIMENSION%neigd),vz(vacuum%nmzd,2),vz0(2)
COMPLEX, INTENT (INOUT):: cdomvz(vacuum%nmzd,2)
COMPLEX, INTENT (INOUT):: cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
!
! STM-Arguments
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
INTEGER, INTENT (IN) :: gvac1(DIMENSION%nv2d),gvac2(dimension%nv2d)
INTEGER, INTENT (IN) :: gvac1(DIMENSION%nv2d),gvac2(DIMENSION%nv2d)
COMPLEX, INTENT (OUT):: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
!
LOGICAL,OPTIONAL,INTENT(IN)::realdata
! local STM variables
INTEGER nv2(DIMENSION%jspd)
INTEGER kvac1(DIMENSION%nv2d,DIMENSION%jspd),kvac2(DIMENSION%nv2d,DIMENSION%jspd),map2(DIMENSION%nvd,DIMENSION%jspd)
......@@ -124,7 +123,12 @@ CONTAINS
REAL, ALLOCATABLE :: u_1(:,:,:,:),ue_1(:,:,:,:)
!+odim
! ..
LOGICAL ::l_real
IF (PRESENT(realdata)) THEN
l_real=realdata
ELSE
l_real=PRESENT(z_r)
ENDIF
! ..
! *******************************************************************************
......@@ -334,12 +338,13 @@ CONTAINS
CMPLX(-dt_1(l,m)*bess(m) +&
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
DO n = 1,ne
ac_1(l,m,n,ispin) = ac_1(l,m,n,ispin) +z(kspin,n)*av_1
! + conjg(z(k,n))*av_1
bc_1(l,m,n,ispin) = bc_1(l,m,n,ispin) +z(kspin,n)*bv_1
! + conjg(z(k,n))*bv_1
END DO
IF (l_real) THEN
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) +z_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) +z_r(kspin,:ne)*bv_1
ELSE
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) +z_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) +z_c(kspin,:ne)*bv_1
END IF
END DO ! -mb:mb
END IF
END DO
......@@ -376,10 +381,13 @@ CONTAINS
av = -c_1 * CMPLX( dte(l),zks*te(l) )
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
DO n = 1,ne
ac(l,n,ispin) = ac(l,n,ispin) + z(kspin,n)*av
bc(l,n,ispin) = bc(l,n,ispin) + z(kspin,n)*bv
ENDDO
IF (l_real) THEN
ac(l,:ne,ispin) = ac(l,:ne,ispin) + z_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + z_r(kspin,:ne)*bv
ELSE
ac(l,:ne,ispin) = ac(l,:ne,ispin) + z_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + z_c(kspin,:ne)*bv
ENDIF
ENDDO
!---> end of spin loop
ENDIF
......@@ -430,12 +438,13 @@ CONTAINS
CMPLX(-dt_1(l,m)*bess(m) +&
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
DO n = 1,ne
ac_1(l,m,n,jspin) = ac_1(l,m,n,jspin) +z(k,n)*av_1
! + conjg(z(k,n))*av_1
bc_1(l,m,n,jspin) = bc_1(l,m,n,jspin) +z(k,n)*bv_1
! + conjg(z(k,n))*bv_1
END DO
IF (l_real) THEN
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) +z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) +z_r(k,:ne)*bv_1
ELSE
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) +z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) +z_r(k,:ne)*bv_1
ENDIF
END DO ! -mb:mb
END IF
END DO ! k = 1,lapw%nv
......@@ -467,10 +476,13 @@ CONTAINS
av = -c_1 * CMPLX( dte(l),zks*te(l) )
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
DO n = 1,ne
ac(l,n,jspin) = ac(l,n,jspin) + z(k,n)*av
bc(l,n,jspin) = bc(l,n,jspin) + z(k,n)*bv
ENDDO
IF (l_real) THEN
ac(l,:ne,jspin) = ac(l,:ne,jspin) + z_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + z_r(k,:ne)*bv
ELSE
ac(l,:ne,jspin) = ac(l,:ne,jspin) + z_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + z_c(k,:ne)*bv
ENDIF
ENDDO
END IF ! D1
ENDIF
......@@ -510,7 +522,7 @@ CONTAINS
!
IF (vacuum%nstm.EQ.3) THEN
#ifdef CPP_MPI
call judft_error("nstm==3 does not work in parallel",calledby="vacden")
CALL judft_error("nstm==3 does not work in parallel",calledby="vacden")
#else
i=0
DO n = 1, ne
......
cdn_mt/abclocdn.F90
View file @ 45b7d160
......@@ -21,7 +21,7 @@ MODULE m_abclocdn
!*********************************************************************
CONTAINS
SUBROUTINE abclocdn(atoms, sym, noco,ccchi,kspin,iintsp,con1,phase,ylm,&
ntyp,na,k,s,nv,ne,z,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof)
ntyp,na,k,s,nv,ne,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof,z_r,z_c)
!
USE m_types
IMPLICIT NONE
......@@ -47,11 +47,8 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%natd)
INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%natd)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX, INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#else
REAL, INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#endif
COMPLEX,OPTIONAL, INTENT (IN) :: z_c(:,:)!(dimension%nbasfcn,dimension%neigd)
REAL,OPTIONAL, INTENT (IN) :: z_r(:,:)!(dimension%nbasfcn,dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX ctmp,term1
......@@ -61,7 +58,8 @@ CONTAINS
! .. Local Arrays ..
COMPLEX clotmp(-atoms%llod:atoms%llod)
! ..
LOGICAL :: l_real
l_real=PRESENT(z_r)
! ..
enough(na) = .TRUE.
term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
......@@ -91,12 +89,16 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*z(kspin+nbasf,i)
ctmp = clotmp(m)*ccchi(iintsp)*z_c(kspin+nbasf,i)
ELSE
ctmp = clotmp(m)*( ccchi(1)*z(nbasf,i)+ccchi(2)*z(kspin+nbasf,i) )
ctmp = clotmp(m)*( ccchi(1)*z_c(nbasf,i)+ccchi(2)*z_c(kspin+nbasf,i) )
ENDIF
ELSE
ctmp = z(nbasf,i)*clotmp(m)
IF (l_real) THEN
ctmp = z_r(nbasf,i)*clotmp(m)
ELSE
ctmp = z_c(nbasf,i)*clotmp(m)
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
......@@ -134,24 +136,28 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*z(kspin+nbasf,i)
ctmp = clotmp(m)*ccchi(iintsp)*z_c(kspin+nbasf,i)
ELSE
ctmp = clotmp(m)*( ccchi(1)*z(nbasf,i)+ ccchi(2)*z(kspin+nbasf,i) )
ctmp = clotmp(m)*( ccchi(1)*z_c(nbasf,i)+ ccchi(2)*z_c(kspin+nbasf,i) )
ENDIF
ELSE
ctmp = z(nbasf,i)*clotmp(m)
IF (l_real) THEN
ctmp = z_r(nbasf,i)*clotmp(m)
ELSE
ctmp = z_c(nbasf,i)*clotmp(m)
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo,ntyp)
#if ( defined(CPP_SOC) && defined(CPP_INVERSION) )
ctmp = z(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(i,lmp,na2) = acof(i,lmp,na2) +ctmp*alo1(lo,ntyp)
bcof(i,lmp,na2) = bcof(i,lmp,na2) +ctmp*blo1(lo,ntyp)
ccof(-m,i,lo,na2) = ccof(-m,i,lo,na2) +ctmp*clo1(lo,ntyp)
#endif
IF (noco%l_soc.AND.sym%invs) THEN
ctmp = z_c(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(i,lmp,na2) = acof(i,lmp,na2) +ctmp*alo1(lo,ntyp)
bcof(i,lmp,na2) = bcof(i,lmp,na2) +ctmp*blo1(lo,ntyp)
ccof(-m,i,lo,na2) = ccof(-m,i,lo,na2) +ctmp*clo1(lo,ntyp)
ENDIF
ENDDO ! m
ENDDO ! i = 1,ne
ELSE
......@@ -166,12 +172,9 @@ CONTAINS
ENDIF ! s > eps & l >= 1
END DO
IF ((k.EQ.nv) .AND. (.NOT.enough(na))) THEN
WRITE (6,FMT=*)&
& 'abclocdn did not find enough linearly independent'
WRITE (6,FMT=*)&
& 'ccof coefficient-vectors.'
CALL juDFT_error("did not find enough lin. ind. ccof-vectors"&
& ,calledby ="abclocdn")
WRITE (6,FMT=*) 'abclocdn did not find enough linearly independent'
WRITE (6,FMT=*) 'ccof coefficient-vectors.'
CALL juDFT_error("did not find enough lin. ind. ccof-vectors" ,calledby ="abclocdn")
END IF
END SUBROUTINE abclocdn
......
cdn_mt/abclocdn_pulay.F90
View file @ 45b7d160
......@@ -11,9 +11,9 @@ CONTAINS
& atoms,sym,&
& noco,ccchi,kspin,iintsp,&
& con1,phase,ylm,ntyp,na,k,fgp,&
& s,nv,ne,z,nbasf0,alo1,blo1,clo1,&
& s,nv,ne,nbasf0,alo1,blo1,clo1,&
& kvec,nkvec,enough,acof,bcof,ccof,&
& acoflo,bcoflo,aveccof,bveccof,cveccof)
& acoflo,bcoflo,aveccof,bveccof,cveccof,z_r,z_c,realdata)
!
!*********************************************************************
! for details see abclocdn; calles by to_pulay
......@@ -48,11 +48,9 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)!(3,-atoms%llod:llod,nobd,atoms%nlod,atoms%natd)
LOGICAL, INTENT (OUT) :: enough(atoms%natd)
INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%natd)
#if ( defined(CPP_INVERSION) && !defined(CPP_SOC) )
REAL, INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#else
COMPLEX, INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#endif
REAL, OPTIONAL,INTENT (IN) :: z_r(:,:)!(dimension%nbasfcn,dimension%neigd)
COMPLEX, OPTIONAL,INTENT (IN) :: z_c(:,:)!(dimension%nbasfcn,dimension%neigd)
LOGICAL,OPTIONAL,INTENT(IN) ::realdata
! ..
! .. Local Scalars ..
COMPLEX ctmp,term1
......@@ -63,7 +61,9 @@ CONTAINS
! .. Local Arrays ..
COMPLEX clotmp(-atoms%llod:atoms%llod)
! ..
LOGICAL:: l_real
l_real=PRESENT(z_r)
IF (PRESENT(realdata)) l_real=realdata
enough(na) = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)*phase
!
......@@ -92,12 +92,16 @@ CONTAINS
lm = ll1 + m
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)* ccchi(iintsp)*z(kspin+nbasf,ie)
ctmp = clotmp(m)* ccchi(iintsp)*z_c(kspin+nbasf,ie)
ELSE
ctmp = clotmp(m)*( ccchi(1)*z(nbasf,ie)+ccchi(2)*z(kspin+nbasf,ie) )
ctmp = clotmp(m)*( ccchi(1)*z_c(nbasf,ie)+ccchi(2)*z_c(kspin+nbasf,ie) )