Commit 0d2e970c authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents b2384ca6 3c83172f
......@@ -116,7 +116,7 @@
REAL, INTENT (INOUT) :: rh(DIMENSION%msh,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX czero,carg,VALUE,slope,ci,c_ph
COMPLEX czero,carg,VALUE,slope,c_ph
REAL dif,dxx,g,gz,dtildh,&
& rkappa,sign,signz,tol_14,z,zero,zvac,&
& g2,phi,gamma,qq
......@@ -161,7 +161,6 @@
! Tests have shown that (1) is more accurate.
!
!
ci = CMPLX(0.0,1.0)
ALLOCATE (qpwc(stars%ng3))
!
......@@ -276,7 +275,7 @@
DO k = 2,stars%ng3
IF ((stars%kv3(1,k).EQ.0).AND.(stars%kv3(2,k).EQ.0)) THEN
g = stars%kv3(3,k) * cell%bmat(3,3) * (3. - 2.*ivac)
carg = carg -qpwc(k)*(EXP(ci*g*dtildh)-EXP(ci*g*cell%z1))/g
carg = carg -qpwc(k)*(EXP(ImagUnit*g*dtildh)-EXP(ImagUnit*g*cell%z1))/g
ENDIF
ENDDO
rho_out(ivac) = qpwc(1) * ( dtildh-cell%z1 ) - AIMAG(carg)
......@@ -308,7 +307,7 @@
gz = kz*cell%bmat(3,3)
DO 240 nrz = 1,nz
signz = 3. - 2.*nrz
carg = ci*sign*signz*gz
carg = ImagUnit*sign*signz*gz
VALUE = VALUE + c_ph*qpwc(ig3)* EXP(carg*cell%z1)
slope = slope + c_ph*carg*qpwc(ig3)* EXP(carg*cell%z1)
240 ENDDO
......@@ -391,9 +390,9 @@
phi = stars%phi2(irec2)
CALL cylbes(oneD%odi%M,g2*cell%z1,fJ)
CALL dcylbs(oneD%odi%M,g2*cell%z1,fJ,dfJ)
VALUE = VALUE + (ci**m)*qpwc(irec3)*&
VALUE = VALUE + (ImagUnit**m)*qpwc(irec3)*&
& EXP(CMPLX(0.,-m*phi))*fJ(m)
slope = slope + (ci**m)*g2*qpwc(irec3)*&
slope = slope + (ImagUnit**m)*g2*qpwc(irec3)*&
& EXP(CMPLX(0.,-m*phi))*dfJ(m)
END IF
END DO
......
......@@ -12,6 +12,7 @@ CONTAINS
USE m_types_cdnval, ONLY: t_eigVecCoeffs
USE m_types_denCoeffsOffdiag
USE m_rotdenmat
use m_constants
IMPLICIT NONE
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
......@@ -29,7 +30,6 @@ CONTAINS
INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
REAL fac
COMPLEX sumaa,sumbb,sumab,sumba
COMPLEX, PARAMETER :: ci = (0.0,1.0)
! .. Local Arrays ..
COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
......@@ -145,10 +145,10 @@ CONTAINS
! rotate into global frame
!
TYPE_loop : DO n = 1,atoms%ntype
chi(1,1) = EXP(-ci*noco%alph(n)/2)*COS(noco%beta(n)/2)
chi(1,2) = -EXP(-ci*noco%alph(n)/2)*SIN(noco%beta(n)/2)
chi(2,1) = EXP( ci*noco%alph(n)/2)*SIN(noco%beta(n)/2)
chi(2,2) = EXP( ci*noco%alph(n)/2)*COS(noco%beta(n)/2)
chi(1,1) = EXP(-ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
chi(1,2) = -EXP(-ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
chi(2,1) = EXP( ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
chi(2,2) = EXP( ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
state : DO i = 1, noccbd
lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),&
......
......@@ -17,6 +17,7 @@ c matrix. --> U*rho*U^dagger
c Philipp Kurz 2000-02-03
c***********************************************************************
use m_constants
IMPLICIT NONE
C .. Scalar Arguments ..
......@@ -28,20 +29,18 @@ C ..
C .. Local Scalars ..
INTEGER ispin
REAL eps
COMPLEX ci
C ..
C .. Local Arrays ..
COMPLEX u2(2,2),rho(2,2),rhoh(2,2)
C ..
eps = 1.0e-10
ci = cmplx(0.0,1.0)
c---> set up the unitary 2x2 spin rotation matrix U^(2)
u2(1,1) = exp(-ci*alph/2)*cos(beta/2)
u2(1,2) = -exp(-ci*alph/2)*sin(beta/2)
u2(2,1) = exp( ci*alph/2)*sin(beta/2)
u2(2,2) = exp( ci*alph/2)*cos(beta/2)
u2(1,1) = exp(-ImagUnit*alph/2)*cos(beta/2)
u2(1,2) = -exp(-ImagUnit*alph/2)*sin(beta/2)
u2(2,1) = exp( ImagUnit*alph/2)*sin(beta/2)
u2(2,2) = exp( ImagUnit*alph/2)*cos(beta/2)
rho(1,1) = cmplx(rho11,0.0)
rho(2,2) = cmplx(rho22,0.0)
......
......@@ -8,7 +8,7 @@ CONTAINS
! ************************************************************
#include "cpp_double.h"
USE m_constants, ONLY : tpi_const
USE m_constants, ONLY : tpi_const, ImagUnit
USE m_setabc1lo
USE m_sphbes
USE m_dsphbs
......@@ -39,7 +39,7 @@ CONTAINS
REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci
COMPLEX cexp,phase,c_0,c_1,c_2
REAL const,df,r1,s,tmk,wronk,qss(3)
REAL s2h, s2h_e(ne)
INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,m,nkvec
......@@ -63,7 +63,6 @@ CONTAINS
IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
ENDIF
ci = CMPLX(0.0,1.0)
const = 2 * tpi_const/SQRT(cell%omtil)
acof(:,:,:) = CMPLX(0.0,0.0)
......@@ -116,7 +115,7 @@ CONTAINS
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$OMP& alo1,blo1,clo1,inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,iintsp,eig,l_force,&
!$OMP& jspin,qss,apw,const,nbasf0,enough,acof,bcof,ccof,force)
DO n = 1,atoms%ntype
CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1)
......@@ -146,10 +145,10 @@ CONTAINS
IF (noco%l_noco) THEN
!---> generate the complex conjgates of the spinors (chi)
ccchi(1,1) = CONJG( EXP(-ci*noco%alph(n)/2)*COS(noco%beta(n)/2))
ccchi(1,2) = CONJG(-EXP(-ci*noco%alph(n)/2)*SIN(noco%beta(n)/2))
ccchi(2,1) = CONJG( EXP( ci*noco%alph(n)/2)*SIN(noco%beta(n)/2))
ccchi(2,2) = CONJG( EXP( ci*noco%alph(n)/2)*COS(noco%beta(n)/2))
ccchi(1,1) = CONJG( EXP(-ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2))
ccchi(1,2) = CONJG(-EXP(-ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2))
ccchi(2,1) = CONJG( EXP( ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2))
ccchi(2,2) = CONJG( EXP( ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2))
IF (noco%l_ss) THEN
!---> the coefficients of the spin-down basis functions are
!---> stored in the second half of the eigenvector
......@@ -320,7 +319,7 @@ CONTAINS
iatom = iatom + 1
IF (atoms%invsat(iatom).EQ.1) THEN
jatom = sym%invsatnr(iatom)
cexp = EXP(tpi_const*ci*DOT_PRODUCT(atoms%taual(:,jatom)&
cexp = EXP(tpi_const*ImagUnit*DOT_PRODUCT(atoms%taual(:,jatom)&
& + atoms%taual(:,iatom),lapw%bkpt))
DO ilo = 1,atoms%nlo(n)
l = atoms%llo(ilo,n)
......
......@@ -33,7 +33,7 @@ CONTAINS
COMPLEX, INTENT (OUT):: b(:,0:,:)!(dimension%nvd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT):: bascof_lo(3,-atoms%llod:atoms%llod,4*atoms%llod+2,atoms%nlod,atoms%nat)
! .. Local Scalars ..
COMPLEX phase,c_0,c_1,c_2,ci
COMPLEX phase,c_0,c_1,c_2
REAL const,df,r1,s,tmk,wronk
INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,mp
INTEGER inv_f,ilo,nvmax,lo,n_ldau,inap,iintsp
......
......@@ -7,6 +7,7 @@ CONTAINS
! *************************************************************
USE m_gaunt,ONLY:gaunt1
USE m_types
use m_constants
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
......@@ -20,15 +21,11 @@ CONTAINS
! ..
! .. Local Scalars ..
COMPLEX cconst,cil,cmv,ci
COMPLEX cconst,cil,cmv
REAL coef
INTEGER :: jmem,l,lcond,lh,llp,llpmax,lm,lmp,lp,lphi,lplow,lplow0,lv
INTEGER :: mp,mv,na,natom,nb,nn,ns,nt,m
! ..
! ..
ci = cmplx(0.0,1.0)
!
!Initialize private variables in gaunt module before parallel region
!$ coef = gaunt1(0,0,0,0,0,0,atoms%lmaxd)
......@@ -56,7 +53,7 @@ CONTAINS
lplow = lplow + mod(lcond,2)
IF (lplow.GT.lphi) CYCLE m_loop
DO lp = lplow,lphi,2
cil = ci** (l-lp)
cil = ImagUnit** (l-lp)
lmp = lp* (lp+1) + mp
IF (lmp.GT.lm) CYCLE m_loop
llp = (l* (l+1))/2 + lp
......
......@@ -18,6 +18,7 @@ CONTAINS
SUBROUTINE rhonmtlo(atoms,sphhar,ne,we,eigVecCoeffs,denCoeffs,ispin)
USE m_gaunt,ONLY:gaunt1
USE m_types
use m_constants
IMPLICIT NONE
......@@ -31,13 +32,11 @@ CONTAINS
REAL, INTENT (IN) :: we(:)!(nobd)
! .. Local Scalars ..
COMPLEX ci,cmv,fact,cf1
COMPLEX cmv,fact,cf1
INTEGER i,jmem,l,lh,lmp,lo,lop,lp,lpmax,lpmax0,lpmin,lpmin0,m,lpp ,mp,mpp,na,neqat0,nn,ntyp
! ..
! ..
ci = CMPLX(0.0,1.0)
!---> for optimal performance consider only
!---> those combinations of l,l',l'',m,m',m'' that satisfy the three
!---> conditions for non-zero gaunt-coeff. i.e.
......@@ -77,7 +76,7 @@ CONTAINS
!---> loop over l'
DO lp = lpmin,lpmax,2
lmp = lp* (lp+1) + mp
fact = cmv* (ci** (l-lp))*gaunt1(l,lp,lpp,m,mp,mpp,atoms%lmaxd)
fact = cmv* (ImagUnit** (l-lp))*gaunt1(l,lp,lpp,m,mp,mpp,atoms%lmaxd)
na = neqat0
DO nn = 1,atoms%neq(ntyp)
na = na + 1
......@@ -99,7 +98,7 @@ CONTAINS
!---> loop over l'
DO lp = lpmin,lpmax,2
lmp = lp* (lp+1) + mp
fact = cmv* (ci** (lp-l))*gaunt1(lp,l,lpp,mp,m,mpp,atoms%lmaxd)
fact = cmv* (ImagUnit** (lp-l))*gaunt1(lp,l,lpp,mp,m,mpp,atoms%lmaxd)
na = neqat0
DO nn = 1,atoms%neq(ntyp)
na = na + 1
......@@ -120,7 +119,7 @@ CONTAINS
!---> add terms containing gaunt1(l,lp,lpp,m,mp,mpp)
mp = m - mpp
IF ((ABS(l-lpp).LE.lp) .AND.(lp.LE. (l+lpp)) .AND.(MOD(l+lp+lpp,2).EQ.0) .AND.(ABS(mp).LE.lp)) THEN
fact = cmv* (ci** (l-lp))*gaunt1(l,lp,lpp,m,mp,mpp,atoms%lmaxd)
fact = cmv* (ImagUnit** (l-lp))*gaunt1(l,lp,lpp,m,mp,mpp,atoms%lmaxd)
na = neqat0
DO nn = 1,atoms%neq(ntyp)
na = na + 1
......
......@@ -12,6 +12,7 @@ CONTAINS
!common subroutine
SUBROUTINE hsmt_spinor(isp,n,noco,chi_mat)
USE m_types
use m_constants
IMPLICIT NONE
TYPE(t_noco),INTENT(IN) :: noco
......@@ -19,15 +20,14 @@ CONTAINS
COMPLEX,INTENT(OUT) :: chi_mat(2,2)
INTEGER :: isp1,isp2
COMPLEX,PARAMETER :: ci=CMPLX(0.0,1.0)
COMPLEX :: chi(2,2)
!---> set up the spinors of this atom within global
!---> spin-coordinateframe
chi(1,1) = exp(-ci*noco%alph(n)/2)*cos(noco%beta(n)/2)
chi(1,2) = -exp(-ci*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,1) = exp(ci*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,2) = exp(ci*noco%alph(n)/2)*cos(noco%beta(n)/2)
chi(1,1) = exp(-ImagUnit*noco%alph(n)/2)*cos(noco%beta(n)/2)
chi(1,2) = -exp(-ImagUnit*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,1) = exp(ImagUnit*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,2) = exp(ImagUnit*noco%alph(n)/2)*cos(noco%beta(n)/2)
!---> and determine the prefactors for the Hamitonian- and
!---> overlapp-matrix elements
chi_mat(1,1) = chi(1,isp)*CONJG(chi(1,isp))
......@@ -41,6 +41,7 @@ CONTAINS
SUBROUTINE hsmt_spinor_soc(n,ki,noco,lapw,chi_so,angso)
USE m_types
use m_constants
IMPLICIT NONE
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_lapw),INTENT(IN) :: lapw
......@@ -53,7 +54,6 @@ CONTAINS
COMPLEX :: isigma(2,2,3)
COMPLEX :: chi(2,2)
COMPLEX :: isigma_x(2,2),isigma_y(2,2),isigma_z(2,2)
COMPLEX,PARAMETER :: ci=CMPLX(0.0,1.0)
! isigma= -i * sigma, where sigma is Pauli matrix
isigma=CMPLX(0.0,0.0)
......@@ -66,10 +66,10 @@ CONTAINS
!---> set up the spinors of this atom within global
!---> spin-coordinateframe
chi(1,1) = exp(-ci*noco%alph(n)/2)*cos(noco%beta(n)/2)
chi(1,2) = -exp(-ci*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,1) = exp(ci*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,2) = EXP(ci*noco%alph(n)/2)*COS(noco%beta(n)/2)
chi(1,1) = exp(-ImagUnit*noco%alph(n)/2)*cos(noco%beta(n)/2)
chi(1,2) = -exp(-ImagUnit*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,1) = exp(ImagUnit*noco%alph(n)/2)*sin(noco%beta(n)/2)
chi(2,2) = EXP(ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
isigma_x=MATMUL(CONJG(TRANSPOSE(chi)), MATMUL(isigma(:,:,1),chi))
isigma_y=MATMUL(CONJG(TRANSPOSE(chi)), MATMUL(isigma(:,:,2),chi))
......
......@@ -11,6 +11,7 @@ MODULE m_tlmplm_cholesky
SUBROUTINE tlmplm_cholesky(sphhar,atoms,noco,enpara,&
jspin,jsp,mpi,v,input,td,ud)
use m_constants
USE m_intgr, ONLY : intgr3
USE m_genMTBasis
USE m_tlo
......@@ -35,7 +36,6 @@ MODULE m_tlmplm_cholesky
! ..
! .. Local Scalars ..
COMPLEX cil
COMPLEX,PARAMETER::ci=cmplx(0.,1.)
REAL temp
INTEGER i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl,lmplm,lmx,lmxx,lp,info,in
INTEGER lp1,lpl ,mem,mems,mp,mu,n,nh,na,m,nsym,s,i_u
......@@ -177,7 +177,7 @@ MODULE m_tlmplm_cholesky
IF (lm.GT.lmp) CYCLE
lpl = lp1 + l
lmplm = lmpl + lm
cil = ((ci** (l-lp))*sphhar%clnu(mem,lh,nsym))*&
cil = ((ImagUnit** (l-lp))*sphhar%clnu(mem,lh,nsym))*&
gaunt1(lp,lamda,l,mp,mu,m,atoms%lmaxd)
td%tuu(lmplm,n,jsp) = td%tuu(lmplm,n,jsp) + cil*uvu(lpl,lh)
td%tdd(lmplm,n,jsp) = td%tdd(lmplm,n,jsp) + cil*dvd(lpl,lh)
......
......@@ -26,6 +26,7 @@ MODULE m_tlo
USE m_intgr, ONLY : intgr3
USE m_gaunt, ONLY: gaunt1
USE m_types
use m_constants
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
......@@ -45,7 +46,7 @@ MODULE m_tlo
REAL, INTENT (IN) :: ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX ci,cil
COMPLEX cil
INTEGER i,l,lh,lm ,lmin,lmp,lo,lop,loplo,lp,lpmax,lpmax0,lpmin,lpmin0,lpp ,mem,mp,mpp,m,lmx,mlo,mlolo
! ..
! .. Local Arrays ..
......@@ -53,7 +54,6 @@ MODULE m_tlo
REAL uvulo(atoms%nlod,0:atoms%lmaxd,lh0:sphhar%nlhd),dvulo(atoms%nlod,0:atoms%lmaxd,lh0:sphhar%nlhd)
! ..
ci = CMPLX(0.0,1.0)
DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp)
DO lp = 0,atoms%lmax(ntyp)
......@@ -133,7 +133,7 @@ MODULE m_tlo
!---> loop over l'
DO lp = lpmin,lpmax,2
lmp = lp* (lp+1) + mp
cil = ((ci** (l-lp))*sphhar%clnu(mem,lh,atoms%ntypsy(na)))* gaunt1(lp,lpp,l,mp,mpp,m,atoms%lmaxd)
cil = ((ImagUnit** (l-lp))*sphhar%clnu(mem,lh,atoms%ntypsy(na)))* gaunt1(lp,lpp,l,mp,mpp,m,atoms%lmaxd)
tlmplm%tuulo(lmp,m,lo+mlo,jsp) = &
tlmplm%tuulo(lmp,m,lo+mlo,jsp) + cil*uvulo(lo,lp,lh)
tlmplm%tdulo(lmp,m,lo+mlo,jsp) = &
......@@ -161,7 +161,7 @@ MODULE m_tlo
loplo = ((lop-1)*lop)/2 + lo
IF ((ABS(l-lpp).LE.lp) .AND. (lp.LE. (l+lpp)) .AND.&
(MOD(l+lp+lpp,2).EQ.0) .AND. (ABS(m).LE.l)) THEN
cil = ((ci** (l-lp))*sphhar%clnu(mem,lh,atoms%ntypsy(na)))* gaunt1(lp,lpp,l,mp,mpp,m,atoms%lmaxd)
cil = ((ImagUnit** (l-lp))*sphhar%clnu(mem,lh,atoms%ntypsy(na)))* gaunt1(lp,lpp,l,mp,mpp,m,atoms%lmaxd)
tlmplm%tuloulo(mp,m,loplo+mlolo,jsp) = tlmplm%tuloulo(mp,m,loplo+mlolo,jsp) + cil*ulovulo(loplo,lh)
END IF
END DO
......
......@@ -37,7 +37,7 @@ CONTAINS
COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,nat_l)
! ..
! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci,ctmp,term1
COMPLEX cexp,phase,c_0,c_1,c_2,ctmp,term1
REAL const,df,r1,s,tmk,wronk
INTEGER i,j,k,l,ll1,lm,n,natom,nn,iatom,jatom,lmp,m,nkvec,nbasf
INTEGER inv_f,ie,ilo,iintsp,nintsp,nvmax,lo,natom_l,na2
......@@ -59,7 +59,6 @@ CONTAINS
IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
ENDIF
ci = CMPLX(0.0,1.0)
const = 2 * tpi_const/SQRT(cell%omtil)
acof(:,:,:) = CMPLX(0.0,0.0)
......@@ -113,7 +112,7 @@ CONTAINS
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(k,i,work_r,work_c,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,na2,nbasf,&
!$OMP& j,fkp,fgp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm,term1,ctmp,acof_l,bcof_l,ccof_l)&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,iintsp,&
!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,nat_start,nat_stop)
!$ ALLOCATE(acof_l(size(acof,1),0:size(acof,2)-1),bcof_l(size(bcof,1),0:size(bcof,2)-1))
!$ ALLOCATE(ccof_l(-atoms%llod:atoms%llod,size(ccof,2),size(ccof,3)))
......
......@@ -40,7 +40,6 @@ CONTAINS
COMPLEX a12,cil1,cil2
REAL,PARAMETER:: zero=0.0
COMPLEX,PARAMETER:: czero=CMPLX(0.0,0.0)
COMPLEX,PARAMETER:: ci=CMPLX(0.0,1.0)
INTEGER i,ie,irinv,is,isinv,it,j,l,l1,l2,lm1,lm2 ,m1,m2,n,natom,natrun,ilo,m
! ..
! .. Local Arrays ..
......@@ -101,11 +100,11 @@ CONTAINS
ENDDO
!
DO l1 = 0,atoms%lmax(n)
cil1 = ci**l1
cil1 = ImagUnit**l1
DO m1 = -l1,l1
lm1 = l1* (l1+1) + m1
DO l2 = 0,atoms%lmax(n)
cil2 = ci**l2
cil2 = ImagUnit**l2
DO m2 = -l2,l2
lm2 = l2* (l2+1) + m2
!
......@@ -133,7 +132,7 @@ CONTAINS
gv(1) = gv(1) + (aaa(1)+bbb(1)-ccc(1)-ddd(1)+&
aaa(2)+bbb(2)-ccc(2)-ddd(2))*0.5* atoms%rmt(n)**2*a12
!
gv(2) = gv(2) + ci* (aaa(1)+bbb(1)+ccc(1)+&
gv(2) = gv(2) + ImagUnit* (aaa(1)+bbb(1)+ccc(1)+&
ddd(1)-aaa(2)-bbb(2)-ccc(2)-ddd(2))*0.5* atoms%rmt(n)**2*a12
!
gv(3) = gv(3) + (eee(1)+eee(2)-fff(1)-fff(2))* 0.5*atoms%rmt(n)**2*a12
......
......@@ -7,7 +7,7 @@ CONTAINS
SUBROUTINE force_a8(input,atoms,sphhar,jsp,vr,rho,force,results)
!
USE m_intgr, ONLY : intgr3
USE m_constants,ONLY: pi_const,sfp_const
USE m_constants, ONLY: pi_const, sfp_const, ImagUnit
USE m_gaunt, ONLY :gaunt1
USE m_differentiate,ONLY: difcub
USE m_types
......@@ -41,7 +41,6 @@ CONTAINS
! ..
! .. Data statements ..
COMPLEX,PARAMETER:: czero=CMPLX(0.000,0.000)
COMPLEX,PARAMETER:: ci = CMPLX(0.0,1.0)
! Kronecker delta for arguments >=0 AND <0
krondel(i,j) = MIN(ABS(i)+1,ABS(j)+1)/MAX(ABS(i)+1,ABS(j)+1)* (1+SIGN(1,i)*SIGN(1,j))/2
......@@ -96,7 +95,7 @@ CONTAINS
& sphhar%clnu(mem1,lh1,nd)*sphhar%clnu(mem2,lh2,nd)*&
& (gaunt1(1,l1,l2,-1,m1,m2,atoms%lmaxd)-&
& gaunt1(1,l1,l2,1,m1,m2,atoms%lmaxd))
gv(2) = gv(2) - ci*SQRT(2.e0*pi_const/3.e0)*&
gv(2) = gv(2) - ImagUnit*SQRT(2.e0*pi_const/3.e0)*&
& sphhar%clnu(mem1,lh1,nd)*sphhar%clnu(mem2,lh2,nd)*&
& (gaunt1(1,l1,l2,-1,m1,m2,atoms%lmaxd)+&
& gaunt1(1,l1,l2,1,m1,m2,atoms%lmaxd))
......@@ -217,7 +216,7 @@ CONTAINS
& krondel(-m1,m2)
!
gv(1) = gv(1) + aaa + bbb - ccc - ddd
gv(2) = gv(2) - ci* (aaa+bbb+ccc+ddd)
gv(2) = gv(2) - ImagUnit* (aaa+bbb+ccc+ddd)
gv(3) = gv(3) + eee - fff
!
! end of summation m1,m2
......
......@@ -16,6 +16,7 @@ MODULE m_constants
REAL, PARAMETER :: tpi_const=2.*3.1415926535897932
REAL, PARAMETER :: fpi_const=4.*3.1415926535897932
REAL, PARAMETER :: sfp_const=sqrt(4.*3.1415926535897932)
complex, parameter :: ImagUnit=(0.0,1.0)
REAL, PARAMETER :: hartree_to_ev_const=27.21138602 ! value from 2014 CODATA recommended values. Uncertainty is 0.00000017
REAL, PARAMETER :: eVac0Default_const = -0.25
CHARACTER(len=9), PARAMETER :: version_const = 'fleur 27'
......
......@@ -18,6 +18,7 @@
> alpha,beta,gamma,l_in,n_u,jspins,lty,
X n_mmp)
use m_constants
USE m_inv3
IMPLICIT NONE
......@@ -33,7 +34,7 @@
REAL fac_l_m,fac_l_mp,fac_lmpx,fac_lmx,fac_x,fac_xmpm
REAL co_bh,si_bh,zaehler,nenner,cp,sp
REAL sina,sinb,sinc,cosa,cosb,cosc,determ,dt
COMPLEX ci,phase_g,phase_a,bas,d(-l_in:l_in,-l_in:l_in)
COMPLEX phase_g,phase_a,bas,d(-l_in:l_in,-l_in:l_in)
COMPLEX d_wig(-l_in:l_in,-l_in:l_in,l_in,n_u)
COMPLEX n_tmp(-l_in:l_in,-l_in:l_in)
COMPLEX nr_tmp(-l_in:l_in,-l_in:l_in)
......@@ -41,9 +42,8 @@
REAL dmat(3,3),dmati(3,3)
INTRINSIC sqrt,max,min
ci = cmplx(0.0,1.0)
DO n = 1, n_u
......@@ -55,13 +55,13 @@
DO m = -l,l
fac_l_m = fac(l+m) * fac(l-m)
phase_g = exp( - ci * gamma(n) * m )
phase_g = exp( - ImagUnit * gamma(n) * m )
DO mp = -l,l
fac_l_mp = fac(l+mp) * fac(l-mp)
zaehler = sqrt( real(fac_l_m * fac_l_mp) )
phase_a = exp( - ci * alpha(n) * mp )
phase_a = exp( - ImagUnit * alpha(n) * mp )
x_lo = max(0, m-mp)
x_up = min(l-mp, l+m)
......
......@@ -36,7 +36,7 @@ c-odim
c+odim
C ..
C .. Local Scalars ..
COMPLEX sf,ci
COMPLEX sf
REAL x
INTEGER j,l,m,n,na,lm
C ..
......@@ -51,11 +51,10 @@ C .. Intrinsic Functions ..
INTRINSIC cmplx,conjg,cos,sin
C ..
ci = cmplx(0.0,1.0)
ciall(0) = fpi_const/ods%nop
DO 10 l = 1,lmaxd
ciall(l) = ciall(0)*ci**l
ciall(l) = ciall(0)*ImagUnit**l
10 CONTINUE
na = 1
DO 70 n = 1,ntype
......
......@@ -23,7 +23,7 @@
COMPLEX, INTENT (OUT):: pylm(:,:)
! ..
! .. Local Scalars ..
COMPLEX sf,ci,csf
COMPLEX sf,csf
REAL x
INTEGER j,l,m,n,na,lm,ll1
! ..
......@@ -35,10 +35,9 @@
COMPLEX, ALLOCATABLE :: ylm(:,:)
! ..
ci = cmplx(0.0,1.0)
ciall(0) = fpi_const/sym%nop
DO l = 1,atoms%lmaxd
ciall(l) = ciall(0)*ci**l
ciall(l) = ciall(0)*ImagUnit**l
ENDDO
CALL spgrot(&
......
......@@ -116,8 +116,8 @@ CONTAINS
banddos,obsolete,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann,l_opti)
CALL timestop("Initialization")
IF((input%preconditioning_param /= 0).AND.input%film) THEN
CALL juDFT_error('Currently no preconditioner for films', calledby = 'fleur')
IF ( ( input%preconditioning_param /= 0 ) .AND. oneD%odi%d1 ) THEN
CALL juDFT_error('Currently no preconditioner for 1D calculations', calledby = 'fleur')
END IF
IF (l_opti) CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
......
......@@ -36,6 +36,7 @@ contains
use m_xmlOutput
use m_umix
use m_vgen_coulomb
use m_VYukawaFilm
#ifdef CPP_MPI
use m_mpi_bc_potden
#endif
......@@ -238,14 +239,14 @@ contains
#ifdef CPP_MPI
call mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, resDen )
#endif
! if ( .not. input%film ) then
if ( .not. input%film ) then
call vgen_coulomb( 1, mpi, dimension, oneD, input, field, vacuum, sym, stars, cell, &
sphhar, atoms, resDen, vYukawa )
! else
! vYukawa%iter = resDen%iter
! call VYukawaFilm( stars, vacuum, cell, sym, input, mpi, atoms, sphhar, dimension, oneD, resDen, ispin, &
! vYukawa )
! end if
else
vYukawa%iter = resDen%iter
call VYukawaFilm( stars, vacuum, cell, sym, input, mpi, atoms, sphhar, dimension, oneD, resDen, &
vYukawa )
end if
end if
MPI0_c: if( mpi%irank == 0 ) then
if( input%preconditioning_param /= 0 ) then
......
......@@ -9,7 +9,6 @@ math/dcylbs.f
math/dsphbs.f
math/gaussp.f
math/grule.f
math/intgr.F
math/inv3.f
math/inwint.f
math/matmul.f
......@@ -21,7 +20,6 @@ math/rfft.F
math/sphbes.f
math/sphpts.f
math/util.F
math/ylm4.f90
math/difcub.f
)
set(fleur_F90 ${fleur_F90}
......@@ -31,6 +29,9 @@ math/fft3d.f90
math/fft_interface.F90
math/SphBessel.f90
math/DoubleFactorial.f90
math/ExpSave.f90
math/intgr.F90
math/ylm4.f90
)
if (FLEUR_USE_FFTMKL)
set(fleur_F90 ${fleur_F90} math/mkl_dfti.f90)
......
module m_ExpSave
contains
pure real function exp_save( x )
! replace exp by a function that does not under/overflow dw09
implicit none
real, intent(in) :: x
real, parameter :: maxexp = log( 2.0 ) * maxexponent( 2.0 )
real, parameter :: minexp = log( 2.0 ) * minexponent( 2.0 )
if ( abs( x ) > minexp .and. abs( x ) < maxexp ) then
exp_save =</