Commit 0a3cc677 authored by Matthias Redies's avatar Matthias Redies

remove read_core function it's never used

parent 423aef85
set(fleur_F90 ${fleur_F90}
hybrid/hyb_abcrot.F90 hybrid/exchange_core.F90 hybrid/mixedbasis.F90 hybrid/symmetrizeh.F90
hybrid/checkolap.F90 hybrid/exchange_val_hf.F90 hybrid/read_core.F90 hybrid/wavefproducts.F90
hybrid/checkolap.F90 hybrid/exchange_val_hf.F90 hybrid/hybrid_core.f90 hybrid/wavefproducts.F90
hybrid/coulombmatrix.F90 hybrid/gen_wavf.F90 hybrid/spmvec.F90 hybrid/hybrid.F90
hybrid/HF_init.F90 hybrid/hsfock.F90 hybrid/subvxc.F90 hybrid/add_Vnonlocal.F90
hybrid/hf_setup.F90 hybrid/kp_perturbation.F90 hybrid/symm_hf.F90 hybrid/trafo.F90
......
......@@ -6,7 +6,7 @@ MODULE m_hf_init
CONTAINS
SUBROUTINE hf_init(hybrid, atoms, input, DIMENSION, hybdat)
USE m_types
USE m_read_core
USE m_hybrid_core
USE m_util
USE m_io_hybrid
IMPLICIT NONE
......
......@@ -14,7 +14,7 @@ CONTAINS
USE m_eig66_io
USE m_util
USE m_checkolap
USE m_read_core
USE m_hybrid_core
USE m_gen_wavf
IMPLICIT NONE
......
MODULE m_read_core
MODULE m_hybrid_core
! read core radial wavefunctions from corebas
! corebas is written in cored.F
! (core basis functions can be read in once during an iteration)
CONTAINS
SUBROUTINE read_core(atoms, hybdat)
USE m_types
IMPLICIT NONE
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
TYPE(t_atoms), INTENT(IN) :: atoms
! - local scalars -
INTEGER :: ncst
INTEGER :: ok, itype, i, idum, l
REAL :: rdum
REAL :: weight1, weight2
! - local arrays -
INTEGER, ALLOCATABLE :: nindxcr(:, :)
INTEGER, ALLOCATABLE :: l_qn(:, :), n_qn(:, :)
REAL, ALLOCATABLE :: j_qn(:, :)
REAL, ALLOCATABLE :: core1r(:, :, :, :),&
& core2r(:, :, :, :)
OPEN (UNIT=77, FILE='corebas', FORM='unformatted')
READ (77) ncst
ALLOCATE (n_qn(0:ncst, atoms%ntype), l_qn(0:ncst, atoms%ntype), &
& j_qn(0:ncst, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'mhsfock: failure allocation n_qn,l_qn,j_qn'
ALLOCATE (nindxcr(0:ncst, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'mhsfock: failure allocation nindxcr'
nindxcr = 0
hybdat%lmaxc = 0
l_qn = 0
ncst = 0
DO itype = 1, atoms%ntype
READ (77) ncst
IF (ncst == 0) CYCLE
DO i = 1, ncst
READ (77) n_qn(i, itype), l_qn(i, itype), j_qn(i, itype)
nindxcr(l_qn(i, itype), itype) = nindxcr(l_qn(i, itype), itype) + 1
END DO
hybdat%lmaxc(itype) = maxval(l_qn(:, itype))
END DO
ALLOCATE (core1r(atoms%jmtd, 0:maxval(hybdat%lmaxc), maxval(nindxcr), atoms%ntype))
ALLOCATE (core2r(atoms%jmtd, 0:maxval(hybdat%lmaxc), maxval(nindxcr), atoms%ntype))
core1r = 0
core2r = 0
REWIND (77)
DEALLOCATE (nindxcr)
ALLOCATE (nindxcr(0:maxval(l_qn), atoms%ntype))
nindxcr = 0
READ (77) idum
DO itype = 1, atoms%ntype
READ (77) ncst
DO i = 1, ncst
nindxcr(l_qn(i, itype), itype) = nindxcr(l_qn(i, itype), itype) + 1
READ (77) idum, idum, rdum, core1r(:atoms%jri(itype), l_qn(i, itype),&
& nindxcr(l_qn(i, itype), itype), itype),&
& core2r(:atoms%jri(itype), l_qn(i, itype),&
& nindxcr(l_qn(i, itype), itype), itype)
END DO
END DO
ALLOCATE (hybdat%nindxc(0:maxval(hybdat%lmaxc), atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'mhsfock: failure allocation nindxc'
ALLOCATE (hybdat%core1(atoms%jmtd, 0:maxval(hybdat%lmaxc), maxval(nindxcr(0, :),&
& nint((maxval(nindxcr)/2.0))), atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'mhsfock: failure allocation core1'
ALLOCATE (hybdat%core2(atoms%jmtd, 0:maxval(hybdat%lmaxc), maxval(nindxcr(0, :),&
& nint((maxval(nindxcr)/2.0))), atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'mhsfock: failure allocation core2'
hybdat%nindxc = 0; hybdat%core1 = 0; hybdat%core2 = 0
! average over core states that only differ in j
! core functions with l-qn equal 0 doesnot change during averaging
hybdat%nindxc(0, :) = nindxcr(0, :)
DO itype = 1, atoms%ntype
hybdat%core1(:, 0, :hybdat%nindxc(0, itype), itype)&
& = core1r(:, 0, :hybdat%nindxc(0, itype), itype)
hybdat%core2(:, 0, :hybdat%nindxc(0, itype), itype)&
& = core2r(:, 0, :hybdat%nindxc(0, itype), itype)
END DO
DO itype = 1, atoms%ntype
DO l = 1, hybdat%lmaxc(itype)
weight1 = 2*(l - 0.5) + 1
weight2 = 2*(l + 0.5) + 1
IF (modulo(nindxcr(l, itype), 2) == 0) THEN
DO i = 1, nindxcr(l, itype), 2
hybdat%nindxc(l, itype) = hybdat%nindxc(l, itype) + 1
hybdat%core1(:atoms%jri(itype), l, hybdat%nindxc(l, itype), itype) =&
& (weight1*core1r(:atoms%jri(itype), l, i, itype) +&
& weight2*core1r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
hybdat%core2(:atoms%jri(itype), l, hybdat%nindxc(l, itype), itype) =&
& (weight1*core2r(:atoms%jri(itype), l, i, itype) +&
& weight2*core2r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
END DO
ELSE
DO i = 1, nindxcr(l, itype) - 1, 2
hybdat%nindxc(l, itype) = hybdat%nindxc(l, itype) + 1
hybdat%core1(:atoms%jri(itype), l, hybdat%nindxc(l, itype), itype) =&
& (weight1*core1r(:atoms%jri(itype), l, i, itype) +&
& weight2*core1r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
hybdat%core2(:atoms%jri(itype), l, hybdat%nindxc(l, itype), itype) =&
& (weight1*core2r(:atoms%jri(itype), l, i, itype) +&
& weight2*core2r(:atoms%jri(itype), l, i + 1, itype))&
& /(weight1 + weight2)
END DO
hybdat%nindxc(l, itype) = hybdat%nindxc(l, itype) + 1
hybdat%core1(:atoms%jri(itype), l, hybdat%nindxc(l, itype), itype)&
& = core1r(:atoms%jri(itype), l, nindxcr(l, itype), itype)
hybdat%core2(:atoms%jri(itype), l, hybdat%nindxc(l, itype), itype)&
& = core2r(:atoms%jri(itype), l, nindxcr(l, itype), itype)
END IF
END DO
END DO
DEALLOCATE (nindxcr, core1r, core2r)
hybdat%maxindxc = maxval(hybdat%nindxc)
CLOSE (77)
END SUBROUTINE read_core
SUBROUTINE corewf(atoms, jsp, input, dimension,&
& vr, lmaxcd, maxindxc, mpi, lmaxc, nindxc, core1, core2, eig_c)
USE m_types
......@@ -509,4 +376,4 @@ CONTAINS
END SUBROUTINE core_init
END MODULE m_read_core
END MODULE m_hybrid_core
......@@ -45,7 +45,7 @@ CONTAINS
USE m_radflo, ONLY: radflo
USE m_loddop, ONLY: loddop
USE m_util, ONLY: intgrf_init, intgrf, rorderpf
USE m_read_core
USE m_hybrid_core
USE m_wrapper
USE m_eig66_io
USE m_types
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment