Skip to content

GitLab

fleur
fleur
Commit 073b29a3 authored by Matthias Redies's avatar Matthias Redies
Browse files
Options

make hybrid code more searchable: remove space after alloc

parent b675c636
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 317 additions and 317 deletions
hybrid/HF_init.F90
View file @ 073b29a3
......@@ -22,27 +22,27 @@ CONTAINS
CALL intgrf_init(atoms%ntype, atoms%jmtd, atoms%jri, atoms%dx, atoms%rmsh, hybdat%gridf)
!Alloc variables
ALLOCATE (hybdat%lmaxc(atoms%ntype), source=0)
ALLOCATE (hybdat%bas1(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
ALLOCATE (hybdat%bas2(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
ALLOCATE (hybdat%bas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
ALLOCATE (hybdat%drbas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
allocate(hybdat%lmaxc(atoms%ntype), source=0)
allocate(hybdat%bas1(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
allocate(hybdat%bas2(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
allocate(hybdat%bas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
allocate(hybdat%drbas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype), source=0.0)
! preparations for core states
CALL core_init(dimension, input, atoms, hybdat%lmaxcd, hybdat%maxindxc)
ALLOCATE (hybdat%nindxc(0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0)
allocate(hybdat%nindxc(0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%nindxc')
ALLOCATE (hybdat%core1(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
allocate(hybdat%core1(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation core1')
ALLOCATE (hybdat%core2(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
allocate(hybdat%core2(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation core2')
ALLOCATE (hybdat%eig_c(hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
allocate(hybdat%eig_c(hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%eig_c')
! pre-calculate gaunt coefficients
hybdat%maxfac = max(2*atoms%lmaxd + hybrid%maxlcutm1 + 1, 2*hybdat%lmaxcd + 2*atoms%lmaxd + 1)
ALLOCATE (hybdat%fac(0:hybdat%maxfac), hybdat%sfac(0:hybdat%maxfac), stat=ok, source=0.0)
allocate(hybdat%fac(0:hybdat%maxfac), hybdat%sfac(0:hybdat%maxfac), stat=ok, source=0.0)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation fac,hybdat%sfac')
hybdat%fac(0) = 1
hybdat%sfac(0) = 1
......
hybrid/checkolap.F90
View file @ 073b29a3
......@@ -68,7 +68,7 @@
& 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x'/)
LOGICAL :: l_mism = .true.
ALLOCATE (z(nkpti))
allocate(z(nkpti))
DO ikpt = 1, nkpti
CALL lapw%init(input, noco, kpts, atoms, sym, ikpt, cell, sym%zrfs)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
......@@ -107,7 +107,7 @@
END DO
IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <core|basis>'
ALLOCATE (olapcb(hybrid%maxindx), olapcv(maxval(hybrid%nbands), nkpti),&
allocate(olapcb(hybrid%maxindx), olapcv(maxval(hybrid%nbands), nkpti),&
& olapcv_avg(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype),&
& olapcv_max(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype),&
& olapcv_loc(2, -hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype))
......@@ -186,7 +186,7 @@
END DO
END IF ! mpi%irank == 0
DEALLOCATE (olapcb, olapcv, olapcv_avg, olapcv_max, olapcv_loc)
deallocate(olapcb, olapcv, olapcv_avg, olapcv_max, olapcv_loc)
IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <basis|basis>'
......@@ -221,9 +221,9 @@
IF (mpi%irank == 0) WRITE (6, '(/A)') &
& 'Mismatch of wave functions at the MT-sphere boundaries'
ALLOCATE (carr1(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
ALLOCATE (carr2(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
ALLOCATE (carr3(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
allocate(carr1(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
allocate(carr2(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
allocate(carr3(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
DO ikpt = 1, nkpti
call read_z(z(ikpt), ikpt)
END DO
......
hybrid/coulombmatrix.F90
View file @ 073b29a3
......@@ -163,9 +163,9 @@ CONTAINS
!
call timestart("coulomb allocation")
IF (ALLOCATED(coulomb)) DEALLOCATE (coulomb)
IF (ALLOCATED(coulomb)) deallocate(coulomb)
ALLOCATE (coulomb(hybrid%maxbasm1*(hybrid%maxbasm1 + 1)/2, kpts%nkpt), stat=ok)
allocate(coulomb(hybrid%maxbasm1*(hybrid%maxbasm1 + 1)/2, kpts%nkpt), stat=ok)
IF (ok /= 0) STOP 'coulombmatrix: failure allocation coulomb matrix'
coulomb = 0
call timestop("coulomb allocation")
......@@ -228,8 +228,8 @@ CONTAINS
nsym1(ikpt) = isym1
END DO
! Define reduced lists of G points -> pgptm1(:,ikpt), ikpt=1,..,nkpt
!ALLOCATE ( hybrid%pgptm1(hybrid%maxgptm,kpts%nkpt)) !in mixedbasis
ALLOCATE (iarr(hybrid%maxgptm), POINTER(kpts%nkpt, &
!allocate( hybrid%pgptm1(hybrid%maxgptm,kpts%nkpt)) !in mixedbasis
allocate(iarr(hybrid%maxgptm), POINTER(kpts%nkpt, &
MINVAL(hybrid%gptm(1, :)) - 1:MAXVAL(hybrid%gptm(1, :)) + 1, &
MINVAL(hybrid%gptm(2, :)) - 1:MAXVAL(hybrid%gptm(2, :)) + 1, &
MINVAL(hybrid%gptm(3, :)) - 1:MAXVAL(hybrid%gptm(3, :)) + 1))
......@@ -255,7 +255,7 @@ CONTAINS
END DO
hybrid%ngptm1(ikpt) = j
END DO
DEALLOCATE (iarr)
deallocate(iarr)
IF (mpi%irank == 0) WRITE (6, '(12X,A)', advance='no') 'done'
CALL cpu_TIME(time2)
......@@ -275,7 +275,7 @@ CONTAINS
call timestart("define gmat")
! Define gmat (symmetric)
i = (hybrid%lexp + 1)**2
ALLOCATE (gmat(i, i))
allocate(gmat(i, i))
gmat = 0
lm1 = 0
DO l1 = 0, hybrid%lexp
......@@ -316,7 +316,7 @@ CONTAINS
call timestart("getnorm")
! Look for different qnorm = |k+G|, definition of qnrm and pqnrm.
CALL getnorm(kpts, hybrid%gptm, hybrid%ngptm, hybrid%pgptm, qnrm, nqnrm, pqnrm, cell)
ALLOCATE (sphbesmoment(0:hybrid%lexp, atoms%ntype, nqnrm), &
allocate(sphbesmoment(0:hybrid%lexp, atoms%ntype, nqnrm), &
olap(hybrid%maxindxm1, 0:hybrid%maxlcutm1, atoms%ntype, nqnrm), &
integral(hybrid%maxindxm1, 0:hybrid%maxlcutm1, atoms%ntype, nqnrm))
sphbes_var = 0
......@@ -456,7 +456,7 @@ CONTAINS
! (1b) r,r' in different MT
ALLOCATE (coulmat(hybrid%nbasp, hybrid%nbasp), stat=ok)
allocate(coulmat(hybrid%nbasp, hybrid%nbasp), stat=ok)
IF (ok /= 0) STOP 'coulombmatrix: failure allocation coulmat'
coulmat = 0
......@@ -527,7 +527,7 @@ CONTAINS
call timestop("MT-MT part")
END DO
IF (ANY(calc_mt)) DEALLOCATE (coulmat)
IF (ANY(calc_mt)) deallocate(coulmat)
IF (mpi%irank == 0) THEN
WRITE (6, '(2X,A)', advance='no') 'done'
......@@ -550,7 +550,7 @@ CONTAINS
! (2b) r,r' in same MT
! (2c) r,r' in different MT
ALLOCATE (coulmat(hybrid%nbasp, hybrid%maxgptm), stat=ok)
allocate(coulmat(hybrid%nbasp, hybrid%maxgptm), stat=ok)
IF (ok /= 0) STOP 'coulombmatrix: failure allocation coulmat'
coulmat = 0
......@@ -685,7 +685,7 @@ CONTAINS
END DO
call timestop("loop over interst.")
DEALLOCATE (coulmat, olap, integral)
deallocate(coulmat, olap, integral)
IF (mpi%irank == 0) THEN
WRITE (6, '(2X,A)', advance='no') 'done'
......@@ -706,7 +706,7 @@ CONTAINS
CALL cpu_TIME(time1)
! Calculate the hermitian matrix smat(i,j) = sum(a) integral(MT(a)) exp[i(Gj-Gi)r] dr
call timestart("calc smat")
ALLOCATE (smat(hybrid%gptmd, hybrid%gptmd))
allocate(smat(hybrid%gptmd, hybrid%gptmd))
smat = 0
DO igpt2 = 1, hybrid%gptmd
DO igpt1 = 1, igpt2
......@@ -778,7 +778,7 @@ CONTAINS
DO ikpt = ikptmin, ikptmax!1,kpts%nkpt
! group together quantities which depend only on l,m and igpt -> carr2a
ALLOCATE (carr2a((hybrid%lexp + 1)**2, hybrid%maxgptm), carr2b(atoms%nat, hybrid%maxgptm))
allocate(carr2a((hybrid%lexp + 1)**2, hybrid%maxgptm), carr2b(atoms%nat, hybrid%maxgptm))
carr2a = 0; carr2b = 0
DO igpt = 1, hybrid%ngptm(ikpt)
igptp = hybrid%pgptm(igpt, ikpt)
......@@ -805,7 +805,7 @@ CONTAINS
!finally we can loop over the plane waves (G: igpt1,igpt2)
call timestart("loop over plane waves")
ALLOCATE (carr2(atoms%nat, (hybrid%lexp + 1)**2), &
allocate(carr2(atoms%nat, (hybrid%lexp + 1)**2), &
structconst1(atoms%nat, (2*hybrid%lexp + 1)**2))
carr2 = 0; structconst1 = 0
DO igpt0 = igptmin(ikpt), igptmax(ikpt)!1,hybrid%ngptm1(ikpt)
......@@ -875,7 +875,7 @@ CONTAINS
coulomb(idum, ikpt) = coulomb(idum, ikpt) + csum/cell%vol
END DO
END DO
DEALLOCATE (carr2, carr2a, carr2b, structconst1)
deallocate(carr2, carr2a, carr2b, structconst1)
call timestop("loop over plane waves")
END DO !ikpt
call timestop("loop 4:")
......@@ -974,7 +974,7 @@ CONTAINS
! Calculate sphbesintegral
call timestart("sphbesintegral")
ALLOCATE (sphbes0(-1:hybrid%lexp + 2, atoms%ntype, nqnrm),&
allocate(sphbes0(-1:hybrid%lexp + 2, atoms%ntype, nqnrm),&
& carr2((hybrid%lexp + 1)**2, hybrid%maxgptm))
sphbes0 = 0; carr2 = 0
DO iqnrm = 1, nqnrm
......@@ -1046,7 +1046,7 @@ CONTAINS
END DO
call timestop("loop 2")
DEALLOCATE (carr2)
deallocate(carr2)
IF (mpi%irank == 0) THEN
WRITE (6, '(2X,A)', advance='no') 'done'
......@@ -1063,8 +1063,8 @@ CONTAINS
! All elements are needed so send all data to all processes treating the
! respective k-points
ALLOCATE (carr2(hybrid%maxbasm1, 2), iarr(hybrid%maxgptm))
ALLOCATE (nsym_gpt(hybrid%gptmd, kpts%nkpt), &
allocate(carr2(hybrid%maxbasm1, 2), iarr(hybrid%maxgptm))
allocate(nsym_gpt(hybrid%gptmd, kpts%nkpt), &
sym_gpt(MAXVAL(nsym1), hybrid%gptmd, kpts%nkpt))
nsym_gpt = 0; sym_gpt = 0
call timestart("loop 3")
......@@ -1122,14 +1122,14 @@ CONTAINS
END DO ! ikpt
call timestop("loop 3")
call timestart("gap 1:")
DEALLOCATE (carr2, iarr, hybrid%pgptm1)
deallocate(carr2, iarr, hybrid%pgptm1)
IF (mpi%irank == 0) THEN
WRITE (6, '(2X,A)', advance='no') 'done'
CALL cpu_TIME(time2)
WRITE (6, '(2X,A,F8.2,A)') '( Timing:', time2 - time1, ' )'
END IF
END IF
DEALLOCATE (qnrm, pqnrm)
deallocate(qnrm, pqnrm)
CALL cpu_TIME(time1)
IF (xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN
......@@ -1222,20 +1222,20 @@ CONTAINS
! rearrange coulomb matrix
!
ALLOCATE (coulomb_mt1(hybrid%maxindxm1 - 1, hybrid%maxindxm1 - 1, 0:hybrid%maxlcutm1, atoms%ntype, 1))
allocate(coulomb_mt1(hybrid%maxindxm1 - 1, hybrid%maxindxm1 - 1, 0:hybrid%maxlcutm1, atoms%ntype, 1))
ic = (hybrid%maxlcutm1 + 1)**2*atoms%nat
idum = ic + hybrid%maxgptm
idum = (idum*(idum + 1))/2
if (sym%invs) THEN
ALLOCATE (coulomb_mt2_r(hybrid%maxindxm1 - 1, -hybrid%maxlcutm1:hybrid%maxlcutm1, 0:hybrid%maxlcutm1 + 1, atoms%nat, 1))
ALLOCATE (coulomb_mt3_r(hybrid%maxindxm1 - 1, atoms%nat, atoms%nat, 1))
ALLOCATE (coulomb_mtir_r(ic + hybrid%maxgptm, ic + hybrid%maxgptm, 1))
ALLOCATE (coulombp_mtir_r(idum, 1))
allocate(coulomb_mt2_r(hybrid%maxindxm1 - 1, -hybrid%maxlcutm1:hybrid%maxlcutm1, 0:hybrid%maxlcutm1 + 1, atoms%nat, 1))
allocate(coulomb_mt3_r(hybrid%maxindxm1 - 1, atoms%nat, atoms%nat, 1))
allocate(coulomb_mtir_r(ic + hybrid%maxgptm, ic + hybrid%maxgptm, 1))
allocate(coulombp_mtir_r(idum, 1))
else
ALLOCATE (coulomb_mt2_c(hybrid%maxindxm1 - 1, -hybrid%maxlcutm1:hybrid%maxlcutm1, 0:hybrid%maxlcutm1 + 1, atoms%nat, 1))
ALLOCATE (coulomb_mt3_c(hybrid%maxindxm1 - 1, atoms%nat, atoms%nat, 1))
ALLOCATE (coulomb_mtir_c(ic + hybrid%maxgptm, ic + hybrid%maxgptm, 1))
ALLOCATE (coulombp_mtir_c(idum, 1))
allocate(coulomb_mt2_c(hybrid%maxindxm1 - 1, -hybrid%maxlcutm1:hybrid%maxlcutm1, 0:hybrid%maxlcutm1 + 1, atoms%nat, 1))
allocate(coulomb_mt3_c(hybrid%maxindxm1 - 1, atoms%nat, atoms%nat, 1))
allocate(coulomb_mtir_c(ic + hybrid%maxgptm, ic + hybrid%maxgptm, 1))
allocate(coulombp_mtir_c(idum, 1))
endif
call timestart("loop bla")
DO ikpt = ikptmin, ikptmax
......@@ -1506,9 +1506,9 @@ CONTAINS
call timestop("loop bla")
if (sym%invs) THEN
DEALLOCATE (coulomb_mt1, coulomb_mt2_r, coulomb_mt3_r, coulomb_mtir_r, coulombp_mtir_r)
deallocate(coulomb_mt1, coulomb_mt2_r, coulomb_mt3_r, coulomb_mtir_r, coulombp_mtir_r)
else
DEALLOCATE (coulomb_mt1, coulomb_mt2_c, coulomb_mt3_c, coulomb_mtir_c, coulombp_mtir_c)
deallocate(coulomb_mt1, coulomb_mt2_c, coulomb_mt3_c, coulomb_mtir_c, coulombp_mtir_c)
end if
IF (mpi%irank == 0) THEN
......@@ -1790,7 +1790,7 @@ CONTAINS
CALL getshells(ptsh, nptsh, radsh, nshell, rad, cell%amat, first)
call timestop("determine atomic shell")
ALLOCATE (pnt(nptsh))
allocate(pnt(nptsh))
structconst = 0
!
......@@ -1886,7 +1886,7 @@ CONTAINS
END DO
call timestop("realspace sum")
DEALLOCATE (ptsh, radsh)
deallocate(ptsh, radsh)
CALL cpu_TIME(time2)
IF (first) WRITE (6, '(A,F7.2)') ' Timing: ', time2 - time1
......@@ -2013,7 +2013,7 @@ CONTAINS
aa = SQRT(SUM(ABS(structconst(1, :, :, ikpt))**2)/atoms%nat**2)
IF (first) WRITE (6, '(/A,F8.5,A,F8.5,A)') 'Accuracy of Gamma-decomposition (structureconstant):', a, ' (abs)', a/aa, ' (rel)'
ENDIF
DEALLOCATE (ptsh, radsh)
deallocate(ptsh, radsh)
first = .FALSE.
......@@ -2040,7 +2040,7 @@ CONTAINS
INTEGER, ALLOCATABLE :: ihelp(:, :)
REAL, ALLOCATABLE :: rhelp(:)
ALLOCATE (ptsh(3, 100000), radsh(100000), stat=ok)
allocate(ptsh(3, 100000), radsh(100000), stat=ok)
IF (ok /= 0) STOP 'getshells: failure allocation ptsh/radsh'
ptsh = 0
......@@ -2059,16 +2059,16 @@ CONTAINS
found = .TRUE.
i = i + 1
IF (i > SIZE(radsh)) THEN
ALLOCATE (rhelp(SIZE(radsh)), ihelp(3, SIZE(ptsh, 2)), stat=ok)
allocate(rhelp(SIZE(radsh)), ihelp(3, SIZE(ptsh, 2)), stat=ok)
IF (ok /= 0) STOP 'getshells: failure allocation rhelp/ihelp'
rhelp = radsh
ihelp = ptsh
DEALLOCATE (radsh, ptsh)
ALLOCATE (radsh(SIZE(rhelp) + 100000), ptsh(3, SIZE(ihelp, 2) + 100000), stat=ok)
deallocate(radsh, ptsh)
allocate(radsh(SIZE(rhelp) + 100000), ptsh(3, SIZE(ihelp, 2) + 100000), stat=ok)
IF (ok /= 0) STOP 'getshells: failure re-allocation ptsh/radsh'
radsh(1:SIZE(rhelp)) = rhelp
ptsh(:, 1:SIZE(ihelp, 2)) = ihelp
DEALLOCATE (rhelp, ihelp)
deallocate(rhelp, ihelp)
END IF
ptsh(:, i) = (/ix, iy, iz/)
radsh(i) = SQRT(rdum)
......@@ -2084,17 +2084,17 @@ CONTAINS
END DO
nptsh = i
ALLOCATE (pnt(nptsh))
allocate(pnt(nptsh))
!reallocate radsh ptsh
ALLOCATE (rhelp(nptsh), ihelp(3, nptsh))
allocate(rhelp(nptsh), ihelp(3, nptsh))
rhelp = radsh(1:nptsh)
ihelp = ptsh(:, 1:nptsh)
DEALLOCATE (radsh, ptsh)
ALLOCATE (radsh(nptsh), ptsh(3, nptsh))
deallocate(radsh, ptsh)
allocate(radsh(nptsh), ptsh(3, nptsh))
radsh = rhelp
ptsh = ihelp
DEALLOCATE (rhelp, ihelp)
deallocate(rhelp, ihelp)
CALL rorderpf(pnt, radsh, nptsh, MAX(0, INT(LOG(nptsh*0.001)/LOG(2.0))))
radsh = radsh(pnt)
......@@ -2127,7 +2127,7 @@ CONTAINS
INTEGER :: i, j, ikpt, igpt, igptp
REAL :: q(3), qnorm
ALLOCATE (qnrm(MAXVAL(ngpt)*kpts%nkpt), pqnrm(MAXVAL(ngpt), kpts%nkpt))
allocate(qnrm(MAXVAL(ngpt)*kpts%nkpt), pqnrm(MAXVAL(ngpt), kpts%nkpt))
i = 0
DO ikpt = 1, kpts%nkpt
igptloop: DO igpt = 1, ngpt(ikpt)
......@@ -2148,10 +2148,10 @@ CONTAINS
END DO
nqnrm = i
ALLOCATE (help(nqnrm))
allocate(help(nqnrm))
help(1:nqnrm) = qnrm(1:nqnrm)
DEALLOCATE (qnrm)
ALLOCATE (qnrm(1:nqnrm))
deallocate(qnrm)
allocate(qnrm(1:nqnrm))
qnrm = help
END SUBROUTINE getnorm
......
hybrid/exchange_core.F90
View file @ 073b29a3
......@@ -79,7 +79,7 @@ CONTAINS
! read in mt wavefunction coefficients from file cmt
CALL read_cmt(cmt, nk)
ALLOCATE (fprod(atoms%jmtd, 5), larr(5), parr(5))
allocate(fprod(atoms%jmtd, 5), larr(5), parr(5))
! generate ldum(nbands(nk),nbands(nk)), which is true if the corresponding matrix entry is non-zero
ic1 = 0
......@@ -128,14 +128,14 @@ CONTAINS
n = n + 1
M = SIZE(fprod, 2)
IF (n > M) THEN
ALLOCATE (fprod2(atoms%jmtd, M), larr2(M), parr2(M))
allocate(fprod2(atoms%jmtd, M), larr2(M), parr2(M))
fprod2 = fprod; larr2 = larr; parr2 = parr
DEALLOCATE (fprod, larr, parr)
ALLOCATE (fprod(atoms%jmtd, M + 5), larr(M + 5), parr(M + 5))
deallocate(fprod, larr, parr)
allocate(fprod(atoms%jmtd, M + 5), larr(M + 5), parr(M + 5))
fprod(:, :M) = fprod2
larr(:M) = larr2
parr(:M) = parr2
DEALLOCATE (fprod2, larr2, parr2)
deallocate(fprod2, larr2, parr2)
END IF
fprod(:atoms%jri(itype), n) = (hybdat%core1(:atoms%jri(itype), p1, l1, itype)*hybdat%bas1(:atoms%jri(itype), p2, l2, itype) &
+ hybdat%core2(:atoms%jri(itype), p1, l1, itype)*hybdat%bas2(:atoms%jri(itype), p2, l2, itype))/atoms%rmsh(:atoms%jri(itype), itype)
......@@ -146,7 +146,7 @@ CONTAINS
! Evaluate radial integrals (special part of Coulomb matrix : contribution from single MT)
ALLOCATE (integral(n, n), carr(n, hybrid%nbands(nk)), carr2(n, lapw%nv(jsp)), carr3(n, lapw%nv(jsp)))
allocate(integral(n, n), carr(n, hybrid%nbands(nk)), carr2(n, lapw%nv(jsp)), carr3(n, lapw%nv(jsp)))
DO i = 1, n
CALL primitivef(primf1, fprod(:, i)*atoms%rmsh(:, itype)**(l + 1), atoms%rmsh, atoms%dx, atoms%jri, atoms%jmtd, itype, atoms%ntype)
......@@ -190,7 +190,7 @@ CONTAINS
END DO
END DO
DEALLOCATE (integral, carr, carr2, carr3)
deallocate(integral, carr, carr2, carr3)
END DO
END DO
......@@ -292,7 +292,7 @@ CONTAINS
CALL read_cmt(cmt, nk)
ALLOCATE (fprod(atoms%jmtd, 5), larr(5), parr(5))
allocate(fprod(atoms%jmtd, 5), larr(5), parr(5))
exchange = 0
iatom = 0
......@@ -315,14 +315,14 @@ CONTAINS
n = n + 1
M = SIZE(fprod, 2)
IF (n > M) THEN
ALLOCATE (fprod2(atoms%jmtd, M), larr2(M), parr2(M))
allocate(fprod2(atoms%jmtd, M), larr2(M), parr2(M))
fprod2 = fprod; larr2 = larr; parr2 = parr
DEALLOCATE (fprod, larr, parr)
ALLOCATE (fprod(atoms%jmtd, M + 5), larr(M + 5), parr(M + 5))
deallocate(fprod, larr, parr)
allocate(fprod(atoms%jmtd, M + 5), larr(M + 5), parr(M + 5))
fprod(:, :M) = fprod2
larr(:M) = larr2
parr(:M) = parr2
DEALLOCATE (fprod2, larr2, parr2)
deallocate(fprod2, larr2, parr2)
END IF
fprod(:atoms%jri(itype), n) = (hybdat%core1(:atoms%jri(itype), p1, l1, itype)*hybdat%bas1(:atoms%jri(itype), p2, l2, itype) &
+ hybdat%core2(:atoms%jri(itype), p1, l1, itype)*hybdat%bas2(:atoms%jri(itype), p2, l2, itype))/atoms%rmsh(:atoms%jri(itype), itype)
......@@ -333,7 +333,7 @@ CONTAINS
! Evaluate radial integrals (special part of Coulomb matrix : contribution from single MT)
ALLOCATE (integral(n, n), carr(n, hybrid%nbands(nk)), carr2(n, lapw%nv(jsp)), carr3(n, lapw%nv(jsp)))
allocate(integral(n, n), carr(n, hybrid%nbands(nk)), carr2(n, lapw%nv(jsp)), carr3(n, lapw%nv(jsp)))
DO i = 1, n
CALL primitivef(primf1, fprod(:atoms%jri(itype), i)*atoms%rmsh(:atoms%jri(itype), itype)**(l + 1), atoms%rmsh, atoms%dx, atoms%jri, atoms%jmtd, itype, atoms%ntype)
......@@ -376,7 +376,7 @@ CONTAINS
END DO
END DO
DEALLOCATE (integral, carr, carr2, carr3)
deallocate(integral, carr, carr2, carr3)
END DO
END DO
......
hybrid/exchange_val_hf.F90
View file @ 073b29a3
......@@ -176,23 +176,23 @@ CONTAINS
WRITE (6, '(A,A,i3,A,f7.2,A)') ' Divide the loop over the occupied hybrid%bands in packages', &
' of the size', psize, ' (cprod=', rdum*psize, 'MB)'
END IF
ALLOCATE (phase_vv(psize, hybrid%nbands(nk)), stat=ok)
allocate(phase_vv(psize, hybrid%nbands(nk)), stat=ok)
IF (ok /= 0) STOP 'exchange_val_hf: error allocation phase'
phase_vv = 0
IF (ok /= 0) STOP 'exchange_val_hf: error allocation phase'
if (mat_ex%l_real) THEN
ALLOCATE (cprod_vv_c(hybrid%maxbasm1, 0, 0), carr3_vv_c(hybrid%maxbasm1, 0, 0))
ALLOCATE (cprod_vv_r(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
allocate(cprod_vv_c(hybrid%maxbasm1, 0, 0), carr3_vv_c(hybrid%maxbasm1, 0, 0))
allocate(cprod_vv_r(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
IF (ok /= 0) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE (carr3_vv_r(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
allocate(carr3_vv_r(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
IF (ok /= 0) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_r = 0; carr3_vv_r = 0
ELSE
ALLOCATE (cprod_vv_r(hybrid%maxbasm1, 0, 0), carr3_vv_r(hybrid%maxbasm1, 0, 0))
ALLOCATE (cprod_vv_c(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
allocate(cprod_vv_r(hybrid%maxbasm1, 0, 0), carr3_vv_r(hybrid%maxbasm1, 0, 0))
allocate(cprod_vv_c(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
IF (ok /= 0) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE (carr3_vv_c(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
allocate(carr3_vv_c(hybrid%maxbasm1, psize, hybrid%nbands(nk)), stat=ok)
IF (ok /= 0) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_c = 0; carr3_vv_c = 0
END IF
......
hybrid/gen_wavf.F90
View file @ 073b29a3
......@@ -105,7 +105,7 @@ CONTAINS
! set spherical component of the potential from the previous iteration vr
vr = vr0
! ALLOCATE ( z_out(nbasfcn,neigd,nkpti),stat=ok )
! allocate( z_out(nbasfcn,neigd,nkpti),stat=ok )
! IF ( ok .ne. 0) STOP 'gen_wavf: failure allocation z'
! z_out = 0
! z_out(:,:,:nkpti) = z_in
......@@ -115,7 +115,7 @@ CONTAINS
! bas1 denotes the large component
! bas2 " " small component
ALLOCATE (f(atoms%jmtd, 2, 0:atoms%lmaxd), &
allocate(f(atoms%jmtd, 2, 0:atoms%lmaxd), &
df(atoms%jmtd, 2, 0:atoms%lmaxd), &
source=0.0)
......@@ -154,7 +154,7 @@ CONTAINS
END DO
END IF
END DO
DEALLOCATE (f, df)
deallocate(f, df)
#if CPP_DEBUG
! consistency check
......@@ -170,15 +170,15 @@ CONTAINS
! (acof,bcof,ccof) and APW-basis coefficients
! (a,b,bascofold_lo) at irred. kpoints
ALLOCATE (acof(dimension%neigd, 0:dimension%lmd, atoms%nat), stat=ok)
allocate(acof(dimension%neigd, 0:dimension%lmd, atoms%nat), stat=ok)
IF (ok /= 0) call judft_error('gen_wavf: failure allocation acof')
ALLOCATE (bcof(dimension%neigd, 0:dimension%lmd, atoms%nat), stat=ok)
allocate(bcof(dimension%neigd, 0:dimension%lmd, atoms%nat), stat=ok)
IF (ok /= 0) call judft_error('gen_wavf: failure allocation bcof')
ALLOCATE (ccof(-atoms%llod:atoms%llod, dimension%neigd, atoms%nlod, atoms%nat), stat=ok)
allocate(ccof(-atoms%llod:atoms%llod, dimension%neigd, atoms%nlod, atoms%nat), stat=ok)
IF (ok /= 0) call judft_error('gen_wavf: failure allocation ccof')
ALLOCATE (cmt(dimension%neigd, hybrid%maxlmindx, atoms%nat), stat=ok)
allocate(cmt(dimension%neigd, hybrid%maxlmindx, atoms%nat), stat=ok)
IF (ok /= 0) call judft_error('gen_wavf: Failure allocation cmt')
ALLOCATE (cmthlp(dimension%neigd, hybrid%maxlmindx, atoms%nat), stat=ok)
allocate(cmthlp(dimension%neigd, hybrid%maxlmindx, atoms%nat), stat=ok)
IF (ok /= 0) call judft_error('gen_wavf: failure allocation cmthlp')
DO ikpt0 = 1, nkpti
......@@ -270,8 +270,8 @@ CONTAINS
END DO !ikpt
END DO !ikpt0
DEALLOCATE (acof, bcof, ccof)
DEALLOCATE (cmt, cmthlp)
deallocate(acof, bcof, ccof)
deallocate(cmt, cmthlp)
END SUBROUTINE gen_wavf
END MODULE m_gen_wavf
hybrid/hf_setup.F90
View file @ 073b29a3
......@@ -59,11 +59,11 @@ CONTAINS
! Preparations for HF and hybrid functional calculation
CALL timestart("gen_bz and gen_wavf")
ALLOCATE (zmat(kpts%nkptf), stat=ok)
allocate(zmat(kpts%nkptf), stat=ok)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation z_c')
ALLOCATE (eig_irr(DIMENSION%neigd2, kpts%nkpt), stat=ok)
allocate(eig_irr(DIMENSION%neigd2, kpts%nkpt), stat=ok)