Commit 3fb39116 authored by Miriam Hinzen's avatar Miriam Hinzen

Introduced ImagUnit in constants and replaced with it the parameter declaration of CI

parent 20508365
......@@ -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
......
......@@ -40,7 +40,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
REAL s2h, s2h_e(ne)
INTEGER i,j,k,l,ll1,lm,n,nap,natom,nn,iatom,jatom,lmp,m,nkvec
......@@ -64,7 +64,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)
......@@ -118,7 +117,7 @@ CONTAINS
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$OMP& inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm)&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,iintsp,eig,l_force,&
!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,force,nat_start,nat_stop)
#endif
DO k = 1,nvmax
......
......@@ -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)
......@@ -43,7 +44,6 @@
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(&
......
......@@ -73,7 +73,7 @@ c**************************************************
> nop,mrot,bmat,lmax,
< d_wgn)
USE m_constants, ONLY : pimach
USE m_constants, ONLY : pimach, ImagUnit
USE m_inv3
IMPLICIT NONE
......@@ -91,7 +91,7 @@ c**************************************************
+ fac_x,fac_xmpm
REAL :: pi,co_bh,si_bh,zaehler,nenner,cp,sp
REAL :: sina,sinb,sinc,cosa,cosb,cosc,determ,dt
COMPLEX :: ci,phase_g,phase_a,bas,
COMPLEX :: phase_g,phase_a,bas,
+ d(-lmax:lmax,-lmax:lmax)
REAL :: alpha(nop),beta(nop),gamma(nop)
......@@ -100,7 +100,6 @@ c**************************************************
INTRINSIC sqrt,max,min
ci = cmplx(0.0,1.0)
pi = pimach()
c
c determine the eulerian angles of all the rotations
......@@ -213,13 +212,13 @@ c
DO m = -l,l
fac_l_m = fac(l+m) * fac(l-m)
phase_g = exp( - ci * gamma(ns) * m )
phase_g = exp( - ImagUnit * gamma(ns) * 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(ns) * mp )
phase_a = exp( - ImagUnit * alpha(ns) * mp )
x_lo = max(0, m-mp)
x_up = min(l-mp, l+m)
......
......@@ -11,6 +11,7 @@
& qpw,rhtxy,rho,rht,&
& xdnout)
!
use m_constants
USE m_angle
USE m_starf, ONLY : starf2,starf3
USE m_ylm
......@@ -42,7 +43,6 @@
! .. Local Scalars ..
REAL delta,s,sx,xd1,xd2,xx1,xx2,rrr,phi
INTEGER i,j,jp3,jr,k,lh,mem,nd,nopa,ivac,ll1,lm ,gzi,m
COMPLEX ci
! ..
! .. Local Arrays ..
COMPLEX sf2(stars%ng2),sf3(stars%ng3),ylm((atoms%lmaxd+1)**2)
......@@ -50,8 +50,7 @@
! ..
! .. Intrinsic Functions ..
INTRINSIC abs,real,sqrt
! ..
ci = cmplx(0.,1.)
ivac=iv
if (iflag.ne.1) THEN
......@@ -86,10 +85,10 @@
m = oneD%odi%kv(2,k)
gzi = oneD%odi%kv(1,k)
xx1 = xx1 + real(rhtxy(jp3,k-1,ivac,jsp)*&
& exp(ci*m*phi)*exp(ci*gzi*cell%bmat(3,3)*p(3)))*&
& exp(ImagUnit*m*phi)*exp(ImagUnit*gzi*cell%bmat(3,3)*p(3)))*&
& oneD%odi%nst2(k)
xx2 = xx2 + real(rhtxy(jp3+1,k-1,ivac,jsp)*&
& exp(ci*m*phi)*exp(ci*gzi*cell%bmat(3,3)*p(3)))*&
& exp(ImagUnit*m*phi)*exp(ImagUnit*gzi*cell%bmat(3,3)*p(3)))*&
& oneD%odi%nst2(k)
ENDDO
xdnout = xdnout + xx1 + delta* (xx2-xx1)
......
......@@ -12,6 +12,7 @@ c.....------------------------------------------------------------------
> lmaxd,lmax,v,ylm,
< dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
c