Commit c590703a authored by Matthias Redies's avatar Matthias Redies

first use of calc_cmt

parent 5782db2e
module m_calc_cmt
contains
! subroutine calc_cmt(atoms, cell, input, noco, hybinp, hybdat, kpts, sym, oneD,&
! zmat_ikp, jsp, ik)
! use m_types
! use m_judft
! implicit none
! type(t_atoms), intent(in) :: atoms
! type(t_cell), intent(in) :: cell
! type(t_enpara), intent(in) :: enpara
! type(t_input), intent(in) :: input
! type(t_noco), intent(in) :: noco
! type(t_hybinp), intent(in) :: hybinp
! type(t_hybdat), intent(in) :: hybdat
! type(t_kpts), intent(in) :: kpts
! type(t_sym), intent(in) :: sym
! type(t_oneD), intent(in) :: oneD
! type(t_mat), intent(in) :: zmat_ikp ! zmat of parent k-point
! integer, intent(in) :: jsp
! integer, intent(in) :: ik ! k-point index
!
!
!
! complex, allocatable :: acof(:, :, :), bcof(:, :, :), ccof(:, :, :, :)
! complex :: cmt(input%neig, hybdat%maxlmindx, atoms%nat)
! complex :: cmthlp(input%neig, hybdat%maxlmindx, atoms%nat)
!
! integer :: ikp, nbands, ok(3), maxp ! index of parent k-point
!
! type(t_lapw) :: lapw_ik, lapw_ikp
! type(t_usdus) :: usdus
!
! ikp = kpts%bkp(ik)
! nbands = hybdat%nbands(ikp)
!
! allocate(acof(nbands, 0:atoms%lmaxd*(atoms%lmaxd+2), atoms%nat), stat=ok(1))
! allocate(bcof(nbands, 0:atoms%lmaxd*(atoms%lmaxd+2), atoms%nat), stat=ok(2))
! allocate(ccof(-atoms%llod:atoms%llod, nbands, atoms%nlod, atoms%nat), stat=ok(3))
! ! allocate(cmt(input%neig, hybdat%maxlmindx, atoms%nat), stat=ok)
! ! allocate(cmthlp(input%neig, hybdat%maxlmindx, atoms%nat), stat=ok)
!
! CALL usdus%init(atoms, input%jspins)
! DO itype = 1, atoms%ntype
! DO l = 0, atoms%lmax(itype)
! CALL radfun(l, itype, jsp, enpara%el0(l,itype, jsp)), vr(:, itype, jsp), &
! atoms, u(:, :, l), du(:, :, l), usdus, nodem, noded, wronk)
! END DO
!
! IF (atoms%nlo(itype) >= 1) THEN
! CALL radflo(atoms, itype, jsp, ello_eig, vr(:, itype, jsp), u, du, mpi, usdus, uuilon, duilon, ulouilopn, flo)
! END IF
! END DO
!
! if(any(ok /= 0)) then
! maxp = maxloc(abs(ok))
! call judft_error("Error in allocating array no" // int2str(maxp))
! endif
! acof = 0; bcof = 0; ccof = 0
!
! CALL lapw_ik%init(input, noco, kpts, atoms, sym, ik, cell, sym%zrfs)
! CALL lapw_ikp%init(input, noco, kpts, atoms, sym, ikp, cell, sym%zrfs)
!
! lapw_ikp%nmat = lapw_ikp%nv(jsp) + atoms%nlotot
!
! CALL abcof(input, atoms, sym, cell, lapw_ikp, nbands, usdus, noco, jsp, &
! oneD, acof, bcof, ccof, zmat_ikp)
! CALL hyb_abcrot(hybinp, atoms, nbands, sym, acof, bcof, ccof)
!
! end subroutine calc_cmt
subroutine calc_cmt(atoms, cell, input, noco, hybinp, hybdat, mpdata, kpts, &
sym, oneD, zmat_ikp, jsp, ik, c_phase, cmt_out)
use m_types
use m_judft
USE m_hyb_abcrot
USE m_abcof
use m_constants, only: ImagUnit
use m_trafo, only: waveftrafo_gen_cmt
implicit none
type(t_atoms), intent(in) :: atoms
type(t_cell), intent(in) :: cell
type(t_input), intent(in) :: input
type(t_noco), intent(in) :: noco
type(t_hybinp), intent(in) :: hybinp
type(t_hybdat), intent(in) :: hybdat
type(t_mpdata), intent(in) :: mpdata
type(t_kpts), intent(in) :: kpts
type(t_sym), intent(in) :: sym
type(t_oneD), intent(in) :: oneD
type(t_mat), intent(in) :: zmat_ikp ! zmat of parent k-point
integer, intent(in) :: jsp
integer, intent(in) :: ik ! k-point
complex, intent(in) :: c_phase(:)
complex, intent(inout) :: cmt_out(:,:,:)
complex, allocatable :: acof(:,:,:), bcof(:,:,:), ccof(:,:,:,:)
complex, allocatable :: cmt(:,:,:)
integer :: ikp, nbands, ok(4) ! index of parent k-point
integer :: iatom, itype, ieq, indx, i, j, idum, iop, l, ll, lm, m
integer :: map_lo(atoms%nlod)
complex :: cdum
type(t_lapw) :: lapw_ik, lapw_ikp
ikp = kpts%bkp(ik)
nbands = hybdat%nbands(ikp)
allocate(acof(nbands, 0:atoms%lmaxd*(atoms%lmaxd+2), atoms%nat), stat=ok(1))
allocate(bcof(nbands, 0:atoms%lmaxd*(atoms%lmaxd+2), atoms%nat), stat=ok(2))
allocate(ccof(-atoms%llod:atoms%llod, nbands, atoms%nlod, atoms%nat), stat=ok(3))
allocate(cmt(nbands, hybdat%maxlmindx, atoms%nat), stat=ok(4))
if(any(ok /= 0)) then
call judft_error("Error in allocating abcof arrays")
endif
acof = 0; bcof = 0; ccof = 0
CALL lapw_ik%init(input, noco, kpts, atoms, sym, ik, cell, sym%zrfs)
CALL lapw_ikp%init(input, noco, kpts, atoms, sym, ikp, cell, sym%zrfs)
lapw_ikp%nmat = lapw_ikp%nv(jsp) + atoms%nlotot
CALL abcof(input, atoms, sym, cell, lapw_ikp, nbands, hybdat%usdus, noco, jsp, &
oneD, acof, bcof, ccof, zmat_ikp)
CALL hyb_abcrot(hybinp, atoms, nbands, sym, acof, bcof, ccof)
cmt = 0
iatom = 0
DO itype = 1, atoms%ntype
DO ieq = 1, atoms%neq(itype)
iatom = iatom + 1
indx = 0
DO l = 0, atoms%lmax(itype)
ll = l*(l + 1)
cdum = ImagUnit**l
! determine number of local orbitals with quantum number l
! map returns the number of the local orbital of quantum
! number l in the list of all local orbitals of the atom type
idum = 0
map_lo = 0
IF (mpdata%num_radfun_per_l(l, itype) > 2) THEN
DO j = 1, atoms%nlo(itype)
IF (atoms%llo(j, itype) == l) THEN
idum = idum + 1
map_lo(idum) = j
END IF
END DO
END IF
DO M = -l, l
lm = ll + M
DO i = 1, mpdata%num_radfun_per_l(l, itype)
indx = indx + 1
IF (i == 1) THEN
cmt(:, indx, iatom) = cdum*acof(:, lm, iatom)
ELSE IF (i == 2) THEN
cmt(:, indx, iatom) = cdum*bcof(:, lm, iatom)
ELSE
idum = i - 2
cmt(:, indx, iatom) = cdum*ccof(M, :, map_lo(idum), iatom)
END IF
END DO
END DO
END DO
END DO
END DO
! write cmt at irreducible k-points in direct-access file cmt
if(ik <= kpts%nkpt) then
cmt_out = cmt
else
iop = kpts%bksym(ik)
call waveftrafo_gen_cmt(cmt, c_phase, zmat_ikp%l_real, ikp, iop, atoms, &
mpdata, hybinp, kpts, sym, nbands, cmt_out)
endif
end subroutine calc_cmt
end module m_calc_cmt
......@@ -2,14 +2,11 @@
CONTAINS
SUBROUTINE checkolap(atoms, hybdat,&
mpdata,hybinp,&
nkpti, kpts,&
mpi, &
input, sym, noco,&
cell, lapw, jsp)
SUBROUTINE checkolap(atoms, hybdat, mpdata,hybinp, nkpti, kpts,&
mpi, input, sym, noco, cell, jsp, oneD, lapw)
USE m_util, ONLY: chr, sphbessel, harmonicsr
use m_intgrf, only: intgrf, intgrf_init
use m_calc_cmt
USE m_constants
USE m_types
USE m_io_hybinp
......@@ -28,6 +25,7 @@
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_atoms), INTENT(IN) :: atoms
type(t_oneD), intent(in) :: oneD
TYPE(t_lapw), INTENT(INOUT) :: lapw
! - scalars -
......@@ -62,7 +60,7 @@
COMPLEX :: cmt(input%neig, hybdat%maxlmindx, atoms%nat, nkpti)
COMPLEX :: y((atoms%lmaxd + 1)**2)
COMPLEX, ALLOCATABLE :: olapcv(:, :)
COMPLEX, ALLOCATABLE :: olapcv(:, :), c_phase(:)
COMPLEX, ALLOCATABLE :: carr1(:, :), carr2(:, :), carr3(:, :)
CHARACTER, PARAMETER :: lchar(0:38) =&
......@@ -87,8 +85,13 @@
! read in cmt
DO ikpt = 1, nkpti
call read_z(atoms, cell, hybdat, kpts, sym, noco, input, ikpt, jsp, z(ikpt))
call read_cmt(cmt(:, :, :, ikpt), ikpt)
if(allocated(c_phase)) deallocate(c_phase)
allocate(c_phase(hybdat%nbands(ikpt)))
call read_z(atoms, cell, hybdat, kpts, sym, noco, input, ikpt, &
jsp, z(ikpt), c_phase)
call calc_cmt(atoms, cell, input, noco, hybinp, hybdat, mpdata, kpts, &
sym, oneD, z(kpts%bkp(ikpt)), jsp, ikpt, c_phase, cmt(:,:,:,ikpt))
END DO
IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <core|core>'
......
......@@ -188,7 +188,7 @@ CONTAINS
! check olap between core-basis/core-valence/basis-basis
CALL checkolap(atoms, hybdat, mpdata, hybinp, kpts%nkpt, kpts, mpi, &
input, sym, noco, cell, lapw, jsp)
input, sym, noco, cell, jsp, oneD, lapw)
! set up pointer pntgpt
......
......@@ -425,8 +425,8 @@ CONTAINS
END SUBROUTINE waveftrafo_genwavf
SUBROUTINE waveftrafo_gen_zmat(z_in, nk, iop, &
kpts, sym, jsp, input, nbands, &
lapw_nk, lapw_rkpt, z_out, c_phase)
kpts, sym, jsp, input, nbands, &
lapw_nk, lapw_rkpt, z_out, c_phase)
use m_juDFT
USE m_constants
......@@ -441,7 +441,7 @@ CONTAINS
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_lapw), INTENT(IN) :: lapw_nk, lapw_rkpt
type(t_mat), intent(inout) :: z_out
complex, intent(inout), optional :: c_phase(nbands)
complex, intent(inout), optional :: c_phase(:)
! - scalars -
INTEGER, INTENT(IN) :: nk, jsp, nbands
INTEGER, INTENT(IN) :: iop
......
......@@ -179,7 +179,7 @@ contains
CALL write_matrix(mat, rec, id_olap)
END subroutine write_olap
subroutine read_z(atoms, cell, hybdat, kpts, sym, noco, input, ik, jsp, z_out)
subroutine read_z(atoms, cell, hybdat, kpts, sym, noco, input, ik, jsp, z_out, c_phase)
USE m_eig66_io
use m_types
use m_trafo
......@@ -194,6 +194,8 @@ contains
integer, intent(in) :: ik, jsp
TYPE(t_mat), INTENT(INOUT) :: z_out
complex, intent(inout), optional :: c_phase(:)
INTEGER :: ikp, iop
type(t_mat) :: tmp_mat
complex :: cmt(input%neig,hybdat%maxlmindx,atoms%nat)
......
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