Commit 251214fe authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' into xc-pot-refactor

Conflicts:
	main/vgen.F90
	vgen/vgen_xcpot.F90
parents 3720c1c6 aae72148
init/compileinfo.h
io/xml/inputSchema.h
*~
\#*
build
......
......@@ -28,6 +28,9 @@ test-gfortran:
- build
script:
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";cd /builds/fleur/fleur/build;ctest
artifacts:
paths:
- build/Testing/test.oldlogs
# only:
# - schedules
# - triggers
......
......@@ -4,25 +4,14 @@ if (EXISTS "${CMAKE_BINARY_DIR}/config.cmake")
include("${CMAKE_BINARY_DIR}/config.cmake")
endif()
set(tmp ${CMAKE_Fortran_FLAGS})
project(FLEUR LANGUAGES C Fortran)
#some variables might be set in the environment
set(FLEUR_LIBRARIES ${FLEUR_LIBRARIES} $ENV{FLEUR_LIBRARIES})
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${FLEUR_Fortran_FLAGS} $ENV{CMAKE_Fortran_FLAGS}")
if (DEFINED ENV{FLEUR_USE_SERIAL})
set(FLEUR_USE_SERIAL ENV{FLEUR_USE_SERIAL})
else()
set(FLEUR_USE_SERIAL TRUE)
endif()
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${tmp}")
include("cmake/CompilerConfig.txt")
include("cmake/ReportConfig.txt")
include("cmake/Generate_Schema.cmake")
include("cmake/Files_and_Targets.txt")
include("cmake/filespecific.cmake")
......
......@@ -116,7 +116,7 @@
REAL, INTENT (INOUT) :: rh(DIMENSION%msh,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX czero,carg,VALUE,slope,ci
COMPLEX czero,carg,VALUE,slope,ci,c_ph
REAL dif,dxx,g,gz,dtildh,&
& rkappa,sign,signz,tol_14,z,zero,zvac,&
& g2,phi,gamma,qq
......@@ -223,7 +223,7 @@
& ,calledby ="cdnovlp")
ENDIF
acoff(n) = rh(atoms%jri(n),n) * EXP( alpha(n)*atoms%rmt(n)*atoms%rmt(n) )
WRITE (6,FMT=8010) alpha(n),acoff(n)
!WRITE (6,FMT=8010) alpha(n),acoff(n)
DO j = 1,atoms%jri(n) - 1
rh(j,n) = acoff(n) * EXP( -alpha(n)*rat(j,n)**2 )
ENDDO
......@@ -300,6 +300,7 @@
! ---> sum over gz-stars
DO 250 kz = m0,stars%mx3
ig3 = stars%ig(k1,k2,kz)
c_ph = stars%rgphs(k1,k2,kz) ! phase factor for invs=T & zrfs=F
! ----> use only stars within the g_max sphere (oct.97 shz)
IF (ig3.NE.0) THEN
nz = 1
......@@ -308,8 +309,8 @@
DO 240 nrz = 1,nz
signz = 3. - 2.*nrz
carg = ci*sign*signz*gz
VALUE = VALUE + qpwc(ig3)* EXP(carg*cell%z1)
slope = slope + carg*qpwc(ig3)* EXP(carg*cell%z1)
VALUE = VALUE + c_ph*qpwc(ig3)* EXP(carg*cell%z1)
slope = slope + c_ph*carg*qpwc(ig3)* EXP(carg*cell%z1)
240 ENDDO
END IF
250 ENDDO
......
This diff is collapsed.
......@@ -24,7 +24,7 @@ MODULE m_eparas
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,mcd,l_mcd)
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus
......@@ -33,7 +33,7 @@ CONTAINS
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_mcd), INTENT(INOUT) :: mcd
TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,jsp
......@@ -60,16 +60,13 @@ CONTAINS
!
IF ((ikpt.LE.mpi%isize).AND..NOT.l_evp) THEN
IF (l_mcd) THEN
mcd%mcd(:,:,:) = 0.0
ENDIF
regCharges%ener(:,:,jsp) = 0.0
regCharges%sqal(:,:,jsp) = 0.0
regCharges%enerlo(:,:,jsp) = 0.0
regCharges%sqlo(:,:,jsp) = 0.0
dos%qal(:,:,:,ikpt,jsp) = 0.0
END IF
!
!---> l-decomposed density for each occupied state
!
! DO 140 i = (skip_t+1),ne ! this I need for all states
......@@ -101,7 +98,7 @@ CONTAINS
DO icore = 1, mcd%ncore(n)
DO ipol = 1, 3
index = 3*(n-1) + ipol
mcd%mcd(index,icore,i)=mcd%mcd(index,icore,i) + fac*(&
mcd%mcd(index,icore,i,ikpt,jsp)=mcd%mcd(index,icore,i,ikpt,jsp) + fac*(&
suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +&
......
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne,we,eig,den,qis,results,f_b8,zMat)
ikpt,jspin,lapw,ne,we,eig,den,results,f_b8,zMat,dos)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -80,32 +80,32 @@ CONTAINS
USE m_types
USE m_fft_interface
IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dos), INTENT(INOUT) :: dos
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
!-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne
!-----> CHARGE DENSITY INFORMATION
INTEGER,INTENT(IN) :: ikpt,jspin
REAL,INTENT(OUT) :: qis(:,:,:) !(dimension%neigd,kpts%nkpt,dimension%jspd)
INTEGER,INTENT(IN) :: ikpt,jspin
COMPLEX, INTENT (INOUT) :: f_b8(3,atoms%ntype)
!
!-----> LOCAL VARIABLES
!
!-----> FFT INFORMATION
INTEGER :: ifftq2d,ifftq3d
......@@ -232,8 +232,8 @@ CONTAINS
q0_22 = zero
IF (.NOT.zmat%l_real ) THEN
DO nu = 1 , ne
q0_11 = q0_11 + we(nu) * CPP_BLAS_cdotc(lapw%nv(1),zMat%z_c(1,nu),1,zMat%z_c(1,nu),1)
q0_22 = q0_22 + we(nu) * CPP_BLAS_cdotc(lapw%nv(2),zMat%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1, zMat%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1)
q0_11 = q0_11 + we(nu) * CPP_BLAS_cdotc(lapw%nv(1),zMat%data_c(1,nu),1,zMat%data_c(1,nu),1)
q0_22 = q0_22 + we(nu) * CPP_BLAS_cdotc(lapw%nv(2),zMat%data_c(lapw%nv(1)+atoms%nlotot+1,nu),1, zMat%data_c(lapw%nv(1)+atoms%nlotot+1,nu),1)
ENDDO
ENDIF
q0_11 = q0_11/cell%omtil
......@@ -241,11 +241,11 @@ CONTAINS
ELSE
IF (zmat%l_real) THEN
DO nu = 1 , ne
q0=q0+we(nu)*CPP_BLAS_sdot(lapw%nv(jspin),zMat%z_r(1,nu),1,zMat%z_r(1,nu),1)
q0=q0+we(nu)*CPP_BLAS_sdot(lapw%nv(jspin),zMat%data_r(1,nu),1,zMat%data_r(1,nu),1)
ENDDO
ELSE
DO nu = 1 , ne
q0=q0+we(nu) *REAL(CPP_BLAS_cdotc(lapw%nv(jspin),zMat%z_c(1,nu),1,zMat%z_c(1,nu),1))
q0=q0+we(nu) *REAL(CPP_BLAS_cdotc(lapw%nv(jspin),zMat%data_c(1,nu),1,zMat%data_c(1,nu),1))
ENDDO
ENDIF
q0 = q0/cell%omtil
......@@ -256,7 +256,7 @@ CONTAINS
IF (noco%l_noco) THEN
rhomat = 0.0
IF (ikpt.LE.mpi%isize) THEN
qis=0.0
dos%qis=0.0
ENDIF
ELSE
rhon=0.0
......@@ -315,19 +315,19 @@ CONTAINS
!------> map WF into FFTbox
IF (noco%l_ss) THEN
DO iv = 1 , lapw%nv(1)
psi1r( iv1d(iv,1) ) = REAL( zMat%z_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( zMat%z_c(iv,nu) )
psi1r( iv1d(iv,1) ) = REAL( zMat%data_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( zMat%data_c(iv,nu) )
ENDDO
DO iv = 1 , lapw%nv(2)
psi2r( iv1d(iv,2) ) = REAL(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i( iv1d(iv,2) ) = AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2r( iv1d(iv,2) ) = REAL(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i( iv1d(iv,2) ) = AIMAG(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO
ELSE
DO iv = 1 , lapw%nv(jspin)
psi1r( iv1d(iv,jspin) ) = REAL( zMat%z_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%z_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi1r( iv1d(iv,jspin) ) = REAL( zMat%data_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%data_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(zMat%data_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO
ENDIF
......@@ -337,12 +337,12 @@ CONTAINS
!------> map WF into FFTbox
IF (zmat%l_real) THEN
DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = zMat%z_r(iv,nu)
psir( iv1d(iv,jspin) ) = zMat%data_r(iv,nu)
ENDDO
ELSE
DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = REAL(zMat%z_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(zMat%z_c(iv,nu))
psir( iv1d(iv,jspin) ) = REAL(zMat%data_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(zMat%data_c(iv,nu))
ENDDO
ENDIF
ENDIF
......@@ -384,7 +384,7 @@ CONTAINS
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
ENDDO
kpsir( iv1d(iv,jspin) ) = s * zMat%z_r(iv,nu)
kpsir( iv1d(iv,jspin) ) = s * zMat%data_r(iv,nu)
ENDDO
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
nw1,nw2,nw3,wsave,kpsir(ifftq3d), kpsir(-ifftq2))
......@@ -427,8 +427,8 @@ CONTAINS
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
ENDDO
kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%z_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%z_c(iv,nu))
kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%data_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%data_c(iv,nu))
ENDDO
!--------------------------------
......@@ -473,7 +473,7 @@ CONTAINS
!---> total charge does not need to be one in each spin-
!---> channel. Thus it has to be calculated explicitly, if
!---> it is needed.
IF (banddos%dos .OR. banddos%vacdos .OR. input%cdinf) THEN
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
DO ir = 0,ifftq3d-1
psi1r(ir) = (psi1r(ir)**2 + psi1i(ir)**2)
psi2r(ir) = (psi2r(ir)**2 + psi2i(ir)**2)
......@@ -493,8 +493,8 @@ CONTAINS
CMPLX(psi1r(stars%igq_fft(ik)),psi1i(stars%igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell,stars%kv3(1,istr),x)
qis(nu,ikpt,1) = qis(nu,ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
CALL pwint(stars,atoms,sym, oneD,cell,istr,x)
dos%qis(nu,ikpt,1) = dos%qis(nu,ikpt,1) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
cwk=0.0
......@@ -503,8 +503,8 @@ CONTAINS
CMPLX(psi2r(stars%igq_fft(ik)),psi2i(stars%igq_fft(ik)))
ENDDO
DO istr = 1,stars%ng3_fft
CALL pwint(stars,atoms,sym, oneD,cell, stars%kv3(1,istr), x)
qis(nu,ikpt,input%jspins) = qis(nu,ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
CALL pwint(stars,atoms,sym, oneD,cell, istr, x)
dos%qis(nu,ikpt,input%jspins) = dos%qis(nu,ikpt,input%jspins) + REAL(cwk(istr)*x)/cell%omtil/REAL(ifftq3)
ENDDO
ENDIF
ELSE
......@@ -668,12 +668,12 @@ CONTAINS
IF ( ABS( q0 - REAL(cwk(1)) )/q0 .GT. tol_3 ) THEN
WRITE(99,*) "XX:",ne,lapw%nv
IF (zmat%l_real) THEN
DO istr=1,SIZE(zMat%z_r,2)
WRITE(99,*) "X:",istr,zMat%z_r(:,istr)
DO istr=1,SIZE(zMat%data_r,2)
WRITE(99,*) "X:",istr,zMat%data_r(:,istr)
ENDDO
ELSE
DO istr=1,SIZE(zMat%z_c,2)
WRITE(99,*) "X:",istr,zMat%z_c(:,istr)
DO istr=1,SIZE(zMat%data_c,2)
WRITE(99,*) "X:",istr,zMat%data_c(:,istr)
ENDDO
ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
......
MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)
SUBROUTINE q_int_sl(isp,ikpt,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
......@@ -19,11 +19,11 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_slab),INTENT(INOUT):: slab
!
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,isp
INTEGER, INTENT (IN) :: ne,isp,ikpt
! ..
! .. Local Scalars ..
REAL q1,zsl1,zsl2,qi,volsli,volintsli
......@@ -65,11 +65,11 @@ CONTAINS
q1 = 0.0
IF (zmat%l_real) THEN
DO i = 1,lapw%nv(isp)
q1 = q1 + zMat%z_r(i,n)*zMat%z_r(i,n)
q1 = q1 + zMat%data_r(i,n)*zMat%data_r(i,n)
ENDDO
ELSE
DO i = 1,lapw%nv(isp)
q1 = q1 + REAL(zMat%z_c(i,n)*CONJG(zMat%z_c(i,n)))
q1 = q1 + REAL(zMat%data_c(i,n)*CONJG(zMat%data_c(i,n)))
ENDDO
ENDIF
z_z(1) = q1/cell%omtil
......@@ -90,11 +90,11 @@ CONTAINS
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
IF (zmat%l_real) THEN
z_z(ind) = z_z(ind) + zMat%z_r(j,n)*zMat%z_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + zMat%z_r(i,n)*zMat%z_r(j,n)*REAL(phasep)
z_z(ind) = z_z(ind) + zMat%data_r(j,n)*zMat%data_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + zMat%data_r(i,n)*zMat%data_r(j,n)*REAL(phasep)
ELSE
z_z(ind) = z_z(ind) +zMat%z_c(j,n)*CONJG(zMat%z_c(i,n))*phase
z_z(indp)= z_z(indp)+zMat%z_c(i,n)*CONJG(zMat%z_c(j,n))*phasep
z_z(ind) = z_z(ind) +zMat%data_c(j,n)*CONJG(zMat%data_c(i,n))*phase
z_z(indp)= z_z(indp)+zMat%data_c(i,n)*CONJG(zMat%data_c(j,n))*phasep
ENDIF
ENDDO
ENDDO
......@@ -105,7 +105,7 @@ CONTAINS
DO j = 1,stars%ng3
qi = qi + z_z(j)*stfunint(j,i)
ENDDO
slab%qintsl(i,n) = qi
slab%qintsl(i,n,ikpt,isp) = qi
ENDDO ! over vacuum%layers
ENDDO ! over states
......
......@@ -134,7 +134,7 @@ CONTAINS
DO ntyp = 1,atoms%ntype
qq = qq + qmttot(ntyp,i)*slab%nmtsl(ntyp,nl)
ENDDO
slab%qmtsl(nl,i) = qq
slab%qmtsl(nl,i,ikpt,jsp) = qq
ENDDO
ENDDO
! DO ntyp = 1,ntype
......
This diff is collapsed.
......@@ -33,7 +33,7 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_zMat), INTENT(IN) :: zMat
TYPE(t_mat), INTENT(IN) :: zMat
TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force
! .. Scalar Arguments ..
......@@ -70,15 +70,15 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%data_c((iintsp-1)*(lapw%nv(1)+atoms%nlotot)+nbasf,i)
ELSE
ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%data_c(nbasf,i)+ccchi(2)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
ENDIF
ELSE
IF (zMat%l_real) THEN
ctmp = zMat%z_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ctmp = zMat%data_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ELSE
ctmp = zMat%z_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ctmp = zMat%data_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
......
......@@ -24,7 +24,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: iintsp
......@@ -88,15 +88,15 @@ CONTAINS
lm = ll1 + m
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)* ccchi(iintsp)*zMat%z_c(kspin+nbasf,ie)
ctmp = clotmp(m)* ccchi(iintsp)*zMat%data_c(kspin+nbasf,ie)
ELSE
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,ie)+ccchi(2)*zMat%z_c(kspin+nbasf,ie) )
ctmp = clotmp(m)*( ccchi(1)*zMat%data_c(nbasf,ie)+ccchi(2)*zMat%data_c(kspin+nbasf,ie) )
ENDIF
ELSE
IF (zmat%l_real) THEN
ctmp = zMat%z_r(nbasf,ie)*clotmp(m)
ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = zMat%z_c(nbasf,ie)*clotmp(m)
ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
ENDIF
ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
......@@ -136,15 +136,15 @@ CONTAINS
lm = ll1 + m
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,ie)
ctmp = clotmp(m)*ccchi(iintsp)*zMat%data_c(kspin+nbasf,ie)
ELSE
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,ie)+ccchi(2)*zMat%z_c(kspin+nbasf,ie) )
ctmp = clotmp(m)*( ccchi(1)*zMat%data_c(nbasf,ie)+ccchi(2)*zMat%data_c(kspin+nbasf,ie) )
ENDIF
ELSE
IF (zmat%l_real) THEN
ctmp = zMat%z_r(nbasf,ie)*clotmp(m)
ctmp = zMat%data_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = zMat%z_c(nbasf,ie)*clotmp(m)
ctmp = zMat%data_c(nbasf,ie)*clotmp(m)
END IF
ENDIF
acof(ie,lm,na) = acof(ie,lm,na) +ctmp*alo1(lo,ntyp)
......@@ -158,7 +158,7 @@ CONTAINS
cveccof(i,m,ie,lo,na)=cveccof(i,m,ie,lo,na)+fgp(i)*ctmp*clo1(lo,ntyp)
ENDDO
IF (noco%l_soc.AND.sym%invs) THEN
ctmp = zMat%z_c(nbasf,ie) * CONJG(clotmp(m))*(-1)**(l-m)
ctmp = zMat%data_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)
......
......@@ -25,7 +25,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_mat),INTENT(IN) :: zMat
TYPE(t_force),OPTIONAL,INTENT(INOUT) :: force
! ..
! .. Scalar Arguments ..
......@@ -138,9 +138,9 @@ CONTAINS
DO k = 1,nvmax