Commit d906df84 authored by Matthias Redies's avatar Matthias Redies

replace more calc_cmt

parent b5b15fac
...@@ -147,7 +147,7 @@ CONTAINS ...@@ -147,7 +147,7 @@ CONTAINS
DO nk = 1, kpts%nkpt DO nk = 1, kpts%nkpt
!DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride !DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, l_zref) CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, l_zref)
CALL hsfock(nk, atoms, mpdata, hybinp, lapw, kpts, jsp, input, hybdat, eig_irr, sym, cell, & CALL hsfock(nk, atoms, mpdata, hybinp, lapw, oneD, kpts, jsp, input, hybdat, eig_irr, sym, cell, &
noco, results, MAXVAL(hybdat%nobd(:,jsp)), xcpot, mpi) noco, results, MAXVAL(hybdat%nobd(:,jsp)), xcpot, mpi)
END DO END DO
END DO END DO
......
...@@ -61,7 +61,7 @@ MODULE m_exchange_valence_hf ...@@ -61,7 +61,7 @@ MODULE m_exchange_valence_hf
CONTAINS CONTAINS
SUBROUTINE exchange_valence_hf(ik, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, & SUBROUTINE exchange_valence_hf(ik, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nsest, indx_sest, & oneD,eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nsest, indx_sest, &
mpi, mat_ex) mpi, mat_ex)
USE m_wrapper USE m_wrapper
...@@ -87,6 +87,7 @@ CONTAINS ...@@ -87,6 +87,7 @@ CONTAINS
TYPE(t_kpts), INTENT(IN) :: kpts TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw TYPE(t_lapw), INTENT(IN) :: lapw
type(t_oneD), intent(in) :: oneD
TYPE(t_mat), INTENT(INOUT) :: mat_ex TYPE(t_mat), INTENT(INOUT) :: mat_ex
TYPE(t_hybdat), INTENT(INOUT) :: hybdat TYPE(t_hybdat), INTENT(INOUT) :: hybdat
...@@ -330,7 +331,7 @@ CONTAINS ...@@ -330,7 +331,7 @@ CONTAINS
IF (zero_order) THEN IF (zero_order) THEN
CALL dwavefproducts(dcprod, ik, 1, hybdat%nbands(ik), 1, hybdat%nbands(ik), .false., input,atoms, mpdata,hybinp, & CALL dwavefproducts(dcprod, ik, 1, hybdat%nbands(ik), 1, hybdat%nbands(ik), .false., input,atoms, mpdata,hybinp, &
cell, hybdat, kpts, sym,noco, lapw, jsp, eig_irr) cell, hybdat, kpts, sym,noco, lapw, oneD, jsp, eig_irr)
! make dcprod hermitian ! make dcprod hermitian
DO n1 = 1, hybdat%nbands(ik) DO n1 = 1, hybdat%nbands(ik)
......
...@@ -54,7 +54,7 @@ MODULE m_hsfock ...@@ -54,7 +54,7 @@ MODULE m_hsfock
CONTAINS CONTAINS
SUBROUTINE hsfock(nk, atoms, mpdata, hybinp, lapw, kpts, jsp, input, hybdat, eig_irr, sym, cell, noco, & SUBROUTINE hsfock(nk, atoms, mpdata, hybinp, lapw, oneD, kpts, jsp, input, hybdat, eig_irr, sym, cell, noco, &
results, mnobd, xcpot, mpi) results, mnobd, xcpot, mpi)
IMPLICIT NONE IMPLICIT NONE
...@@ -68,6 +68,7 @@ CONTAINS ...@@ -68,6 +68,7 @@ CONTAINS
TYPE(t_kpts), INTENT(IN) :: kpts TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw TYPE(t_lapw), INTENT(IN) :: lapw
type(t_oneD), intent(in) :: oneD
TYPE(t_mpdata), intent(inout) :: mpdata TYPE(t_mpdata), intent(inout) :: mpdata
TYPE(t_hybinp), INTENT(IN) :: hybinp TYPE(t_hybinp), INTENT(IN) :: hybinp
TYPE(t_hybdat), INTENT(INOUT) :: hybdat TYPE(t_hybdat), INTENT(INOUT) :: hybdat
...@@ -165,7 +166,7 @@ CONTAINS ...@@ -165,7 +166,7 @@ CONTAINS
! HF exchange ! HF exchange
ex%l_real = sym%invs ex%l_real = sym%invs
CALL exchange_valence_hf(nk, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, & CALL exchange_valence_hf(nk, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nsest, indx_sest, & oneD,eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nsest, indx_sest, &
mpi, ex) mpi, ex)
CALL timestart("core exchange calculation") CALL timestart("core exchange calculation")
...@@ -193,7 +194,7 @@ CONTAINS ...@@ -193,7 +194,7 @@ CONTAINS
CALL invtrafo%alloc(olap%l_real, hybdat%nbands(nk), nbasfcn) CALL invtrafo%alloc(olap%l_real, hybdat%nbands(nk), nbasfcn)
CALL trafo%TRANSPOSE(invtrafo) CALL trafo%TRANSPOSE(invtrafo)
DO i = 1, hybdat%nbands(nk) DO i = 1, hybdat%nbands(nk)
DO j = 1, i - 1 DO j = 1, i - 1
IF (ex%l_real) THEN IF (ex%l_real) THEN
......
...@@ -704,7 +704,7 @@ CONTAINS ...@@ -704,7 +704,7 @@ CONTAINS
dcprod, nk, bandi1, bandf1, bandi2, bandf2, lwrite, & dcprod, nk, bandi1, bandf1, bandi2, bandf2, lwrite, &
input, atoms, mpdata, hybinp, & input, atoms, mpdata, hybinp, &
cell, & cell, &
hybdat, kpts, sym, noco, lapw, & hybdat, kpts, sym, noco, lapw, oneD, &
jsp, & jsp, &
eig_irr) eig_irr)
...@@ -723,6 +723,7 @@ CONTAINS ...@@ -723,6 +723,7 @@ CONTAINS
type(t_noco), intent(in) :: noco type(t_noco), intent(in) :: noco
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw TYPE(t_lapw), INTENT(IN) :: lapw
type(t_oneD), intent(in) :: oneD
! - scalars - ! - scalars -
INTEGER, INTENT(IN) :: nk, bandi1, bandf1, bandi2, bandf2 INTEGER, INTENT(IN) :: nk, bandi1, bandf1, bandi2, bandf2
...@@ -744,7 +745,7 @@ CONTAINS ...@@ -744,7 +745,7 @@ CONTAINS
dcprod = cmplx_0 dcprod = cmplx_0
CALL momentum_matrix(dcprod, nk, bandi1, bandf1, bandi2, bandf2, & CALL momentum_matrix(dcprod, nk, bandi1, bandf1, bandi2, bandf2, &
input, atoms, mpdata, hybinp, cell, hybdat, kpts, sym, noco, lapw, & input, atoms, mpdata, hybinp, cell, hybdat, kpts, sym, noco, lapw, &
jsp) oneD,jsp)
! __ ! __
! Calculate expansion coefficients -i < uj | \/ | ui > / ( ei - ej ) for periodic function ui ! Calculate expansion coefficients -i < uj | \/ | ui > / ( ei - ej ) for periodic function ui
...@@ -776,7 +777,7 @@ CONTAINS ...@@ -776,7 +777,7 @@ CONTAINS
! !
SUBROUTINE momentum_matrix(momentum, nk, bandi1, bandf1, bandi2, bandf2, & SUBROUTINE momentum_matrix(momentum, nk, bandi1, bandf1, bandi2, bandf2, &
input, atoms, mpdata, hybinp, & input, atoms, mpdata, hybinp, &
cell, hybdat, kpts, sym, noco, lapw, jsp) cell, hybdat, kpts, sym, noco, lapw, oneD, jsp)
USE m_olap USE m_olap
USE m_wrapper USE m_wrapper
USE m_util, only: derivative USE m_util, only: derivative
...@@ -785,6 +786,7 @@ CONTAINS ...@@ -785,6 +786,7 @@ CONTAINS
USE m_constants USE m_constants
USE m_types USE m_types
USE m_io_hybinp USE m_io_hybinp
use m_calc_cmt
IMPLICIT NONE IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input TYPE(t_input), INTENT(IN) :: input
TYPE(t_hybdat), INTENT(IN) :: hybdat TYPE(t_hybdat), INTENT(IN) :: hybdat
...@@ -796,6 +798,7 @@ CONTAINS ...@@ -796,6 +798,7 @@ CONTAINS
type(t_noco), intent(in) :: noco type(t_noco), intent(in) :: noco
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw TYPE(t_lapw), INTENT(IN) :: lapw
type(t_oneD), intent(in) :: oneD
! - scalars - ! - scalars -
INTEGER, INTENT(IN) :: bandi1, bandf1, bandi2, bandf2 INTEGER, INTENT(IN) :: bandi1, bandf1, bandi2, bandf2
...@@ -830,14 +833,17 @@ CONTAINS ...@@ -830,14 +833,17 @@ CONTAINS
COMPLEX :: olap_c(lapw%nv(jsp)*(lapw%nv(jsp) + 1)/2) COMPLEX :: olap_c(lapw%nv(jsp)*(lapw%nv(jsp) + 1)/2)
REAL :: vec1_r(lapw%nv(jsp)), vec2_r(lapw%nv(jsp)), vec3_r(lapw%nv(jsp)) REAL :: vec1_r(lapw%nv(jsp)), vec2_r(lapw%nv(jsp)), vec3_r(lapw%nv(jsp))
COMPLEX :: vec1_c(lapw%nv(jsp)), vec2_c(lapw%nv(jsp)), vec3_c(lapw%nv(jsp)) COMPLEX :: vec1_c(lapw%nv(jsp)), vec2_c(lapw%nv(jsp)), vec3_c(lapw%nv(jsp))
COMPLEX :: c_phase(hybdat%nbands(nk))
! read in cmt coefficients from direct access file cmt at kpoint nk ! read in cmt coefficients from direct access file cmt at kpoint nk
momentum = cmplx_0 momentum = cmplx_0
call read_cmt(cmt, nk) call read_z(atoms, cell, hybdat, kpts, sym, noco, input, nk, jsp, z, c_phase)
call calc_cmt(atoms, cell, input, noco, hybinp, hybdat, mpdata, kpts, &
sym, oneD, z, jsp, nk, c_phase, cmt)
!call read_cmt(cmt, nk)
! read in z coefficients from direct access file z at kpoint nk ! read in z coefficients from direct access file z at kpoint nk
call read_z(atoms, cell, hybdat, kpts, sym, noco, input, nk, jsp, z)
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf) !CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
gpt(:, 1:lapw%nv(jsp)) = lapw%gvec(:, 1:lapw%nv(jsp), jsp) gpt(:, 1:lapw%nv(jsp)) = lapw%gvec(:, 1:lapw%nv(jsp), jsp)
......
...@@ -535,7 +535,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars ...@@ -535,7 +535,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
exMat%l_real=sym%invs exMat%l_real=sym%invs
CALL exchange_valence_hf(ikpt,kpts,nkpt_EIBZ, sym,atoms,mpdata,hybinp,cell,input,jspin,hybdat,mnobd,lapw,& CALL exchange_valence_hf(ikpt,kpts,nkpt_EIBZ, sym,atoms,mpdata,hybinp,cell,input,jspin,hybdat,mnobd,lapw,&
eig_irr,results,pointer_EIBZ,n_q,wl_iks,xcpot,noco,nsest,indx_sest,& oneD,eig_irr,results,pointer_EIBZ,n_q,wl_iks,xcpot,noco,nsest,indx_sest,&
mpi,exMat) mpi,exMat)
CALL exchange_vccv1(ikpt,input,atoms,mpdata,hybinp,hybdat,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat) CALL exchange_vccv1(ikpt,input,atoms,mpdata,hybinp,hybdat,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat)
......
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