Commit 45b7d160 authored by Daniel Wortmann's avatar Daniel Wortmann

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
......@@ -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)
......
This diff is collapsed.
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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) )
ENDIF
ELSE
ctmp = z(nbasf,ie)*clotmp(m)
IF (l_real) THEN
ctmp = z_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = z_c(nbasf,ie)*clotmp(m)
ENDIF
ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
bcof(ie,lm,na) = bcof(ie,lm,na) +ctmp*blo1(lo,ntyp)
......@@ -136,12 +140,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) )
ENDIF
ELSE
ctmp = z(nbasf,ie)*clotmp(m)
IF (l_real) THEN
ctmp = z_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = z_c(nbasf,ie)*clotmp(m)
END IF
ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
bcof(ie,lm,na) = bcof(ie,lm,na) +ctmp*blo1(lo,ntyp)
......@@ -153,21 +161,21 @@ CONTAINS
bveccof(i,ie,lm,na)=bveccof(i,ie,lm,na) +fgp(i)*ctmp*blo1(lo,ntyp)
cveccof(i,m,ie,lo,na)=cveccof(i,m,ie,lo,na)+fgp(i)*ctmp*clo1(lo,ntyp)
ENDDO
#if ( defined(CPP_SOC) && defined(CPP_INVERSION) )
ctmp = z(nbasf,ie) * CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(ie,lmp,na2) = acof(ie,lmp,na2) +ctmp*alo1(lo,ntyp)
bcof(ie,lmp,na2) = bcof(ie,lmp,na2) +ctmp*blo1(lo,ntyp)
ccof(-m,ie,lo,na2) = ccof(-m,ie,lo,na2) + ctmp*clo1(lo,ntyp)
acoflo(-m,ie,lo,na2) = acoflo(-m,ie,lo,na2) +ctmp*alo1(lo,ntyp)
bcoflo(-m,ie,lo,na2) = bcoflo(-m,ie,lo,na2) +ctmp*blo1(lo,ntyp)
DO i = 1,3
aveccof(i,ie,lmp,na2)=aveccof(i,ie,lmp,na2)-fgp(i)*ctmp*alo1(lo,ntyp)
bveccof(i,ie,lmp,na2)=bveccof(i,ie,lmp,na2)-fgp(i)*ctmp*blo1(lo,ntyp)
cveccof(i,-m,ie,lo,na2) =cveccof(i,-m,ie,lo,na2) -fgp(i)*ctmp*clo1(lo,ntyp)
ENDDO
#endif
IF (noco%l_soc.AND.sym%invs) THEN
ctmp = z_c(nbasf,ie) * CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(ie,lmp,na2) = acof(ie,lmp,na2) +ctmp*alo1(lo,ntyp)
bcof(ie,lmp,na2) = bcof(ie,lmp,na2) +ctmp*blo1(lo,ntyp)
ccof(-m,ie,lo,na2) = ccof(-m,ie,lo,na2) + ctmp*clo1(lo,ntyp)
acoflo(-m,ie,lo,na2) = acoflo(-m,ie,lo,na2) +ctmp*alo1(lo,ntyp)
bcoflo(-m,ie,lo,na2) = bcoflo(-m,ie,lo,na2) +ctmp*blo1(lo,ntyp)
DO i = 1,3
aveccof(i,ie,lmp,na2)=aveccof(i,ie,lmp,na2)-fgp(i)*ctmp*alo1(lo,ntyp)
bveccof(i,ie,lmp,na2)=bveccof(i,ie,lmp,na2)-fgp(i)*ctmp*blo1(lo,ntyp)
cveccof(i,-m,ie,lo,na2) =cveccof(i,-m,ie,lo,na2) -fgp(i)*ctmp*clo1(lo,