Commit 462fa9a2 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files

Merge branch 'develop' of iffgit:/fleur/fleur into develop

parents 40eda20b 11f5c0f2
......@@ -15,7 +15,7 @@ cdn/m_perp.f90
cdn/n_mat.f90
cdn/n_mat21.f90
cdn/od_abvac.f90
cdn/prp_qfft_map.f90
#cdn/prp_qfft_map.f90
cdn/pwden.F90
cdn/pwint.f90
cdn/pwint_sl.f90
......
......@@ -123,7 +123,7 @@ CONTAINS
COMPLEX,INTENT(IN),OPTIONAL :: vpw(:,:)
REAL,INTENT(IN),OPTIONAL :: vr(:,0:,:,:)
COMPLEX,INTENT (INOUT) :: qpw(stars%ng3,input%jspins)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
REAL, INTENT (INOUT) :: rh(atoms%msh,atoms%ntype)
......@@ -443,10 +443,10 @@ CONTAINS
!
!=====> calculate the fourier transform of the core-pseudocharge
IF (l_f2) THEN
CALL ft_of_CorePseudocharge(fmpi,atoms,mshc,alpha,tol_14,rh, &
CALL ft_of_CorePseudocharge(fmpi,input,atoms,mshc,alpha,tol_14,rh, &
acoff,stars,method2,rat,cell,oneD,sym,qpwc,jspin,l_f2,vpw,ffonat,force_a4_mt_loc)
ELSE
CALL ft_of_CorePseudocharge(fmpi,atoms,mshc,alpha,tol_14,rh, &
CALL ft_of_CorePseudocharge(fmpi,input,atoms,mshc,alpha,tol_14,rh, &
acoff,stars,method2,rat,cell,oneD,sym,qpwc,jspin,l_f2)
END IF
......@@ -687,7 +687,7 @@ CONTAINS
! INTERNAL SUBROUTINES
!***********************************************************************
subroutine ft_of_CorePseudocharge(fmpi,atoms,mshc,alpha,&
subroutine ft_of_CorePseudocharge(fmpi,input,atoms,mshc,alpha,&
tol_14,rh,acoff,stars,method2,rat,cell,oneD,sym,qpwc,jspin,l_f2,vpw,ffonat,force_a4_mt_loc)
!=====> calculate the fourier transform of the core-pseudocharge
......@@ -700,7 +700,7 @@ CONTAINS
USE m_types
type(t_mpi) ,intent(in) :: fmpi
TYPE(t_input), INTENT(in) ::input
type(t_atoms) ,intent(in) :: atoms
integer ,intent(in) :: mshc(atoms%ntype),jspin
real ,intent(in) :: alpha(atoms%ntype), tol_14
......@@ -719,6 +719,7 @@ CONTAINS
! ..Local variables
integer nat1, n, n_out_p, k
INTEGER :: reducedStarsCutoff ! This is introduced to avoid numerical instabilities.
complex czero
! ..Local arrays
......@@ -730,11 +731,12 @@ CONTAINS
#endif
czero = (0.0,0.0)
#ifdef CPP_MPI
DO k = 1 , stars%ng3
DO k = 1, stars%ng3
qpwc_loc(k) = czero
ENDDO
#endif
DO k = 1 , stars%ng3
DO k = 1, stars%ng3
IF (stars%sk3(k).LE.3.0*input%rkmax) reducedStarsCutoff = k ! The factor 3.0 is arbitrary. One could try going down to 2.0.
qpwc(k) = czero
ENDDO
......@@ -749,7 +751,7 @@ CONTAINS
! (1) Form factor for each atom type
CALL FormFactor_forAtomType(atoms%msh,method2,n_out_p,&
CALL FormFactor_forAtomType(atoms%msh,method2,n_out_p,reducedStarsCutoff,&
atoms%rmt(n),atoms%jri(n),atoms%dx(n),mshc(n),rat(:,n), &
rh(:,n),alpha(n),stars,cell,acoff(n),qf)
......@@ -763,11 +765,11 @@ CONTAINS
END IF
IF (l_f2) THEN
CALL StructureConst_forAtom(nat1,stars,oneD,sym,&
CALL StructureConst_forAtom(nat1,stars,oneD,sym,reducedStarsCutoff,&
atoms%neq(n),atoms%nat,atoms%taual,&
cell,qf,qpwc_at,jspin,l_f2,n,vpw,ffonat)
ELSE
CALL StructureConst_forAtom(nat1,stars,oneD,sym,&
CALL StructureConst_forAtom(nat1,stars,oneD,sym,reducedStarsCutoff,&
atoms%neq(n),atoms%nat,atoms%taual,&
cell,qf,qpwc_at,jspin,l_f2,n)
END IF
......@@ -796,7 +798,7 @@ CONTAINS
END IF
end subroutine ft_of_CorePseudocharge
SUBROUTINE StructureConst_forAtom(nat1,stars,oneD,sym,&
SUBROUTINE StructureConst_forAtom(nat1,stars,oneD,sym,reducedStarsCutoff,&
neq,natd,taual,cell,qf,qpwc_at,jspin,l_f2,n,vpw,ffonat)
! Calculates the structure constant for each atom of atom type
......@@ -809,6 +811,7 @@ CONTAINS
type(t_stars), intent(in) :: stars
type(t_oneD), intent(in) :: oneD
type(t_sym), intent(in) :: sym
INTEGER, INTENT(IN) :: reducedStarsCutoff
integer, intent(in) :: neq,natd, jspin, n
real, intent(in) :: taual(3,natd)
type(t_cell), intent(in) :: cell
......@@ -829,9 +832,7 @@ CONTAINS
complex phaso(oneD%ods%nop), kcmplx(3)
czero = (0.0,0.0)
DO k = 1 , stars%ng3
qpwc_at(k) = czero
END DO
qpwc_at(:) = czero
! first G=0
k=1
......@@ -842,11 +843,11 @@ CONTAINS
force_mt_loc=0.0
force_is_loc=cmplx(0.0,0.0)
!$OMP PARALLEL DO DEFAULT(none) &
!$OMP SHARED(stars,oneD,sym,neq,natd,nat1,taual,cell,qf,qpwc_at,l_f2,ffonat,n,jspin,vpw) &
!$OMP SHARED(stars,oneD,sym,reducedStarsCutoff,neq,natd,nat1,taual,cell,qf,qpwc_at,l_f2,ffonat,n,jspin,vpw) &
!$OMP FIRSTPRIVATE(czero) &
!$OMP PRIVATE(k,kr,phas,nat2,nat,sf,j,x,kro,phaso,kcmplx,phase) &
!$OMP REDUCTION(+:force_mt_loc,force_is_loc)
DO k = 2,stars%ng3
DO k = 2,reducedStarsCutoff
IF (.NOT.oneD%odi%d1) THEN
CALL spgrot(sym%nop, sym%symor, sym%mrot, sym%tau, sym%invtab, &
stars%kv3(:,k), kr, phas)
......@@ -912,7 +913,7 @@ CONTAINS
END IF
END SUBROUTINE StructureConst_forAtom
SUBROUTINE FormFactor_forAtomType(msh, method2, n_out_p, rmt, jri, dx, &
SUBROUTINE FormFactor_forAtomType(msh, method2, n_out_p, reducedStarsCutoff, rmt, jri, dx, &
mshc, rat, rh, alpha, stars, cell, acoff, &
qf)
......@@ -923,6 +924,7 @@ CONTAINS
integer ,intent(in) :: msh,method2, n_out_p
INTEGER, INTENT(IN) :: reducedStarsCutoff
real ,intent(in) :: rmt
integer ,intent(in) :: jri
real ,intent(in) :: dx
......@@ -944,9 +946,7 @@ CONTAINS
real rhohelp(msh)
zero = 0.0
DO k = 1,stars%ng3
qf(k) = 0.0
END DO
qf(:) = 0.0
tail = .FALSE.
f11 = tpi_const * rmt * rh(jri) / alpha
......@@ -954,11 +954,11 @@ CONTAINS
ar = SQRT( alpha ) * rmt
!$OMP PARALLEL DO DEFAULT(none) &
!$OMP SHARED(stars,f11,f12,ar,method2,n_out_p,jri,rat,rh,dx,tail) &
!$OMP SHARED(stars,f11,f12,ar,method2,n_out_p,reducedStarsCutoff,jri,rat,rh,dx,tail) &
!$OMP SHARED(alpha,cell,mshc,rmt,qf) &
!$OMP FIRSTPRIVATE(zero) &
!$OMP PRIVATE(k,g,ai,qfin,ir,j,rhohelp,qfout,gr,a4,alpha3)
DO k = 1,stars%ng3
DO k = 1, reducedStarsCutoff
g = stars%sk3(k)
! first G=0
IF ( k.EQ.1 ) THEN
......
......@@ -151,8 +151,8 @@ CONTAINS
enddo
call finish_mt_grid()
call init_pw_grid(xcpot%needs_grad(), stars, sym, cell)
call pw_from_grid(xcpot%needs_grad(), stars, .False., is, tmp_potden%pw)
call init_pw_grid(stars, sym, cell,xcpot)
call pw_from_grid( stars, is, tmp_potden%pw) !THIS CODE SEEMS TO BE BROKEN!!
call finish_pw_grid()
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, tmp_potden, &
......
......@@ -297,7 +297,7 @@ SUBROUTINE cdnval(eig_id, fmpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
IF (input%l_f) THEN
CALL tlmplm%init(atoms,input%jspins,.FALSE.)
CALL tlmplm_cholesky(sphhar,atoms,sym,noco,nococonv,enpara,ispin,fmpi,vTot,vtot,den,input,hub1inp,hub1data,tlmplm,usdus,0.0,.FALSE.)
CALL tlmplm_cholesky(sphhar,atoms,sym,noco,nococonv,enpara,ispin,fmpi,vTot,vtot,den,input,hub1inp,hub1data,tlmplm,usdus,0.0)
CALL force%addContribsA21A12(input,atoms,sym,cell,oneD,enpara,&
usdus,tlmplm,vtot,eigVecCoeffs,noccbd,ispin,eig,we,results,jsp_start,jspin,nbasfcn,zMat,lapw,sphhar,lapw%gvec(1,:,:),lapw%gvec(2,:,:),lapw%gvec(3,:,:),bkpt)
ENDIF
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_prpqfftmap
use m_juDFT
CONTAINS
SUBROUTINE prp_qfft_map(stars,sym,input, igq2_fft,igq_fft)
!*********************************************************************
! This subroutine prepares the pointer which identifies a
! threedimensional g-vector in the positive domain of the
! charge density fft-box in order to map a 3-d g-vector
! onto stars in case of the backtransform for fft of the
! charge density. correspondes to igfft(*,2)
! it is independent of spin and k-point.
! pointer is built up when ever the chargedensity is calculated
! in order to save memory
!
! s. bluegel, JRCAT, Feb. 97
!*********************************************************************
!
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
!
!
INTEGER igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1),igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
!
!---> local variables
!
LOGICAL new
INTEGER istr,iop,iopm1,il,im,in,kid2x,kidx,iv1d,ifftq1,ifftq2
INTEGER norm,kr(3,sym%nop),nop_local
!-------> ABBREVIATIONS
!
! kq1d : dimension of the charge density FFT box in the pos. domain
! kq2d : defined in dimens.f program (subroutine apws).1,2,3 indicate
! kq3d ; a_1, a_2, a_3 directions.
! kq(i) : i=1,2,3 actual length of the fft-box for which FFT is done.
! nstr : number of members (arms) of reciprocal lattice (g) vector
! of each star.
! nq3_fft: number of stars in the charge density FFT-box
! kmxq_fft: number of g-vectors forming the nq3_fft stars in the
! charge density sphere
!
!-----> prepare pointer which identifies a threedimensional g-vector
! in the positive domain of the charge density fft-box.
! correspondes to igfft(*,2)
!
kidx = 0
kid2x = 0
ifftq1 = stars%kq1_fft
ifftq2 = stars%kq1_fft*stars%kq2_fft
!
DO istr = 1 , stars%ng3_fft
!
nop_local=sym%nop
IF (stars%kv3(3,istr).EQ.0) nop_local=sym%nop2
!
DO iop = 1,nop_local
kr(1,iop) = stars%kv3(1,istr)*sym%mrot(1,1,iop) &
+ stars%kv3(2,istr)*sym%mrot(2,1,iop)+ stars%kv3(3,istr)*sym%mrot(3,1,iop)
kr(2,iop) = stars%kv3(1,istr)*sym%mrot(1,2,iop) &
+ stars%kv3(2,istr)*sym%mrot(2,2,iop)+ stars%kv3(3,istr)*sym%mrot(3,2,iop)
kr(3,iop) = stars%kv3(1,istr)*sym%mrot(1,3,iop) &
+ stars%kv3(2,istr)*sym%mrot(2,3,iop) + stars%kv3(3,istr)*sym%mrot(3,3,iop)
ENDDO
!
DO iop = 1 , nop_local
new=.true.
DO iopm1 = 1 , iop - 1
norm=(kr(1,iop)-kr(1,iopm1))**2 +&
(kr(2,iop)-kr(2,iopm1))**2 +(kr(3,iop)-kr(3,iopm1))**2
IF (norm.EQ.0) new=.false.
ENDDO
IF (new) THEN
il=kr(1,iop)
im=kr(2,iop)
in=kr(3,iop)
if(il.lt.0) il=il+stars%kq1_fft
if(im.lt.0) im=im+stars%kq2_fft
if(in.lt.0) in=in+stars%kq3_fft
iv1d = in*ifftq2 + im*ifftq1 + il
igq_fft(kidx)=iv1d
kidx=kidx+1
IF (input%film.AND.(stars%kv3(3,istr).EQ.0)) THEN
iv1d = im*ifftq1 + il
igq2_fft(kid2x)=iv1d
kid2x=kid2x+1
ENDIF
ENDIF
ENDDO
!
ENDDO
!
IF (kidx .NE. stars%kmxq_fft) THEN
WRITE (oUnit,'('' something wrong with stars%kmxq_fft or nq3_fft'')')
WRITE (oUnit,'('' stars%kmxq_fft, acutal kidx '',2i5)') stars%kmxq_fft, kidx
CALL juDFT_error("something wrong with stars or nq3_fft", calledby ="prp_qfft_map")
ENDIF
END SUBROUTINE prp_qfft_map
END MODULE m_prpqfftmap
......@@ -125,7 +125,7 @@ CONTAINS
IF (banddos%dos .OR. banddos%vacdos .OR. input%cdinf.OR.banddos%band) THEN
stateFFTExtendedRadius = 3.0*stateRadius+0.1
CALL stepFct%init(cell,sym,stateFFTExtendedRadius+0.001)
CALL stepFct%putFieldOnGrid(stars, stars%ustep, stateFFTRadius+0.0005)
CALL stepFct%putFieldOnGrid(stars, stars%ustep, cell,stateFFTRadius+0.0005)
CALL stepFct%fillFieldSphereIndexArray(stars, stateFFTRadius+0.0008, fieldSphereIndices)
CALL fft_interface(3, stepFct%dimensions(:), stepFct%grid, .FALSE., fieldSphereIndices)
END IF
......
......@@ -60,13 +60,14 @@
x = (0.0,0.0)
END IF
ELSE
ig2d = stars%ig2(ig3d)
IF (ig2d.EQ.1) THEN
g = stars%kv3(3,ng)*cell%bmat(3,3)*cell%z1
x = cmplx(cell%vol*sin(g)/g,0.0)
ELSE
x = (0.0,0.0)
END IF
x = (0.0,0.0)
if (allocated(stars%ig2)) THEN !film
ig2d = stars%ig2(ig3d)
IF (ig2d.EQ.1) THEN
g = stars%kv3(3,ng)*cell%bmat(3,3)*cell%z1
x = cmplx(cell%vol*sin(g)/g,0.0)
ENDIF
END IF
END IF
END IF
......@@ -77,7 +78,7 @@
IF (.NOT.oneD%odi%d1) THEN
CALL spgrot(&
& sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab,&
& stars%kv3,&
& stars%kv3(:,ig3d),&
& kr,ph)
DO n = 1,atoms%ntype
srmt = s*atoms%rmt(n)
......@@ -99,7 +100,7 @@
srmt = s*atoms%rmt(n)
CALL spgrot(&
& sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab,&
& stars%kv3,&
& stars%kv3(:,ig3d),&
& kr,ph)
sfs = (0.0,0.0)
DO nn = 1,sym%nop
......@@ -167,8 +168,9 @@
x(ng) = cmplx(cell%volint,0.0)
cycle starloop
ELSE
IF (oneD%odi%d1) THEN
IF (allocated(stars%ig2)) THEN
!Film calculation
IF (oneD%odi%d1) THEN
IF (stars%kv3(3,ng).EQ.0) THEN
g = (stars%kv3(1,ng)*cell%bmat(1,1) + stars%kv3(2,ng)*cell%bmat(2,1))**2 + &
(stars%kv3(1,ng)*cell%bmat(1,2) + stars%kv3(2,ng)*cell%bmat(2,2))**2
......@@ -179,7 +181,7 @@
ELSE
x(ng) = (0.0,0.0)
END IF
ELSE
ELSE
ig2d = stars%ig2(ig3d)
IF (ig2d.EQ.1) THEN
g = stars%kv3(3,ng)*cell%bmat(3,3)*cell%z1
......@@ -187,8 +189,10 @@
ELSE
x(ng) = (0.0,0.0)
END IF
END IF
END IF
ELSE
x(ng)=0.0
ENDIF
END IF
! -----> sphere contributions
s = stars%sk3(ig3d)
......
......@@ -133,7 +133,7 @@ CONTAINS
CALL setabc1lo(atoms,iType,usdus,jspin,alo1,blo1,clo1)
! generate the spinors (chi)
IF(noco%l_noco) ccchi=nococonv%chi(itype)
IF(noco%l_noco) ccchi=conjg(nococonv%umat(itype))
nintsp = 1
......@@ -212,7 +212,7 @@ CONTAINS
!$acc host_data use_device(work_c,abCoeffs,abTemp)
CALL zgemm_acc("T","C",ne,2*abSize,nvmax,CMPLX(1.0,0.0),work_c,MAXVAL(lapw%nv),abCoeffs,2*atoms%lmaxd*(atoms%lmaxd+2)+2,CMPLX(0.0,0.0),abTemp,acof_size)
CALL zgemm_acc("T","T",ne,2*abSize,nvmax,CMPLX(1.0,0.0),work_c,MAXVAL(lapw%nv),abCoeffs,2*atoms%lmaxd*(atoms%lmaxd+2)+2,CMPLX(0.0,0.0),abTemp,acof_size)
!$acc end host_data
!stop "DEBUG"
......@@ -302,8 +302,8 @@ CONTAINS
lm = ll1 + m
lmp = ll1 - m
inv_f = (-1)**(l-m)
acof(:,lmp,jatom)=acof(:,lmp,jatom)+inv_f*matmul(abCoeffs(lm+1,:),work_c(:nvmax,:))
bcof(:,lmp,jatom)=bcof(:,lmp,jatom)+inv_f*matmul(abCoeffs(lm+1+abSize,:),work_c(:nvmax,:))
acof(:,lmp,jatom)=acof(:,lmp,jatom)+inv_f*matmul(CONJG(abCoeffs(lm+1,:)),work_c(:nvmax,:)) !TODO: Is this conjugation costly?
bcof(:,lmp,jatom)=bcof(:,lmp,jatom)+inv_f*matmul(CONJG(abCoeffs(lm+1+abSize,:)),work_c(:nvmax,:)) !TODO: Is this conjugation costly?
!CALL zaxpy(ne,c_1,workTrans_c(:,iLAPW),1, acof(:,lmp,jatom),1)
!CALL zaxpy(ne,c_2,workTrans_c(:,iLAPW),1, bcof(:,lmp,jatom),1)
END DO
......@@ -336,10 +336,10 @@ CONTAINS
fgpl(:,iLAPW) = MATMUL(fgr,cell%bmat)
ENDDO
helpMat_c = abCoeffs(1+abSize:,:)
helpMat_c = CONJG(abCoeffs(1+abSize:,:)) !TODO: Is this conjugation costly?
workTrans_cf = 0.0
CALL zgemm("N","C",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),s2h_e,ne,abCoeffs,size(abcoeffs,1),CMPLX(1.0,0.0),force%e1cof(:,:,iAtom),ne)
CALL zgemm("N","T",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),s2h_e,ne,abCoeffs,size(abcoeffs,1),CMPLX(1.0,0.0),force%e1cof(:,:,iAtom),ne)
CALL zgemm("N","C",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),s2h_e,ne,helpMat_c,size(helpMat_c,1),CMPLX(1.0,0.0),force%e2cof(:,:,iAtom),ne)
DO i =1,3
IF (zmat%l_real) THEN
......@@ -351,7 +351,7 @@ CONTAINS
workTrans_cf(:,iLAPW) = workTrans_c(:,iLAPW) * fgpl(i,iLAPW)
ENDDO
ENDIF
CALL zgemm("N","C",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),workTrans_cf,ne,abCoeffs,size(abCoeffs,1),CMPLX(0.0,0.0),helpMat_force,ne)
CALL zgemm("N","T",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),workTrans_cf,ne,abCoeffs,size(abCoeffs,1),CMPLX(0.0,0.0),helpMat_force,ne)
force%aveccof(i,:,:,iAtom) = force%aveccof(i,:,:,iAtom) + helpMat_force(:,:)
CALL zgemm("N","C",ne,atoms%lmaxd*(atoms%lmaxd+2)+1,nvmax,CMPLX(1.0,0.0),workTrans_cf,ne,helpMat_c,size(helpMat_c,1),CMPLX(0.0,0.0),helpMat_force,ne)
force%bveccof(i,:,:,iAtom) = force%bveccof(i,:,:,iAtom) + helpMat_force(:,:)
......@@ -363,8 +363,8 @@ CONTAINS
ll1 = l* (l+1)
DO m = -l,l
lm = ll1 + m
c_1 = CONJG(abCoeffs(lm+1,iLAPW))
c_2 = CONJG(abCoeffs(lm+1+abSize,iLAPW))
c_1 = abCoeffs(lm+1,iLAPW)
c_2 = abCoeffs(lm+1+abSize,iLAPW)
jatom = sym%invsatnr(iAtom)
lmp = ll1 - m
inv_f = (-1)**(l-m)
......
......@@ -252,12 +252,12 @@ CONTAINS
+ denCoeffsOffdiag%du21(l,itype)*( g(j,1,l,2)*f(j,1,l,1) +g(j,2,l,2)*f(j,2,l,1) )&
+ denCoeffsOffdiag%dd21(l,itype)*( g(j,1,l,2)*g(j,1,l,1) +g(j,2,l,2)*g(j,2,l,1) )
!rho21(j,0,itype) = rho21(j,0,itype)+ conjg(cs)/(atoms%neq(itype)*sfp_const)
rho21=CONJG(cs)/(atoms%neq(itype)*sfp_const)
rho(j,0,itype,3)=rho(j,0,itype,3)+REAL(rho21)
rho(j,0,itype,4)=rho(j,0,itype,4)-aimag(rho21)
rho21 = cs/(atoms%neq(itype)*sfp_const)
rho(j,0,itype,3) = rho(j,0,itype,3) + REAL(rho21)
rho(j,0,itype,4) = rho(j,0,itype,4) + AIMAG(rho21)
IF (l.LE.input%lResMax) THEN
moments%rhoLRes(j,0,llp,itype,3) = moments%rhoLRes(j,0,llp,itype,3)+REAL(conjg(cs)/(atoms%neq(itype)*sfp_const))
moments%rhoLRes(j,0,llp,itype,4) = moments%rhoLRes(j,0,llp,itype,4)-AIMAG(conjg(cs)/(atoms%neq(itype)*sfp_const))
moments%rhoLRes(j,0,llp,itype,3) = moments%rhoLRes(j,0,llp,itype,3)+ REAL(cs/(atoms%neq(itype)*sfp_const))
moments%rhoLRes(j,0,llp,itype,4) = moments%rhoLRes(j,0,llp,itype,4)+ AIMAG(cs/(atoms%neq(itype)*sfp_const))
END IF
ENDDO
ENDDO
......@@ -276,12 +276,12 @@ CONTAINS
+ g(j,2,lp,2)*f(j,2,l,1) )+ denCoeffsOffdiag%ddnmt21(llp,lh,itype)*(g(j,1,lp,2)*g(j,1,l,1)&
+ g(j,2,lp,2)*g(j,2,l,1) )
!rho21(j,lh,itype)= rho21(j,lh,itype)+ CONJG(cs)/atoms%neq(itype)
rho21=CONJG(cs)/atoms%neq(itype)
rho(j,lh,itype,3)=rho(j,lh,itype,3)+REAL(rho21)
rho(j,lh,itype,4)=rho(j,lh,itype,4)-aimag(rho21)
rho21 = cs/atoms%neq(itype)
rho(j,lh,itype,3) = rho(j,lh,itype,3) + REAL(rho21)
rho(j,lh,itype,4) = rho(j,lh,itype,4) + AIMAG(rho21)
IF ((l.LE.input%lResMax).AND.(lp.LE.input%lResMax)) THEN
moments%rhoLRes(j,lh,llpb,itype,3)= moments%rhoLRes(j,lh,llpb,itype,3) + REAL(conjg(cs)/atoms%neq(itype))
moments%rhoLRes(j,lh,llpb,itype,4)= moments%rhoLRes(j,lh,llpb,itype,4) - AIMAG(conjg(cs)/atoms%neq(itype))
moments%rhoLRes(j,lh,llpb,itype,3)= moments%rhoLRes(j,lh,llpb,itype,3) + REAL(cs/atoms%neq(itype))
moments%rhoLRes(j,lh,llpb,itype,4)= moments%rhoLRes(j,lh,llpb,itype,4) + AIMAG(cs/atoms%neq(itype))
END IF
ENDDO
ENDDO
......
......@@ -41,7 +41,6 @@ MODULE m_rhonmt21
! .. Local Scalars ..
COMPLEX coef, cil, coef1
COMPLEX, PARAMETER :: mi = (0.0,-1.0)
COMPLEX :: temp(ne)
#include"cpp_double.h"
......@@ -81,7 +80,7 @@ MODULE m_rhonmt21
IF (lplow.GT.lphi) CYCLE m_loop
DO lp = lplow, lphi,2
cil = mi**(l-lp)
cil = ImagUnit**(lp-l)
coef1 = cil * sphhar%clnu(jmem,lh,ns)
lmp = lp*(lp+1) + mp
......
......@@ -36,4 +36,4 @@ else()
set(git_branch unknown)
endif()
message("compile_date=\"${compile_time}\"\ncompile_user=\"${compile_user}\"\ncompile_host=\"${compile_host}\"\ngitdesc=\"${git_describe}\"\ngitbranch=\"${git_branch}\"\ngithash=\"${git_hash}\"")
file(WRITE "${BI_FILE}" "compile_date=\"${compile_time}\"\ncompile_user=\"${compile_user}\"\ncompile_host=\"${compile_host}\"\ngitdesc=\"${git_describe}\"\ngitbranch=\"${git_branch}\"\ngithash=\"${git_hash}\"")
......@@ -2,7 +2,7 @@
#init/compile_descr.F90 to determine the program version and
#some compilation environment description
include("${CMAKE_SOURCE_DIR}/cmake/buildinfo.cmake")
#include("${CMAKE_SOURCE_DIR}/cmake/buildinfo.cmake")
file(REMOVE ${CMAKE_SOURCE_DIR}/init/compileinfo.h)
file(GENERATE OUTPUT ${CMAKE_BINARY_DIR}/include/compileinfo.h CONTENT "compile_flags=\"${CMAKE_Fortran_FLAGS}\"\nlink_flags=\"${FLEUR_LIBRARIES}\"\n")
......@@ -18,7 +18,7 @@ endif()
file(REMOVE ${CMAKE_BINARY_DIR}/include/buildinfo.h)
ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_BINARY_DIR}/include/buildinfo.h
COMMAND ${CMAKE_COMMAND} -P cmake/buildinfo.cmake 2> ${CMAKE_BINARY_DIR}/include/buildinfo.h
COMMAND ${CMAKE_COMMAND} -DBI_FILE=${CMAKE_BINARY_DIR}/include/buildinfo.h -P cmake/buildinfo.cmake
DEPENDS ${buildinfo_deps}
WORKING_DIRECTORY ${CMAKE_SOURCE_DIR}
COMMENT "Generating buildinfo.h")
......@@ -36,6 +36,13 @@ if (CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
else()
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -check arg_temp_created,assume,bounds,contiguous,format,output_conversion,pointers,stack,uninit -traceback -O0 -g -check uninit -check pointers -DCPP_DEBUG")
endif()
elseif (CMAKE_Fortran_COMPILER_ID MATCHES "NVHPC")
message("NVHPC Fortran detected")
set(FLEUR_PRECISION_OPTION "-Mr8;-Mr8intrinsics")
set(FLEUR_OPENMP_FLAG "-mp")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -tp=zen2 -mp -O1 -g ")
set(FLEUR_COMPILE_OPTIONS -mavx2 -Mlre -Mautoinline -Mpre -Mvect=simd -Mcache_align -Mflushz -O2 -g)
set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -C -traceback -O0 -g -Mchkstk -Mchkptr -Ktrap=fp -DCPP_DEBUG")
elseif (CMAKE_Fortran_COMPILER_ID MATCHES "PGI")
message("PGI Fortran detected")
set(FLEUR_PRECISION_OPTION "-Mr8;-Mr8intrinsics")
......
......@@ -27,9 +27,7 @@ CONTAINS
USE m_types_mat
#ifdef CPP_ELPA_ONENODE
USE elpa
#ifdef CPP_GPU
USE nvtx
#endif
#endif
IMPLICIT NONE
......@@ -49,9 +47,7 @@ CONTAINS
call timestart("ELPA 2018 one-node")
#ifdef CPP_GPU
call nvtxStartRange("ELPA", 5)
#endif
err = elpa_init(20180525)
elpa_obj => elpa_allocate()
......@@ -77,17 +73,12 @@ CONTAINS
CALL hmat%add_transpose(hmat)
CALL smat%add_transpose(smat)
#ifdef CPP_GPU