Skip to content

GitLab

fleur
fleur
Commit e11f4835 authored by Miriam Hinzen's avatar Miriam Hinzen
Browse files
Options

git wants me to add main/fleur.F90 although this is not modified

parent e5e541fa
Hide whitespace changes
Inline Side-by-side
Showing with 570 additions and 4099 deletions
.gitignore
View file @ e11f4835
init/compileinfo.h
io/xml/inputSchema.h
*~
\#*
build
......
CMakeLists.txt
View file @ e11f4835
......@@ -22,7 +22,7 @@ endif()
include("cmake/CompilerConfig.txt")
include("cmake/ReportConfig.txt")
include("cmake/Generate_Schema.cmake")
include("cmake/Files_and_Targets.txt")
include("cmake/filespecific.cmake")
......
cdn/cdnovlp.F90
View file @ e11f4835
......@@ -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
......
cdn/cdnval.F90
View file @ e11f4835
......@@ -105,7 +105,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE (t_force) :: force
TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
TYPE (t_mat) :: zMat
TYPE (t_gVacMap) :: gVacMap
CALL timestart("cdnval")
......
cdn/pwden.F90
View file @ e11f4835
......@@ -91,7 +91,7 @@ CONTAINS
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_mat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_dos), INTENT(INOUT) :: dos
......@@ -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
......@@ -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
!--------------------------------
......@@ -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) )
......
cdn/q_int_sl.F90
View file @ e11f4835
......@@ -19,7 +19,7 @@ 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 ..
......@@ -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
......
cdn/vacden.F90
View file @ e11f4835
......@@ -59,7 +59,7 @@ CONTAINS
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_mat),INTENT(IN) :: zMat
TYPE(t_gVacMap),INTENT(IN) :: gVacMap
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_dos), INTENT(INOUT) :: dos
......@@ -317,11 +317,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
IF (zmat%l_real) THEN
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*bv_1
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%data_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%data_r(kspin,:ne)*bv_1
ELSE
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*bv_1
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%data_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%data_c(kspin,:ne)*bv_1
END IF
END DO ! -mb:mb
END IF
......@@ -360,11 +360,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
IF (zmat%l_real) THEN
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_r(kspin,:ne)*bv
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%data_r(kspin,:ne)*bv
ELSE
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_c(kspin,:ne)*bv
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%data_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%data_c(kspin,:ne)*bv
ENDIF
ENDDO
!---> end of spin loop
......@@ -417,11 +417,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
IF (zmat%l_real) THEN
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*bv_1
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%data_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%data_r(k,:ne)*bv_1
ELSE
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*bv_1
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%data_c(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%data_c(k,:ne)*bv_1
ENDIF
END DO ! -mb:mb
END IF
......@@ -455,11 +455,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
IF (zmat%l_real) THEN
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_r(k,:ne)*bv
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%data_r(k,:ne)*bv
ELSE
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_c(k,:ne)*bv
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%data_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%data_c(k,:ne)*bv
ENDIF
ENDDO
END IF ! D1
......
cdn_mt/abclocdn.F90
View file @ e11f4835
......@@ -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(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)
......
cdn_mt/abclocdn_pulay.F90
View file @ e11f4835
......@@ -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)
......
cdn_mt/abcof.F90
View file @ e11f4835
......@@ -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
IF (.NOT.noco%l_noco) THEN
IF (zmat%l_real) THEN
work_r(:ne)=zMat%z_r(k,:ne)
work_r(:ne)=zMat%data_r(k,:ne)
ELSE
work_c(:ne)=zMat%z_c(k,:ne)
work_c(:ne)=zMat%data_c(k,:ne)
END IF
ENDIF
......@@ -155,7 +155,7 @@ CONTAINS
!---> stored in the second half of the eigenvector
kspin = (iintsp-1)*(lapw%nv(1)+atoms%nlotot)
DO i = 1,ne
work_c(i) = ccchi(iintsp,jspin)*zMat%z_c(kspin+k,i)
work_c(i) = ccchi(iintsp,jspin)*zMat%data_c(kspin+k,i)
ENDDO
ELSE
!---> perform sum over the two interstitial spin directions
......@@ -163,8 +163,8 @@ CONTAINS
!---> (jspin counts the local spin directions inside each MT)
kspin = lapw%nv(1)+atoms%nlotot
DO i = 1,ne
work_c(i) = ccchi(1,jspin)*zMat%z_c(k,i)&
& + ccchi(2,jspin)*zMat%z_c(kspin+k,i)
work_c(i) = ccchi(1,jspin)*zMat%data_c(k,i)&
& + ccchi(2,jspin)*zMat%data_c(kspin+k,i)
ENDDO
ENDIF
ENDIF ! (noco%l_noco)
......
cmake/Generate_Schema.cmake 0 → 100644
View file @ e11f4835
find_program(XXD_PROG xxd)
if (XXD_PROG)
ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMAND ${XXD_PROG} -i FleurInputSchema.xsd inputSchema.h
WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}/io/xml/
COMMENT "Putting current Schema into inputSchema.h")
else()
ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMAND mv ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h.backup ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMENT "No xxd found using backup")
message("No xxd command found! Using backup of inputSchema.h")
endif()
\ No newline at end of file
diagonalization/chase_diag.F90
View file @ e11f4835
......@@ -32,30 +32,44 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE chase_diag(hmat,smat,ne,eig,zmat)
SUBROUTINE chase_diag(mpi,hmat,smat,ikpt,jsp,chase_eig_id,iter,ne,eig,zmat)
USE m_types
USE m_types_mpi
USE m_judft
USE iso_c_binding
USE m_eig66_io
!Simple driver to solve Generalized Eigenvalue Problem using the ChASE library
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mat), INTENT(INOUT) :: hmat,smat
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: chase_eig_id
INTEGER, INTENT(IN) :: iter
INTEGER, INTENT(INOUT) :: ne
CLASS(t_mat), ALLOCATABLE, INTENT(OUT) :: zmat
REAL, INTENT(OUT) :: eig(:)
INTEGER :: i, j, nev, nex
INTEGER :: i, j, nev, nex, nbands
INTEGER :: info
CLASS(t_Mat), ALLOCATABLE :: zMatTemp
REAL(c_double), ALLOCATABLE :: eigenvalues(:)
REAL(c_double), ALLOCATABLE :: eigenvectors_r(:,:)
COMPLEX(c_double_complex), ALLOCATABLE :: eigenvectors_c(:,:)
ALLOCATE(t_mat::zmat)
CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne)
nev = min(ne,hmat%matsize1)
nex = min(max(nev/4, 45), hmat%matsize1-nev) !dimensioning for workspace
ALLOCATE(eigenvalues(nev+nex))
eigenvalues = 0.0
ALLOCATE(t_mat::zmatTemp)
CALL zMatTemp%alloc(hmat%l_real,hmat%matsize1,nev+nex)
IF (hmat%l_real) THEN
! --> start with Cholesky factorization of b ( so that b = l * l^t)
......@@ -76,31 +90,27 @@ IMPLICIT NONE
! --> solve a' * z' = eig * z' for eigenvalues eig between lb und ub
nev = min(ne,hmat%matsize1)
nex = min(max(nev/4, 45), hmat%matsize1-nev) !dimensioning for workspace
ALLOCATE(eigenvectors_r(smat%matsize1,nev+nex))
ALLOCATE(eigenvalues(nev+nex))
eigenvectors_r = 0.0
eigenvalues = 0.0
zMatTemp%data_r = 0.0
do j = 1, hmat%matsize1
do i = 1, j
hmat%data_r(j,i) = hmat%data_r(i,j)
end do
end do
! if(first_entry_franza) then
call chase_r(hmat%data_r, hmat%matsize1, eigenvectors_r, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
! else
! call chase_r(hmat%data_r, hmat%matsize1, eigenvectors_r, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
! end if
if(iter.EQ.1) then
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'R', 'S' )
else
CALL read_eig(chase_eig_id,ikpt,jsp,n_start=mpi%n_size,n_end=mpi%n_rank,neig=nbands,eig=eigenvalues,zmat=zMatTemp)
call chase_r(hmat%data_r, hmat%matsize1, zMatTemp%data_r, eigenvalues, nev, nex, 25, 1e-10, 'A', 'S' )
end if
ne = nev
CALL write_eig(chase_eig_id,ikpt,jsp,nev+nex,nev+nex,&
eigenvalues(:(nev+nex)),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMatTemp)
! --> recover the generalized eigenvectors z by solving z' = l^t * z
CALL dtrtrs('U','N','N',hmat%matsize1,nev,smat%data_r,eigenvectors_r,zmat%matsize1,info)
CALL dtrtrs('U','N','N',hmat%matsize1,nev,smat%data_r,smat%matsize1,zMatTemp%data_r,zmat%matsize1,info)
IF (info.NE.0) THEN
WRITE (6,*) 'Error in dtrtrs: info =',info
CALL juDFT_error("Diagonalization failed",calledby="chase_diag")
......@@ -108,20 +118,12 @@ IMPLICIT NONE
DO i = 1, ne
DO j = 1, hmat%matsize1
zmat%data_r(j,i) = eigenvectors_r(j,i)
zmat%data_r(j,i) = zMatTemp%data_r(j,i)
END DO
eig(i) = eigenvalues(i)
END DO
!TODO: Store eigenvectors array to reuse it in next iteration
DEALLOCATE(eigenvalues)
DEALLOCATE(eigenvectors_r)
ELSE
! --> start with Cholesky factorization of b ( so that b = l * l^t)
......@@ -142,14 +144,7 @@ IMPLICIT NONE