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

branch switch

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