Commit 05cfb284 authored by Matthias Redies's avatar Matthias Redies

branch switch

parent e1f5e9f7
......@@ -6,8 +6,7 @@
MODULE m_cdngen
USE m_types
TYPE(t_potden) :: comparison_kinED_pw
TYPE(t_potden) :: comparison_kinED_pw(3)
CONTAINS
SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
......@@ -87,6 +86,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!Local Scalars
REAL :: fix, qtot, dummy,eFermiPrev
INTEGER :: jspin, jspmax
INTEGER :: dim_idx
#ifdef CPP_HDF
INTEGER(HID_T) :: banddosFile_id
#endif
......@@ -100,6 +100,10 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL orbcomp%init(input,banddos,dimension,atoms,kpts)
CALL outDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
do dim_idx = 1,3
CALL comparison_kinED_pw(dim_idx)%init(stars,atoms,sphhar,vacuum,&
noco,input%jspins, POTDEN_TYPE_DEN)
enddo
CALL EnergyDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_EnergyDen)
IF (mpi%irank == 0) CALL openXMLElementNoAttributes('valenceDensity')
......@@ -114,12 +118,16 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin,sliceplot,banddos)
CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,coreSpecInput,mcd,slab,orbcomp)
fake_regCharges = regCharges
fake_dos = dos
fake_results = results
fake_moments = moments
CALL calc_kinED_pw(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,vTot,oneD,cdnvalJob,comparison_kinED_pw,fake_regCharges,fake_dos,fake_results,fake_moments)
do dim_idx =1,3
fake_regCharges = regCharges
fake_dos = dos
fake_results = results
fake_moments = moments
CALL calc_kinED_pw(dim_idx,eig_id,mpi,kpts,jspin,noco,input,banddos,cell,&
atoms,enpara,stars,vacuum,dimension,sphhar,sym,vTot,oneD,&
cdnvalJob,comparison_kinED_pw(dim_idx),fake_regCharges,&
fake_dos,fake_results,fake_moments)
enddo
END DO
! calculate kinetic energy density for MetaGGAs
......@@ -197,4 +205,30 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END SUBROUTINE cdngen
subroutine save_kinED(xcpot, input, noco, stars, cell)
use m_types
use m_pw_tofrom_grid
implicit none
CLASS(t_xcpot),INTENT(IN) :: xcpot
type(t_input), intent(in) :: input
type(t_noco), intent(in) :: noco
type(t_stars), intent(in) :: stars
type(t_cell), intent(in) :: cell
integer :: dim_idx
real, allocatable :: tmp(:,:), kinED(:,:)
type(t_gradients) :: grad
do dim_idx = 1,3
call pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, cell, &
comparison_kinED_pw(dim_idx)%pw, grad, tmp)
if(.not. allocated(kinED)) allocate(kinED, mold=tmp)
kinEd = kinED + tmp
deallocate(tmp)
enddo
write (*,*) "kED shape =", shape(kinED)
end subroutine save_kinED
END MODULE m_cdngen
......@@ -14,6 +14,7 @@ MODULE m_metagga
CONTAINS
SUBROUTINE calc_kinEnergyDen(EnergyDen_rs, vTot_rs, den_rs, kinEnergyDen_RS)
USE m_juDFT_stop
!use m_cdngen
IMPLICIT NONE
REAL, INTENT(in) :: den_RS(:,:), EnergyDen_RS(:,:), vTot_RS(:,:)
REAL, INTENT(inout), allocatable :: kinEnergyDen_RS(:,:)
......@@ -126,7 +127,7 @@ CONTAINS
ENDDO
END SUBROUTINE calc_EnergyDen_auxillary_weights
SUBROUTINE calc_kinED_pw(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
SUBROUTINE calc_kinED_pw(dim_idx, eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,vTot,oneD,cdnvalJob,kinED,regCharges,dos,results,&
moments,coreSpecInput,mcd,slab,orbcomp)
......@@ -169,7 +170,7 @@ CONTAINS
#endif
IMPLICIT NONE
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
......@@ -197,7 +198,7 @@ CONTAINS
TYPE(t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin
INTEGER, INTENT(IN) :: eig_id, jspin, dim_idx
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -320,7 +321,7 @@ CONTAINS
CALL zMat%init(l_real,nbasfcn,noccbd)
CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat)
call set_zPrime(zMat, kpts%bk(:,ikpt), lapw, zPrime)
call set_zPrime(dim_idx, zMat, kpts%bk(:,ikpt), lapw, zPrime)
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
......@@ -411,26 +412,27 @@ CONTAINS
END IF
CALL timestop("cdnval")
write (*,*) "done calc_kinED_pw"
END SUBROUTINE calc_kinED_pw
subroutine set_zPrime(zMat, kpt, lapw, zPrime)
subroutine set_zPrime(dim_idx, zMat, kpt, lapw, zPrime)
USE m_types
implicit none
INTEGER, intent(in) :: dim_idx
TYPE (t_mat), intent(in) :: zMat
REAL, intent(in) :: kpt(3)
TYPE(t_lapw), intent(in) :: lapw
TYPE (t_mat) :: zPrime
call zPrime%init(zMat)
REAL :: fac
INTEGER :: basis_idx
if(zPrime%l_real) then
write (*,*) "zMat is real"
else
write (*,*) "zMat is complex"
if(.not. allocated(zPrime%data_r)) then
call zPrime%init(zMat)
endif
do basis_idx = 1,size(lapw%gvec,dim=2)
fac = kpt(dim_idx) + lapw%gvec(dim_idx,basis_idx,1)
zPrime%data_r(basis_idx,:) = fac * zPrime%data_r(basis_idx,:)
enddo
end subroutine set_zPrime
END MODULE m_metagga
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