Commit e811fca7 authored by Matthias Redies's avatar Matthias Redies

remove double & whenever it works nicely

parent cb99b450
This diff is collapsed.
......@@ -319,7 +319,7 @@ CONTAINS
ENDIF
! DO icst = 1,ncstd
! IF ( irank == 0 )
! & WRITE(6,'( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,1X,F12.5)')bkpt,icst,REAL(exch(icst,icst))*(-27.211608)
! WRITE(6,'( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,1X,F12.5)')bkpt,icst,REAL(exch(icst,icst))*(-27.211608)
! END DO
! add core exchange contributions to the te_hfex
......
......@@ -2,7 +2,7 @@
MODULE m_hyb_abcrot
CONTAINS
SUBROUTINE hyb_abcrot(hybrid, atoms, neig, sym,&
& acof, bcof, ccof)
acof, bcof, ccof)
! ***************************************************************
! * This routine transforms a/b/cof which are given wrt rotated *
! * MT functions (according to invsat/ngopr) into a/b/cof wrt *
......
......@@ -6,7 +6,7 @@ MODULE m_hybrid_core
CONTAINS
SUBROUTINE corewf(atoms, jsp, input, dimension,&
& vr, lmaxcd, maxindxc, mpi, lmaxc, nindxc, core1, core2, eig_c)
vr, lmaxcd, maxindxc, mpi, lmaxc, nindxc, core1, core2, eig_c)
USE m_types
USE m_juDFT
IMPLICIT NONE
......@@ -47,8 +47,8 @@ CONTAINS
! generate relativistic core wave functions( ->core1r,core2r )
CALL calcorewf(dimension, input, jsp, atoms,&
& ncstd, vr,&
& lmaxc, nindxcr, core1r, core2r, eig_cr, mpi)
ncstd, vr,&
lmaxc, nindxcr, core1r, core2r, eig_cr, mpi)
nindxc = 0
......@@ -58,11 +58,11 @@ CONTAINS
nindxc(0, :) = nindxcr(0, :)
DO itype = 1, atoms%ntype
core1(:, :nindxc(0, itype), 0, itype)&
& = core1r(:, 0, :nindxc(0, itype), itype)
= core1r(:, 0, :nindxc(0, itype), itype)
core2(:, :nindxc(0, itype), 0, itype)&
& = core2r(:, 0, :nindxc(0, itype), itype)
= core2r(:, 0, :nindxc(0, itype), itype)
eig_c(:nindxc(0, itype), 0, itype)&
& = eig_cr(0, :nindxc(0, itype), itype)
= eig_cr(0, :nindxc(0, itype), itype)
END DO
DO itype = 1, atoms%ntype
......@@ -73,43 +73,43 @@ CONTAINS
DO i = 1, nindxcr(l, itype), 2
nindxc(l, itype) = nindxc(l, itype) + 1
core1(:atoms%jri(itype), nindxc(l, itype), l, itype) =&
& (weight1*core1r(:atoms%jri(itype), l, i, itype) +&
& weight2*core1r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
(weight1*core1r(:atoms%jri(itype), l, i, itype) +&
weight2*core1r(:atoms%jri(itype), l, i + 1, itype))&
/(weight1 + weight2)
core2(:atoms%jri(itype), nindxc(l, itype), l, itype) =&
& (weight1*core2r(:atoms%jri(itype), l, i, itype) + &
& weight2*core2r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
(weight1*core2r(:atoms%jri(itype), l, i, itype) + &
weight2*core2r(:atoms%jri(itype), l, i + 1, itype))&
/(weight1 + weight2)
eig_c(nindxc(l, itype), l, itype) =&
& (weight1*eig_cr(l, i, itype) +&
& weight2*eig_cr(l, i + 1, itype))&
& /(weight1 + weight2)
(weight1*eig_cr(l, i, itype) +&
weight2*eig_cr(l, i + 1, itype))&
/(weight1 + weight2)
END DO
ELSE
DO i = 1, nindxcr(l, itype) - 1, 2
nindxc(l, itype) = nindxc(l, itype) + 1
core1(:atoms%jri(itype), nindxc(l, itype), l, itype) =&
& (weight1*core1r(:atoms%jri(itype), l, i, itype) +&
& weight2*core1r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
(weight1*core1r(:atoms%jri(itype), l, i, itype) +&
weight2*core1r(:atoms%jri(itype), l, i + 1, itype))&
/(weight1 + weight2)
core2(:atoms%jri(itype), nindxc(l, itype), l, itype) =&
& (weight1*core2r(:atoms%jri(itype), l, i, itype) + &
& weight2*core2r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
(weight1*core2r(:atoms%jri(itype), l, i, itype) + &
weight2*core2r(:atoms%jri(itype), l, i + 1, itype))&
/(weight1 + weight2)
eig_c(nindxc(l, itype), l, itype) =&
& (weight1*eig_cr(l, i, itype) +&
& weight2*eig_cr(l, i + 1, itype))&
& /(weight1 + weight2)
(weight1*eig_cr(l, i, itype) +&
weight2*eig_cr(l, i + 1, itype))&
/(weight1 + weight2)
END DO
nindxc(l, itype) = nindxc(l, itype) + 1
core1(:atoms%jri(itype), nindxc(l, itype), l, itype)&
& = core1r(:atoms%jri(itype), l, nindxcr(l, itype), itype)
= core1r(:atoms%jri(itype), l, nindxcr(l, itype), itype)
core2(:atoms%jri(itype), nindxc(l, itype), l, itype)&
& = core2r(:atoms%jri(itype), l, nindxcr(l, itype), itype)
= core2r(:atoms%jri(itype), l, nindxcr(l, itype), itype)
eig_c(nindxc(l, itype), l, itype)&
& = eig_cr(l, nindxcr(l, itype), itype)
= eig_cr(l, nindxcr(l, itype), itype)
END IF
END DO
......@@ -118,13 +118,13 @@ CONTAINS
deallocate(nindxcr, core1r, core2r, eig_cr)
IF (maxindxc /= maxval(nindxc))&
& call judft_error('corewf: counting error nindxc')
call judft_error('corewf: counting error nindxc')
END SUBROUTINE corewf
SUBROUTINE calcorewf(dimension, input, jspin, atoms,&
& ncstd, vr,&
& lmaxc, nindxcr, core1, core2, eig_c, mpi)
ncstd, vr,&
lmaxc, nindxcr, core1, core2, eig_c, mpi)
USE m_intgr, ONLY: intgr3, intgr0, intgr1
USE m_constants, ONLY: c_light
......@@ -188,7 +188,7 @@ CONTAINS
dxx = atoms%dx(itype)
bmu = 0.0
CALL setcor(itype, input%jspins, atoms, input, bmu,&
& nst, kappa, nprnc, occ_h)
nst, kappa, nprnc, occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins*occ_h(1:nst, jspin)
......@@ -284,9 +284,9 @@ CONTAINS
nindxcr(NINT(fl), itype) = nindxcr(NINT(fl), itype) + 1
core1(:atoms%jri(itype), NINT(fl), nindxcr(NINT(fl), itype), itype)&
& = a(:atoms%jri(itype))
= a(:atoms%jri(itype))
core2(:atoms%jri(itype), NINT(fl), nindxcr(NINT(fl), itype), itype)&
& = b(:atoms%jri(itype))
= b(:atoms%jri(itype))
eig_c(NINT(fl), nindxcr(NINT(fl), itype), itype) = e
......@@ -300,8 +300,8 @@ CONTAINS
END DO
8000 FORMAT(/, /, 10x, 'z=', f4.0, 5x, 'r(1)=', e14.6, 5x, 'dx=', f8.6, 5x,&
& 'm.t.index=', i4, /, 15x, 'n', 4x, 'l', 5x, 'j', 4x, 'energy', 7x,&
& 'weight')
'm.t.index=', i4, /, 15x, 'n', 4x, 'l', 5x, 'j', 4x, 'energy', 7x,&
'weight')
8010 FORMAT(12x, 2f5.0, f6.1, f10.4, f10.0)
END SUBROUTINE calcorewf
......
......@@ -112,7 +112,7 @@ CONTAINS
DO ineq = 1, atoms%neq(itype)
icent = icent + 1
olap_r(k) = olap_r(k) - real(fgr* &
& exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent))))
exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent))))
END DO
END DO
END IF
......@@ -140,7 +140,7 @@ CONTAINS
DO ineq = 1, atoms%neq(itype)
icent = icent + 1
olap_c(k) = olap_c(k) - fgr* &
& exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent)))
exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent)))
END DO
END DO
END IF
......@@ -154,8 +154,8 @@ CONTAINS
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SUBROUTINE wfolap_init(olappw, olapmt, gpt,&
& atoms, mpbasis, cell,&
& bas1, bas2)
atoms, mpbasis, cell,&
bas1, bas2)
USE m_intgrf, ONLY: intgrf, intgrf_init
USE m_types
......@@ -167,7 +167,7 @@ CONTAINS
! - arrays -
INTEGER, INTENT(IN) :: gpt(:, :)!(3,ngpt)
REAL, INTENT(IN) :: bas1(atoms%jmtd, maxval(mpbasis%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype),&
& bas2(atoms%jmtd, maxval(mpbasis%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype)
bas2(atoms%jmtd, maxval(mpbasis%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype)
REAL, INTENT(OUT) :: olapmt(maxval(mpbasis%num_radfun_per_l), maxval(mpbasis%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype)
TYPE(t_mat), INTENT(INOUT):: olappw
......@@ -185,9 +185,9 @@ CONTAINS
DO n1 = 1, nn!n2
!IF( n1 .gt. 2 .or. n2 .gt. 2) CYCLE
olapmt(n1, n2, l, itype) = intgrf( &
& bas1(:, n1, l, itype)*bas1(:, n2, l, itype)&
& + bas2(:, n1, l, itype)*bas2(:, n2, l, itype),&
& atoms, itype, gridf)
bas1(:, n1, l, itype)*bas1(:, n2, l, itype)&
+ bas2(:, n1, l, itype)*bas2(:, n2, l, itype),&
atoms, itype, gridf)
! olapmt(n2,n1,l,itype) = olapmt(n1,n2,l,itype)
END DO
END DO
......@@ -227,9 +227,9 @@ CONTAINS
DO M = -l, l
nn = mpbasis%num_radfun_per_l(l, itype)
wfolap_inv = wfolap_inv + &
& dot_product(cmt1(lm + 1:lm + nn, iatom),&
& matmul(olapmt(:nn, :nn, l, itype),&
& cmt2(lm + 1:lm + nn, iatom)))
dot_product(cmt1(lm + 1:lm + nn, iatom),&
matmul(olapmt(:nn, :nn, l, itype),&
cmt2(lm + 1:lm + nn, iatom)))
lm = lm + nn
END DO
END DO
......@@ -279,9 +279,9 @@ CONTAINS
DO M = -l, l
nn = mpbasis%num_radfun_per_l(l, itype)
wfolap_noinv = wfolap_noinv + &
& dot_product(cmt1(lm + 1:lm + nn, iatom),&
& matmul(olapmt(:nn, :nn, l, itype),&
& cmt2(lm + 1:lm + nn, iatom)))
dot_product(cmt1(lm + 1:lm + nn, iatom),&
matmul(olapmt(:nn, :nn, l, itype),&
cmt2(lm + 1:lm + nn, iatom)))
lm = lm + nn
END DO
END DO
......
......@@ -350,7 +350,7 @@ CONTAINS
DO ilo = 1, atoms%nlo(itype)
#ifdef CPP_OLDINTEL
CALL judft_error("no LOs & hybrid with old intel compiler!", calledby="subvxc.F90")
CALL judft_error("no LOs hybrid with old intel compiler!", calledby="subvxc.F90")
#else
l1 = atoms%llo(ilo, itype)
DO ikvec = 1, invsfct*(2*l1 + 1)
......
......@@ -364,7 +364,7 @@ CONTAINS
! however, also in the latter case the trace of the spatial rotations
! for two symmetry equivalent states must be equivalent
IF (all(abs(trace(:sym%nop, ic1) - trace(:sym%nop, ic2)) <= 1E-8))&
& THEN
THEN
symequivalent(ic2, ic1) = .true.
END IF
END IF
......@@ -390,9 +390,9 @@ CONTAINS
DO n2 = 1, nn
DO n1 = 1, nn
olapmt(n1, n2, l, itype) = intgrf( &
& hybdat%bas1(:, n1, l, itype)*hybdat%bas1(:, n2, l, itype)&
& + hybdat%bas2(:, n1, l, itype)*hybdat%bas2(:, n2, l, itype),&
& atoms, itype, hybdat%gridf)
hybdat%bas1(:, n1, l, itype)*hybdat%bas1(:, n2, l, itype)&
+ hybdat%bas2(:, n1, l, itype)*hybdat%bas2(:, n2, l, itype),&
atoms, itype, hybdat%gridf)
END DO
END DO
END DO
......@@ -412,11 +412,11 @@ CONTAINS
nn = mpbasis%num_radfun_per_l(l, itype)
DO iband1 = 1, hybrid%nbands(nk)
carr(:nn) = matmul(olapmt(:nn, :nn, l, itype),&
& cmt(iband1, lm + 1:lm + nn, iatom))
cmt(iband1, lm + 1:lm + nn, iatom))
DO iband2 = 1, iband1
wavefolap(iband2, iband1)&
& = wavefolap(iband2, iband1)&
& + dot_product(cmt(iband2, lm + 1:lm + nn, iatom), carr(:nn))
= wavefolap(iband2, iband1)&
+ dot_product(cmt(iband2, lm + 1:lm + nn, iatom), carr(:nn))
END DO
END DO
lm = lm + nn
......@@ -445,8 +445,8 @@ CONTAINS
IF (ndb2 == 0) CYCLE
ic2 = ic2 + 1
IF (any(abs(wavefolap(iband1:iband1 + ndb1 - 1,&
& iband2:iband2 + ndb2 - 1)) > 1E-9)) THEN
! & .and. ndb1 .eq. ndb2 ) THEN
iband2:iband2 + ndb2 - 1)) > 1E-9)) THEN
! .and. ndb1 .eq. ndb2 ) THEN
symequivalent(ic2, ic1) = .true.
END IF
END DO
......@@ -501,7 +501,7 @@ CONTAINS
pi = pimach()
IF (hybdat%lmaxcd > atoms%lmaxd) STOP &
& 'symm_hf: The very impropable case that hybdat%lmaxcd > atoms%lmaxd occurs'
'symm_hf: The very impropable case that hybdat%lmaxcd > atoms%lmaxd occurs'
iatom = 0
iatom0 = 0
......@@ -521,7 +521,7 @@ CONTAINS
g = nint(rotkpt - kpts%bkf(:, nk))
cdum = exp(-2*pi*img*dot_product(rotkpt, sym%tau(:, iisym)))* &
& exp(2*pi*img*dot_product(g, atoms%taual(:, ratom)))
exp(2*pi*img*dot_product(g, atoms%taual(:, ratom)))
END DO
END DO
iatom0 = iatom0 + atoms%neq(itype)
......@@ -548,7 +548,7 @@ CONTAINS
! - local arrays -
INTEGER :: rrot(3, 3, sym%nsym)
INTEGER :: neqvkpt(kpts%nkptf), list(kpts%nkptf), parent(kpts%nkptf),&
& symop(kpts%nkptf)
symop(kpts%nkptf)
INTEGER, ALLOCATABLE :: psym(:)!,help(:)
REAL :: rotkpt(3)
......
......@@ -99,8 +99,8 @@ CONTAINS
DO i = 1, ndb
if (l_real) THEN
cmt_out(lm1:lm2:nn, iatom1, i) = cdum* &
& matmul(cmt(bandi + i - 1, lm1:lm2:nn, iatom),&
& sym%d_wgn(-l:l, -l:l, l, iop))
matmul(cmt(bandi + i - 1, lm1:lm2:nn, iatom),&
sym%d_wgn(-l:l, -l:l, l, iop))
else
IF (trs) THEN
cmthlp(:2*l + 1) = CONJG(cmt(bandi + i - 1, lm1:lm2:nn, iatom))
......@@ -244,7 +244,7 @@ CONTAINS
DO i = 1, nbands
if (l_real) THEN
cmt_out(i, lm1:lm2:nn, iatom1) = cdum*matmul(cmt(i, lm1:lm2:nn, iatom),&
& hybrid%d_wgn2(-l:l, -l:l, l, iop))
hybrid%d_wgn2(-l:l, -l:l, l, iop))
else
IF (trs) THEN
cmthlp(:2*l + 1) = conjg(cmt(i, lm1:lm2:nn, iatom))
......@@ -438,7 +438,7 @@ CONTAINS
CALL commonphase(cfac, mat, dim1*dim2)
mat = mat/cfac
IF (any(abs(aimag(mat)) > 1e-8)) &
&STOP 'symmetrize: Residual imaginary part. Symmetrization failed.'
STOP 'symmetrize: Residual imaginary part. Symmetrization failed.'
END IF
END SUBROUTINE symmetrize
......@@ -578,16 +578,16 @@ CONTAINS
INTEGER :: g(3), g1(3)
REAL :: rkpt(3), rkpthlp(3), trans(3)
COMPLEX :: dwgn(-maxval(hybrid%lcutm1):maxval(hybrid%lcutm1),&
& -maxval(hybrid%lcutm1):maxval(hybrid%lcutm1), 0:maxval(hybrid%lcutm1))
-maxval(hybrid%lcutm1):maxval(hybrid%lcutm1), 0:maxval(hybrid%lcutm1))
! COMPLEX :: vecin1(dim,nobd,nbands),vecout1(dim,nobd,nbands)
COMPLEX, ALLOCATABLE :: vecin1(:, :, :), vecout1(:, :, :)
call timestart("bra trafo")
allocate(vecin1(dim, nobd, nbands), &
& vecout1(dim, nobd, nbands), stat=ok)
vecout1(dim, nobd, nbands), stat=ok)
IF (ok /= 0) &
& call judft_error('bra_trafo2: error allocating vecin1 or vecout1')
call judft_error('bra_trafo2: error allocating vecin1 or vecout1')
vecin1 = 0; vecout1 = 0
IF (maxval(hybrid%lcutm1) > atoms%lmaxd) call judft_error('bra_trafo2: maxlcutm > atoms%lmaxd') ! very improbable case
......@@ -812,17 +812,17 @@ CONTAINS
! - arrays -
INTEGER, INTENT(IN) :: rrot(:,:), invrrot(:,:)
INTEGER, INTENT(IN) :: lcutm(atoms%ntype),&
& nindxm(0:maxlcutm, atoms%ntype)
nindxm(0:maxlcutm, atoms%ntype)
INTEGER, INTENT(IN) :: nbasm(:)
INTEGER, INTENT(IN) :: pointer(&
& minval(mpbasis%g(1, :)) - 1:maxval(mpbasis%g(1, :)) + 1,&
& minval(mpbasis%g(2, :)) - 1:maxval(mpbasis%g(2, :)) + 1,&
& minval(mpbasis%g(3, :)) - 1:maxval(mpbasis%g(3, :)) + 1)
minval(mpbasis%g(1, :)) - 1:maxval(mpbasis%g(1, :)) + 1,&
minval(mpbasis%g(2, :)) - 1:maxval(mpbasis%g(2, :)) + 1,&
minval(mpbasis%g(3, :)) - 1:maxval(mpbasis%g(3, :)) + 1)
COMPLEX, INTENT(IN) :: vecin(:)
COMPLEX, INTENT(IN) :: dwgn(-maxlcutm:maxlcutm,&
& -maxlcutm:maxlcutm,&
& 0:maxlcutm)
-maxlcutm:maxlcutm,&
0:maxlcutm)
COMPLEX, INTENT(OUT) :: vecout(nbasm(ikpt0))
! - private scalars -
......@@ -834,7 +834,7 @@ CONTAINS
COMPLEX :: cexp, cdum
! - private arrays -
INTEGER :: pnt(maxindxm, 0:maxlcutm, atoms%nat), g(3),&
& g1(3), iarr(mpbasis%n_g(ikpt0))
g1(3), iarr(mpbasis%n_g(ikpt0))
REAL :: rkpt(3), rkpthlp(3), trans(3)
COMPLEX :: vecin1(nbasm(ikpt0))
COMPLEX :: carr(mpbasis%n_g(ikpt0))
......
......@@ -10,10 +10,10 @@ MODULE m_wavefproducts
PUBLIC wavefproducts_inv, wavefproducts_inv5
CONTAINS
SUBROUTINE wavefproducts_noinv(bandi, bandf, nk, iq, dimension, input, jsp,& !cprod,&
& cell, atoms, hybrid, hybdat,&
& kpts, mnobd,&
& lapw, sym, noco, nbasm_mt, nkqpt, cprod)
SUBROUTINE wavefproducts_noinv(bandi, bandf, nk, iq, dimension, input, jsp, !cprod,&
cell, atoms, hybrid, hybdat,&
kpts, mnobd,&
lapw, sym, noco, nbasm_mt, nkqpt, cprod)
USE m_constants
USE m_util, ONLY: modulo1
......@@ -272,12 +272,12 @@ CONTAINS
END SUBROUTINE wavefproducts_noinv
SUBROUTINE wavefproducts_inv(&
& bandi, bandf, dimension, input, jsp, atoms,&
& lapw, kpts,&
& nk, iq, hybdat, mnobd, hybrid,&
& parent, cell,&
& nbasm_mt, sym, noco,&
& nkqpt, cprod)
bandi, bandf, dimension, input, jsp, atoms,&
lapw, kpts,&
nk, iq, hybdat, mnobd, hybrid,&
parent, cell,&
nbasm_mt, sym, noco,&
nkqpt, cprod)
USE m_util, ONLY: modulo1
USE m_wrapper
......@@ -1198,14 +1198,14 @@ CONTAINS
END SUBROUTINE wavefproducts_inv
SUBROUTINE wavefproducts_inv5(&
& bandi, bandf, bandoi, bandof,&
& dimension, input, jsp, atoms,&
& lapw, kpts,&
& nk, iq, hybdat, mnobd, hybrid,&
& parent, cell,&
& nbasm_mt, sym,&
& noco,&
& nkqpt, cprod)
bandi, bandf, bandoi, bandof,&
dimension, input, jsp, atoms,&
lapw, kpts,&
nk, iq, hybdat, mnobd, hybrid,&
parent, cell,&
nbasm_mt, sym,&
noco,&
nkqpt, cprod)
USE m_util, ONLY: modulo1
USE m_olap, ONLY: gptnorm
......@@ -1322,14 +1322,14 @@ CONTAINS
call timestop("read_z")
g(1) = maxval(abs(lapw%k1(:lapw%nv(jsp), jsp))) &
& + maxval(abs(lapw_nkqpt%k1(:lapw_nkqpt%nv(jsp), jsp)))&
& + maxval(abs(mpbasis%g(1, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
+ maxval(abs(lapw_nkqpt%k1(:lapw_nkqpt%nv(jsp), jsp)))&
+ maxval(abs(mpbasis%g(1, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
g(2) = maxval(abs(lapw%k2(:lapw%nv(jsp), jsp)))&
& + maxval(abs(lapw_nkqpt%k2(:lapw_nkqpt%nv(jsp), jsp)))&
& + maxval(abs(mpbasis%g(2, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
+ maxval(abs(lapw_nkqpt%k2(:lapw_nkqpt%nv(jsp), jsp)))&
+ maxval(abs(mpbasis%g(2, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
g(3) = maxval(abs(lapw%k3(:lapw%nv(jsp), jsp)))&
& + maxval(abs(lapw_nkqpt%k3(:lapw_nkqpt%nv(jsp), jsp)))&
& + maxval(abs(mpbasis%g(3, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
+ maxval(abs(lapw_nkqpt%k3(:lapw_nkqpt%nv(jsp), jsp)))&
+ maxval(abs(mpbasis%g(3, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
ALLOCATE (pointer(-g(1):g(1), -g(2):g(2), -g(3):g(3)), stat=ok)
IF (ok /= 0) STOP 'wavefproducts_inv5: error allocation pointer'
......@@ -1593,10 +1593,10 @@ CONTAINS
DO ibando = bandoi, bandof
rarr3(1, ibando, iband) = rarr3(1, ibando, iband)&
& + rdum1*cmt(ibando, lmp2, iatom1) + rdum2*cmt(ibando, lmp2, iatom2)
+ rdum1*cmt(ibando, lmp2, iatom1) + rdum2*cmt(ibando, lmp2, iatom2)
rarr3(2, ibando, iband) = rarr3(2, ibando, iband)&
& + rdum1*cmt(ibando, lmp2, iatom2) - rdum2*cmt(ibando, lmp2, iatom1)
+ rdum1*cmt(ibando, lmp2, iatom2) - rdum2*cmt(ibando, lmp2, iatom1)
END DO !ibando
END DO !iband
......@@ -1614,10 +1614,10 @@ CONTAINS
! loop over occupied bands
DO ibando = bandoi, bandof
rarr3(1, ibando, iband) = rarr3(1, ibando, iband)&
& + rdum1*cmt(ibando, lmp1, iatom1) + rdum2*cmt(ibando, lmp1, iatom2)
+ rdum1*cmt(ibando, lmp1, iatom1) + rdum2*cmt(ibando, lmp1, iatom2)
rarr3(2, ibando, iband) = rarr3(2, ibando, iband)&
& + rdum1*cmt(ibando, lmp1, iatom2) - rdum2*cmt(ibando, lmp1, iatom1)
+ rdum1*cmt(ibando, lmp1, iatom2) - rdum2*cmt(ibando, lmp1, iatom1)
END DO !ibando
END DO !iband
END IF ! rdum .ne. 0
......@@ -2216,16 +2216,16 @@ CONTAINS
END SUBROUTINE wavefproducts_inv5
SUBROUTINE wavefproducts_noinv5(&
& bandi, bandf, bandoi, bandof,&
& nk, iq, dimension, input, jsp,&
& cell, atoms, hybrid,&
& hybdat,&
& kpts,&
& mnobd,&
& lapw, sym,&
& nbasm_mt,&
& noco,&
& nkqpt, cprod)
bandi, bandf, bandoi, bandof,&
nk, iq, dimension, input, jsp,&
cell, atoms, hybrid,&
hybdat,&
kpts,&
mnobd,&
lapw, sym,&
nbasm_mt,&
noco,&
nkqpt, cprod)
USE m_constants
USE m_util, ONLY: modulo1
......@@ -2333,14 +2333,14 @@ CONTAINS
call timestop("read_z")
g(1) = maxval(abs(lapw%k1(:lapw%nv(jsp), jsp))) &
& + maxval(abs(lapw_nkqpt%k1(:lapw_nkqpt%nv(jsp), jsp)))&
& + maxval(abs(mpbasis%g(1, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
+ maxval(abs(lapw_nkqpt%k1(:lapw_nkqpt%nv(jsp), jsp)))&
+ maxval(abs(mpbasis%g(1, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
g(2) = maxval(abs(lapw%k2(:lapw%nv(jsp), jsp)))&
& + maxval(abs(lapw_nkqpt%k2(:lapw_nkqpt%nv(jsp), jsp)))&
& + maxval(abs(mpbasis%g(2, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
+ maxval(abs(lapw_nkqpt%k2(:lapw_nkqpt%nv(jsp), jsp)))&
+ maxval(abs(mpbasis%g(2, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
g(3) = maxval(abs(lapw%k3(:lapw%nv(jsp), jsp)))&
& + maxval(abs(lapw_nkqpt%k3(:lapw_nkqpt%nv(jsp), jsp)))&
& + maxval(abs(mpbasis%g(3, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
+ maxval(abs(lapw_nkqpt%k3(:lapw_nkqpt%nv(jsp), jsp)))&
+ maxval(abs(mpbasis%g(3, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq)))) + 1
ALLOCATE (pointer(-g(1):g(1), -g(2):g(2), -g(3):g(3)), stat=ok)
IF (ok /= 0) STOP 'wavefproducts_noinv2: error allocation pointer'
......
......@@ -164,8 +164,8 @@ CONTAINS
call timestop("read_z")
g = maxval(abs(lapw%gvec(:, :lapw%nv(jsp), jsp)), dim=2) &
& + maxval(abs(lapw_nkqpt%gvec(:, :lapw_nkqpt%nv(jsp), jsp)), dim=2)&
& + maxval(abs(mpbasis%g(:, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq))), dim=2) + 1
+ maxval(abs(lapw_nkqpt%gvec(:, :lapw_nkqpt%nv(jsp), jsp)), dim=2)&
+ maxval(abs(mpbasis%g(:, mpbasis%gptm_ptr(:mpbasis%n_g(iq), iq))), dim=2) + 1
call hybdat%set_stepfunction(cell, atoms, g, sqrt(cell%omtil))
!
......@@ -432,10 +432,10 @@ CONTAINS
DO ibando = bandoi, bandof
rarr3(1, ibando, iband) = rarr3(1, ibando, iband)&
& + rdum1*cmt(ibando, lmp2, iatom1) + rdum2*cmt(ibando, lmp2, iatom2)
+ rdum1*cmt(ibando, lmp2, iatom1) + rdum2*cmt(ibando, lmp2, iatom2)
rarr3(2, ibando, iband) = rarr3(2, ibando, iband)&