Skip to content

fleur
fleur
Commit f6c81798 authored by Gregor Michalicek's avatar Gregor Michalicek
1 Browse files
Options

Move prp_qfft_map call to fleur_init 

(Sorry, this commit breaks fleur I will correct it as soon as possible.)
parent fe07424d
Hide whitespace changes
Inline Side-by-side
Showing with 33 additions and 33 deletions
cdn/cdnval.F90
View file @ f6c81798
......@@ -2,7 +2,7 @@ MODULE m_cdnval
use m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,igq_fft,vTot,oneD,coreSpecInput,den,results,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,den,results,&
qvac,qvlay,qa21, chmom,clmom)
!
! ***********************************************************
......@@ -117,7 +117,6 @@ CONTAINS
! .. Array Arguments ..
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype)
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL, INTENT (OUT) :: chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
REAL, INTENT (INOUT) :: qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd)
REAL, INTENT (INOUT) :: qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,dimension%jspd)
......@@ -651,8 +650,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, eig,den,qis,results%force,f_b8,zMat)
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,den,qis,results%force,f_b8,zMat)
CALL timestop("cdnval: pwden")
END IF
!+new
......
cdn/pwden.F90
View file @ f6c81798
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne, igq_fft,we,eig,den,qis,forces,f_b8,zMat)
ikpt,jspin,lapw,ne,we,eig,den,qis,forces,f_b8,zMat)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -94,7 +94,6 @@ CONTAINS
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
!-----> BASIS FUNCTION INFORMATION
......@@ -491,7 +490,7 @@ CONTAINS
cwk=0.0
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(psi1r(igq_fft(ik)),psi1i(igq_fft(ik)))
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)
......@@ -500,7 +499,8 @@ CONTAINS
cwk=0.0
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))* CMPLX(psi2r(igq_fft(ik)),psi2i(igq_fft(ik)))
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
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)
......@@ -608,27 +608,32 @@ CONTAINS
ecwk=0.0
IF (noco%l_noco) THEN
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))* CMPLX(rhomat(igq_fft(ik),idens),psi1r(igq_fft(ik)))
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhomat(stars%igq_fft(ik),idens),psi1r(stars%igq_fft(ik)))
ENDDO
ELSE
IF (zmat%l_real) THEN
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))* CMPLX(rhon(igq_fft(ik)),zero)
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhon(stars%igq_fft(ik)),zero)
ENDDO
ELSE
DO ik = 0 , stars%kmxq_fft - 1
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))* CMPLX(rhon(igq_fft(ik)),psir(igq_fft(ik)))
cwk(stars%igfft(ik,1))=cwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(rhon(stars%igq_fft(ik)),psir(stars%igq_fft(ik)))
ENDDO
ENDIF
!+apw
IF (input%l_f) THEN
IF (zmat%l_real) THEN
DO ik = 0 , stars%kmxq_fft - 1
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))* CMPLX(ekin(igq_fft(ik)),zero)
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(ekin(stars%igq_fft(ik)),zero)
ENDDO
ELSE
DO ik = 0 , stars%kmxq_fft - 1
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))* CMPLX(ekin(igq_fft(ik)),psii(igq_fft(ik)))
ecwk(stars%igfft(ik,1))=ecwk(stars%igfft(ik,1))+CONJG(stars%pgfft(ik))*&
CMPLX(ekin(stars%igq_fft(ik)),psii(stars%igq_fft(ik)))
ENDDO
ENDIF
ENDIF
......
main/cdngen.F90
View file @ f6c81798
......@@ -77,13 +77,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!Local Arrays
REAL stdn(atoms%ntype,dimension%jspd),svdn(atoms%ntype,dimension%jspd)
REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
INTEGER,ALLOCATABLE :: igq_fft(:)
REAL ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:)
!pk non-collinear (start)
INTEGER igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1)
COMPLEX,ALLOCATABLE :: qa21(:)
!pk non-collinear (end)
IF (mpi%irank.EQ.0) THEN
INQUIRE(file='enpara',exist=l_enpara)
......@@ -92,40 +87,32 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
ALLOCATE (qa21(atoms%ntype))
ALLOCATE (qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd))
ALLOCATE (qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,dimension%jspd))
ALLOCATE (igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
!initialize density arrays with zero
qa21(:) = cmplx(0.0,0.0)
qvac(:,:,:,:) = 0.0
qvlay(:,:,:,:,:) = 0.0
!Set up pointer for backtransformation of from g-vector in
!positive domain fof carge density fftibox into stars
!In principle this can also be done in main program once.
!It is done here to save memory.
CALL prp_qfft_map(stars,sym, input, igq2_fft,igq_fft)
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
!in a non-collinear calcuation where the off-diagonal part of
!In a non-collinear calcuation where the off-diagonal part of the
!density matrix in the muffin-tins is calculated, the a- and
!b-coef. for both spins are needed at once. Thus, cdnval is only
!called once and both spin directions are calculated in a single
!go.
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
!called once and both spin directions are calculated in a single run.
jspmax = input%jspins
IF (noco%l_mperp) jspmax = 1
DO jspin = 1,jspmax
CALL timestart("cdngen: cdnval")
CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,igq_fft,vTot,oneD,coreSpecInput,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,&
outDen,results,qvac,qvlay,qa21,chmom,clmom)
CALL timestop("cdngen: cdnval")
END DO
IF (mpi%irank.EQ.0) THEN
IF (l_enpara) CLOSE (40)
CALL cdntot(stars,atoms,sym, vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
CALL closeXMLElement('valenceDensity')
END IF ! mpi%irank = 0
......@@ -166,7 +153,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
#endif
DEALLOCATE (qvac,qvlay,qa21)
DEALLOCATE (igq_fft)
END SUBROUTINE cdngen
......
main/fleur_init.F90
View file @ f6c81798
......@@ -32,6 +32,7 @@
USE m_cdn_io
USE m_fleur_info
USE m_checks
USE m_prpqfftmap
USE m_writeOutHeader
#ifdef CPP_MPI
USE m_mpi_bc_all, ONLY : mpi_bc_all
......@@ -521,7 +522,14 @@
& noco,oneD,xcpot,hybrid)
! initialize record length of the eig file
#endif
#endif
! Set up pointer for backtransformation from g-vector in positive
! domain of carge density fftibox into stars
ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)
atoms%nlotot = 0
DO n = 1, atoms%ntype
DO l = 1,atoms%nlo(n)
......
types/types_misc.F90
View file @ f6c81798
......@@ -312,6 +312,8 @@ MODULE m_types_misc
INTEGER :: kq2_fft
INTEGER :: kq3_fft
INTEGER :: kmxq_fft !no of g-vectors in sphere
INTEGER, ALLOCATABLE :: igq_fft(:)
INTEGER, ALLOCATABLE :: igq2_fft(:)
!fft box for xc-pot
INTEGER :: kxc1_fft
......
  • Gregor Michalicek @micha ·
    Maintainer

    I just realized that the commit actually doesn't break fleur. I probably had compiled an inconsistent executable. The error I got (a "signal 11") now disappeared and is not reproducible.

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