phase0_2015.01.01.patch
phase0_2015.01.01.patch
—
differences between files,
1.03 MB (1081551 bytes)
ファイルコンテンツ
diff -uprN phase0_2015.01/src_phase/ChargeDensity_Construction.F90 phase0_2015.01.01/src_phase/ChargeDensity_Construction.F90
--- phase0_2015.01/src_phase/ChargeDensity_Construction.F90 2015-09-14 15:16:01.000000000 +0900
+++ phase0_2015.01.01/src_phase/ChargeDensity_Construction.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 455 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 494 $)
!
! SUBROUINE: ChargeDensity_Construction, FermiEnergyLevel,
! CD_Softpart_plus_Hardpart
@@ -32,7 +32,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine ChargeDensity_Construction(ic)
-! $Id: ChargeDensity_Construction.F90 455 2015-09-07 08:04:26Z yamasaki $
+! $Id: ChargeDensity_Construction.F90 494 2016-06-02 00:54:16Z jkoga $
use m_Total_Energy, only : m_TE_total_energy, ehartr
use m_Charge_Density, only : m_CD_convergence_check &
& , m_CD_softpart, m_CD_hardpart &
@@ -73,8 +73,7 @@ subroutine ChargeDensity_Construction(ic
! ========================================================================= 11.0
- use m_PlaneWaveBasisSet, only : kgp,ngabc,igfp_l
- use m_Electronic_Structure, only : vlhxc_l
+ use m_PlaneWaveBasisSet, only : kgp
use m_FFT, only : fft_box_size_CD
@@ -111,6 +110,12 @@ subroutine ChargeDensity_Construction(ic
& m_OP_calc_OrbMagMom_method2
! ============== 2014/08/26
+! ==== Positron SCF === 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : positron_CONV
+ use m_Positron_Wave_Functions, only : m_pWF_construct_pcharge, m_pWF_charge_rspace
+! ===================== 2015/11/28
+
implicit none
include 'mpif.h'
@@ -138,12 +143,14 @@ subroutine ChargeDensity_Construction(ic
! =================== added by K. Tagami ============ 5.0
if ( sw_eval_energy_before_charge == ON ) then
! ================================= modified by K.Tagami ====== 11.0
+! call m_TE_total_energy(nfout,display_on,kv3)
+!
if ( noncol ) then
call m_TE_total_energy_noncl(nfout,display_on,kv3)
-! ============================================================= 11.0
else
call m_TE_total_energy(nfout,display_on,kv3)
endif
+! ============================================================= 11.0
endif
! =================================================== 5.0
@@ -202,16 +209,20 @@ subroutine ChargeDensity_Construction(ic
if(sw_esm==ON)then
nfftcd = fft_box_size_CD(1,0)*fft_box_size_CD(2,0)*fft_box_size_CD(3,0)
allocate(vhar(nfftcd));vhar=(0.d0,0.d0)
- allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+! allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+ allocate(chgc(1:kgp,nspin));chgc=(0.d0,0.d0)
if(kimg==1)then
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),0.d0)
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),0.d0)
+ chgc(ig,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),0.d0)
enddo
else
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),chgq_l(ig,2,1:nspin))
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),chgq_l(ig,2,1:nspin))
+ chgc(ig,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),chgq_l(ig,2,1:nspin))
enddo
endif
+ call mpi_allreduce(mpi_in_place,chgc,kgp*nspin,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
call esm_hartree(chgc,ehartr,vhar)
ehartr = 0.5d0*ehartr !Ry -> Ha
deallocate(chgc)
@@ -249,14 +260,21 @@ subroutine ChargeDensity_Construction(ic
endif
! ============== 2014/08/26
+ if ( sw_positron /= OFF ) then
+ if ( positron_method /= Positron_CONV ) then
+ call m_pWF_construct_pcharge
+ call m_pWF_charge_rspace
+ endif
+ endif
+
if ( sw_eval_energy_before_charge == OFF ) then
! ================================== modified by K. Tagami ================ 11.0
if ( noncol ) then
call m_TE_total_energy_noncl(nfout,display_on,kv3)
else
-! ========================================================================== 11.0
call m_TE_total_energy(nfout,display_on,kv3)
endif
+! ========================================================================== 11.0
endif
! ======================================================== 5.0
@@ -296,7 +314,7 @@ contains
end subroutine FermiEnergyLevel
subroutine CD_Softpart_plus_Hardpart
-! $Id: ChargeDensity_Construction.F90 455 2015-09-07 08:04:26Z yamasaki $
+! $Id: ChargeDensity_Construction.F90 494 2016-06-02 00:54:16Z jkoga $
!fj#ifdef __TIMER_SUB__
!fj call timer_sta(716)
!fj#endif
diff -uprN phase0_2015.01/src_phase/ChargeDensity_Mixing.F90 phase0_2015.01.01/src_phase/ChargeDensity_Mixing.F90
--- phase0_2015.01/src_phase/ChargeDensity_Mixing.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/ChargeDensity_Mixing.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 492 $)
!
! SUBROUINE: ChargeDensity_Mixing
!
@@ -31,7 +31,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine ChargeDensity_Mixing
-! $Id: ChargeDensity_Mixing.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: ChargeDensity_Mixing.F90 492 2016-05-31 03:06:04Z jkoga $
use m_Const_Parameters, only : DP,SIMPLE,BROYD1,BROYD2,DFP,PULAY,RMM2P,ON &
& , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION, CONTINUATION, SKIP
use m_Charge_Density, only : m_CD_check
@@ -49,7 +49,7 @@ subroutine ChargeDensity_Mixing
& , m_CtrlP_set_rmx &
& , m_CtrlP_waymix_now &
& , m_CtrlP_set_mix_parameter &
- & , sw_hubbard
+ & , sw_hubbard, sw_mix_occ_matrix
use m_Files, only : nfout
use m_IterationNumbers, only : iteration_electronic, iteration_ionic &
& , m_Iter_cmix_reset
@@ -305,10 +305,10 @@ contains
case (SIMPLE)
call m_CD_simple_mixing( nfout,rmxt_tot )
call m_CD_simple_mixing_hard( nfout, rmxt_hard )
- if ( sw_hubbard == ON ) then
+ if ( sw_hubbard == ON .and.sw_mix_occ_matrix==OFF ) then
call Renewal_of_OccMat( .false., ON ) ! hsr --> om
- call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
+ if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case (BROYD1)
! call m_CD_mix_broyden1_with_hsr(rmxt_tot)
@@ -316,22 +316,21 @@ contains
stop
case (BROYD2)
- call m_CD_mix_broyden2_with_hsr(nfout,rmxt_tot)
- if ( sw_hubbard == ON ) then
+ call m_CD_mix_broyden2_with_hsr(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
+ if ( sw_hubbard == ON .and. sw_mix_occ_matrix==OFF ) then
call Renewal_of_OccMat(.false., ON ) ! hsr --> om
- call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
-
+ if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case (DFP)
! call m_CD_mix_DFP(rmxt_tot)
write(*,*) 'Not supported '
stop
case (PULAY)
- call m_CD_mix_pulay_with_hsr(nfout,rmxt_tot)
- if ( sw_hubbard == ON ) then
+ call m_CD_mix_pulay_with_hsr(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
+ if ( sw_hubbard == ON .and. sw_mix_occ_matrix==OFF ) then
call Renewal_of_OccMat(.false., ON ) ! hsr --> om
- call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
+ if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case default
stop ' ! waymix is invalid'
end select mixing_way
@@ -349,13 +348,13 @@ contains
endif
case (BROYD2)
- call m_CD_mix_broyden2_intg(nfout,rmxt_tot)
+ call m_CD_mix_broyden2_intg(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
if ( sw_hubbard == ON ) then
call Renewal_of_OccMat(.false., ON ) ! hsr --> om
call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
case (PULAY)
- call m_CD_mix_pulay_intg(nfout,rmxt_tot)
+ call m_CD_mix_pulay_intg(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
if ( sw_hubbard == ON ) then
call Renewal_of_OccMat(.false., ON ) ! hsr --> om
call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
diff -uprN phase0_2015.01/src_phase/Convergence_Check.F90 phase0_2015.01.01/src_phase/Convergence_Check.F90
--- phase0_2015.01/src_phase/Convergence_Check.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Convergence_Check.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! FUNCTION: Ending_Time(), ckiter(), ChargeDensity_is_Converged(),
! TotalEnergy_is_Divergent(), Forces_are_Converged(),
@@ -37,7 +37,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
logical function Ending_Time()
-! $Id: Convergence_Check.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Convergence_Check.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Const_Parameters, only : INITIAL, CONTINUATION, FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
use m_Files, only : nfstop,nfout,m_Files_open_nfstop,m_Files_close_nfstop
use m_IterationNumbers, only : iteration, iteration_ionic, iteration_electronic
@@ -45,6 +45,7 @@ logical function Ending_Time()
& , max_TS_iteration_is_given, max_mdstep_is_given, printable &
& , m_CtrlP_ckcput, m_CtrlP_rd_istop
use m_Parallelization, only : mype,mpi_comm_group
+
implicit none
include 'mpif.h' ! MPI
@@ -209,6 +210,12 @@ logical function ChargeDensity_is_Conver
& truncate_vxw_updating, sw_update_vxw, oneshot
! ======================================================================== 12.5Exp
+! === Postitron SCF === 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : positron_GGGC
+ use m_Positron_Wave_Functions, only : m_pWF_update_lifetime
+! ===================== 2015/11/28
+
implicit none
logical, save :: renew_wf_again = .false.
logical :: EigenValues_are_Converged
@@ -320,6 +327,10 @@ logical function ChargeDensity_is_Conver
! <--
end if
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == positron_GGGC ) call m_pWF_update_lifetime
+ endif
+
! =========================== KT_Test ================= 12.5Exp
if ( sw_hybrid_functional == ON ) then
if ( truncate_vxw_updating .and. sw_update_vxw == OFF ) then
@@ -1136,6 +1147,38 @@ logical function Positron_Defect()
end if
end function Positron_Defect
+! ==== Positron SCF === 2015/11/28
+logical function Positron_scf()
+ use m_Const_Parameters, only : OFF, Positron_CONV
+ use m_Control_Parameters, only : sw_positron, positron_method
+
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_CONV ) then
+ Positron_scf = .false.
+ else
+ Positron_scf = .true.
+ end if
+ else
+ Positron_scf = .false.
+ endif
+end function Positron_scf
+
+logical function Positron_nonscf()
+ use m_Const_Parameters, only : OFF, Positron_CONV
+ use m_Control_Parameters, only : sw_positron, positron_method
+
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_CONV ) then
+ Positron_nonscf = .true.
+ else
+ Positron_nonscf = .false.
+ end if
+ else
+ Positron_nonscf = .false.
+ endif
+end function Positron_nonscf
+! ========== 2015/11/28
+
logical function Structure_is_fixed()
! Coded by T. Yamasaki, 25 Jul. 2008
use m_Const_Parameters, only : ON, VERLET
diff -uprN phase0_2015.01/src_phase/EsmPack/Esm.F90 phase0_2015.01.01/src_phase/EsmPack/Esm.F90
--- phase0_2015.01/src_phase/EsmPack/Esm.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/EsmPack/Esm.F90 2016-07-12 12:51:19.000000000 +0900
@@ -227,9 +227,9 @@ END SUBROUTINE esm_ggen_2d
SUBROUTINE esm_hartree (rhog, ehart, aux )
Use ESM_VARS
IMPLICIT NONE
-#ifdef __MPI__
- include 'mpif.h'
-#endif
+!#ifdef __MPI__
+! include 'mpif.h'
+!#endif
!
COMPLEX(8) :: rhog(ngm,nspin) ! n(G)
REAL(8), Intent(Out) :: ehart ! Hartree energy
@@ -339,22 +339,22 @@ SUBROUTINE esm_hartree (rhog, ehart, aux
vg3(1:nr3x,ng_2d)=vg2(1:nr3x)*2.d0
enddo
-#ifdef __MPI__
- n1h=nr1x/2;n2h=nr2x/2
- allocate(vg3_mpi(1:nr3x,-n2h:n2h,-n1h:n1h));vg3_mpi(:,:,:)=(0.d0,0.d0)
- do ng_2d=1,ngm_2d
- k1 = mill_2d(1,ng_2d)
- k2 = mill_2d(2,ng_2d)
- vg3_mpi(:,k2,k1) = vg3(:,ng_2d)
- enddo
- call mpi_allreduce(MPI_IN_PLACE,vg3_mpi,nr3x*nr2x*nr1x,mpi_double_complex,mpi_sum,communicator,ierr)
- do ng_2d=1,ngm_2d
- k1 = mill_2d(1,ng_2d)
- k2 = mill_2d(2,ng_2d)
- vg3(:,ng_2d) = vg3_mpi(:,k2,k1)
- enddo
- deallocate(vg3_mpi)
-#endif
+!#ifdef __MPI__
+! n1h=nr1x/2;n2h=nr2x/2
+! allocate(vg3_mpi(1:nr3x,-n2h:n2h,-n1h:n1h));vg3_mpi(:,:,:)=(0.d0,0.d0)
+! do ng_2d=1,ngm_2d
+! k1 = mill_2d(1,ng_2d)
+! k2 = mill_2d(2,ng_2d)
+! vg3_mpi(:,k2,k1) = vg3(:,ng_2d)
+! enddo
+! call mpi_allreduce(MPI_IN_PLACE,vg3_mpi,nr3x*nr2x*nr1x,mpi_double_complex,mpi_sum,communicator,ierr)
+! do ng_2d=1,ngm_2d
+! k1 = mill_2d(1,ng_2d)
+! k2 = mill_2d(2,ng_2d)
+! vg3(:,ng_2d) = vg3_mpi(:,k2,k1)
+! enddo
+! deallocate(vg3_mpi)
+!#endif
deallocate(vg2,vg2_in)
!$omp end parallel
@@ -507,9 +507,9 @@ SUBROUTINE esm_hartree (rhog, ehart, aux
vg3(1:nr3x,ng_2d)=vg2(1:nr3x)*2.d0
-#ifdef __MPI__
- call mpi_allreduce(MPI_IN_PLACE,vg3(1,ng_2d),nr3x,mpi_double_complex,mpi_sum,communicator,ierr)
-#endif
+!#ifdef __MPI__
+! call mpi_allreduce(MPI_IN_PLACE,vg3(1,ng_2d),nr3x,mpi_double_complex,mpi_sum,communicator,ierr)
+!#endif
deallocate(vg2,vg2_in)
endif ! if( ng_2d > 0 )
@@ -537,9 +537,9 @@ SUBROUTINE esm_hartree (rhog, ehart, aux
#ifdef __PARA
call mp_sum( ehart, intra_pool_comm )
#endif
-#ifdef __MPI__
- call mpi_allreduce(MPI_IN_PLACE,ehart,1,mpi_double_precision,mpi_sum,communicator,ierr)
-#endif
+!#ifdef __MPI__
+! call mpi_allreduce(MPI_IN_PLACE,ehart,1,mpi_double_precision,mpi_sum,communicator,ierr)
+!#endif
! Map to FFT mesh (nrxx)
aux=0.0d0
@@ -594,7 +594,6 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
!
! here the local variables
!
- real(8), external :: qe_erfc, qe_erf
real(8) :: gp2, t(2), gp, sa, z1, z0, L
integer :: k1, k2, k3, ipol, it1, it2, ng_2d
real(8) :: tt, z, zp, kk1, kk2, g, cc1, cc2, arg1, arg2, t1, t2, ff, argmax, ew
@@ -640,7 +639,7 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
tt=upf_zp(it1)*upf_zp(it2)*2.0*pi/sa
- kk1=0.5d0*(-(z-zp)*qe_erf(g*(z-zp))-exp(-g**2*(z-zp)**2)/g/sqrt(pi))
+ kk1=0.5d0*(-(z-zp)*erf(g*(z-zp))-exp(-g**2*(z-zp)**2)/g/sqrt(pi))
if (esm_bc.eq.'bc1') then
kk2=0.d0
@@ -668,8 +667,8 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cc1=cc1+(t1+t2)/4.d0/gp
if (esm_bc.eq.'bc1') then
@@ -708,8 +707,8 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cc1=cc1+cos(ff)*(t1+t2)/4.d0/gp
if (esm_bc.eq.'bc1') then
@@ -791,8 +790,6 @@ subroutine esm_local_(nrx,aux,natm,ngaus
! here the local variables
!
complex(8),allocatable :: vloc3(:,:),vg2(:),vg2_in(:)
-! real(8), external :: qe_erf, qe_erfc
- real(8) :: qe_erf, qe_erfc
real(8) :: t(3),tt,gp,gp2,sa,z1,z0,pp,cc,ss,t1,t2, &
z,zp,arg11,arg12,arg21,arg22,v0,tmp,L,argmax, &
z_l,z_r
@@ -849,8 +846,8 @@ subroutine esm_local_(nrx,aux,natm,ngaus
arg21= gp*(z-zp)
arg21=min(arg21,argmax)
arg22= gp/2.d0/tmp+tmp*(z-zp)
- t1=exp(arg11)*qe_erfc(arg12)
- t2=exp(arg21)*qe_erfc(arg22)
+ t1=exp(arg11)*erfc(arg12)
+ t2=exp(arg21)*erfc(arg22)
cc1=cc1+bgauss(it,ig)*cs*(t1+t2)/4.d0/gp
enddo
if (esm_bc.eq.'bc1') then
@@ -909,7 +906,7 @@ subroutine esm_local_(nrx,aux,natm,ngaus
cc1=(0.d0,0.d0)
do ig=1,ngauss
tmp=sqrt(agauss(it,ig))
- cc1=cc1+bgauss(it,ig)*0.5d0*(-(z-zp)*qe_erf(tmp*(z-zp)) &
+ cc1=cc1+bgauss(it,ig)*0.5d0*(-(z-zp)*erf(tmp*(z-zp)) &
-exp(-tmp**2*(z-zp)**2)/tmp/sqrt(pi))
enddo
if (esm_bc.eq.'bc1') then
@@ -924,12 +921,12 @@ subroutine esm_local_(nrx,aux,natm,ngaus
! smoothing cell edge potential (avoiding unphysical oscillation)
do ig=1,ngauss
tmp=sqrt(agauss(it,ig))
- f1=f1+tt*bgauss(it,ig)*0.5d0*(-(z_r-zp)*qe_erf(tmp*(z_r-zp)) &
+ f1=f1+tt*bgauss(it,ig)*0.5d0*(-(z_r-zp)*erf(tmp*(z_r-zp)) &
-exp(-tmp**2*(z_r-zp)**2)/tmp/sqrt(pi))
- f2=f2+tt*bgauss(it,ig)*0.5d0*(-(z_l-zp)*qe_erf(tmp*(z_l-zp)) &
+ f2=f2+tt*bgauss(it,ig)*0.5d0*(-(z_l-zp)*erf(tmp*(z_l-zp)) &
-exp(-tmp**2*(z_l-zp)**2)/tmp/sqrt(pi))
- f3=f3-tt*bgauss(it,ig)*0.5d0*qe_erf(tmp*(z_r-zp))
- f4=f4-tt*bgauss(it,ig)*0.5d0*qe_erf(tmp*(z_l-zp))
+ f3=f3-tt*bgauss(it,ig)*0.5d0*erf(tmp*(z_r-zp))
+ f4=f4-tt*bgauss(it,ig)*0.5d0*erf(tmp*(z_l-zp))
enddo
if(esm_bc.eq.'bc1')then
f1=f1+tt*0.d0
@@ -1004,7 +1001,6 @@ subroutine esm_force_ew ( alpha, forceio
!
! here the local variables
!
- real(8), external :: qe_erfc, qe_erf
integer :: it1, it2, ipol, k1, k2, k3, ng_2d
integer :: nth, ith, omp_get_num_threads, omp_get_thread_num
real(8) :: t1_for, t2_for, z, zp, kk1_for, kk2_for, g, gp2, gp, z1, t(2), L
@@ -1052,7 +1048,7 @@ subroutine esm_force_ew ( alpha, forceio
endif
t2_for=upf_zp(it1)*upf_zp(it2)*fpi/sa
- kk1_for=0.5d0*qe_erf(g*(z-zp))
+ kk1_for=0.5d0*erf(g*(z-zp))
if (esm_bc.eq.'bc1') then
kk2_for=0.d0
else if (esm_bc.eq.'bc2') then
@@ -1078,8 +1074,8 @@ subroutine esm_force_ew ( alpha, forceio
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cz1_for=0.d0
if (esm_bc.eq.'bc1') then
cz2_for=0.d0
@@ -1119,8 +1115,8 @@ subroutine esm_force_ew ( alpha, forceio
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cx1_for=cx1_for+sin(ff)*(t1+t2)/4.d0/gp*k1
cy1_for=cy1_for+sin(ff)*(t1+t2)/4.d0/gp*k2
@@ -1175,8 +1171,8 @@ subroutine esm_force_ew ( alpha, forceio
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cx1_for=cx1_for+sin(ff)*(t1+t2)/4.d0/gp*k1
cy1_for=cy1_for+sin(ff)*(t1+t2)/4.d0/gp*k2
@@ -1276,7 +1272,6 @@ subroutine esm_force_lc_ (nrx, aux, natm
!
complex(8),allocatable :: vlocx(:), vlocy(:), vlocdz(:)
real(8),allocatable :: for(:,:),for_g(:,:)
- real(8), external :: qe_erf, qe_erfc
real(8) :: t(3),tt,gp,gp2,sa,z1,z0,pp,cc,ss,t1,t2,z,zp,L,forcelc2(3,nat)
real(8) :: arg11,arg12,arg21,arg22,tmp,r1,r2,fx1,fy1,fz1,fx2,fy2,fz2,argmax
integer :: iz,ig,it,ipol,k1,k2,k3,ng,n1,n2,n3,ng_2d
@@ -1357,8 +1352,8 @@ subroutine esm_force_lc_ (nrx, aux, natm
arg21= gp*(z-zp)
arg21=min(arg21,argmax)
arg22= gp/2.d0/tmp+tmp*(z-zp)
- t1=exp(arg11)*qe_erfc(arg12)
- t2=exp(arg21)*qe_erfc(arg22)
+ t1=exp(arg11)*erfc(arg12)
+ t2=exp(arg21)*erfc(arg22)
cx1=cx1+bgauss(it,ig)*CMPLX(ss, -cc, kind=8) &
*(t1+t2)/4.d0/gp*k1
cy1=cy1+bgauss(it,ig)*CMPLX(ss, -cc, kind=8) &
@@ -1440,7 +1435,7 @@ subroutine esm_force_lc_ (nrx, aux, natm
cc1=(0.d0,0.d0)
do ig=1,ngauss
tmp=sqrt(agauss(it,ig))
- cc1=cc1+bgauss(it,ig)*(0.5d0*qe_erf(tmp*(z-zp)))
+ cc1=cc1+bgauss(it,ig)*(0.5d0*erf(tmp*(z-zp)))
enddo
if (esm_bc.eq.'bc1') then
cc2=(0.d0,0.d0)
diff -uprN phase0_2015.01/src_phase/EsmPack/Makefile phase0_2015.01.01/src_phase/EsmPack/Makefile
--- phase0_2015.01/src_phase/EsmPack/Makefile 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/EsmPack/Makefile 2016-07-12 12:51:19.000000000 +0900
@@ -2,8 +2,8 @@
FFLAG = $(INCLUDE) $(OMPFLAG) $(MPIFLAG)
-OBJ = qe_erf.o fft.o vector.o Ewald.o Esm.o EsmInterface.o
-OBJ_P = qe_erf.o fft.o vector.o Ewald.o Esm.o EsmPack.o
+OBJ = fft.o vector.o Ewald.o Esm.o EsmInterface.o
+OBJ_P = fft.o vector.o Ewald.o Esm.o EsmPack.o
LIBFLAG = -L/usr/local/lib -lfftw3 -lblas -llapack
.f90.o:
diff -uprN phase0_2015.01/src_phase/EsmPack/qe_erf.f90 phase0_2015.01.01/src_phase/EsmPack/qe_erf.f90
--- phase0_2015.01/src_phase/EsmPack/qe_erf.f90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/EsmPack/qe_erf.f90 1970-01-01 09:00:00.000000000 +0900
@@ -1,35 +0,0 @@
-! Copyright (c) 2012, Minoru Otani <minoru.otani@aist.go.jp>
-!
-! Permission is hereby granted, free of charge, to any person
-! obtaining a copy of this software and associated documentation
-! files (the "Software"), to deal in the Software without restriction,
-! including without limitation the rights to use, copy, modify, merge,
-! publish, distribute, sublicense, and/or sell copies of the Software,
-! and to permit persons to whom the Software is furnished to do so,
-! subject to the following conditions:
-
-! The above copyright notice and this permission notice shall be
-! included in all copies or substantial portions of the Software.
-
-! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-! OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-! NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-! HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-! WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-! DEALINGS IN THE SOFTWARE.
-
-Function qe_erf(x)
- Implicit none
- Real(8), Intent(In) :: x
- Real(8) :: qe_erf
- qe_erf = erf(x)
-End Function qe_erf
-
-Function qe_erfc(x)
- Implicit none
- Real(8), Intent(In) :: x
- Real(8) :: qe_erfc
- qe_erfc = erfc(x)
-End Function qe_erfc
diff -uprN phase0_2015.01/src_phase/Finalization_of_mpi.F90 phase0_2015.01.01/src_phase/Finalization_of_mpi.F90
--- phase0_2015.01/src_phase/Finalization_of_mpi.F90 2015-09-14 15:16:30.000000000 +0900
+++ phase0_2015.01.01/src_phase/Finalization_of_mpi.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 449 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! SUBROUINE: Finalization_of_mpi
!
@@ -14,7 +14,7 @@
!
!=======================================================================
subroutine Finalization_of_mpi
-! $Id: Finalization_of_mpi.F90 449 2015-08-06 04:37:59Z jkoga $
+! $Id: Finalization_of_mpi.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Parallelization, only : m_Parallel_end_mpi
use m_PlaneWaveBasisSet, only : m_pwBS_dealloc_ngpt_igfp_gr &
& , m_pwBS_dealloc_ylm_l
@@ -30,7 +30,7 @@ subroutine Finalization_of_mpi
use m_PAW_ChargeDensity, only : m_PAWCD_dealloc
#endif
#ifdef _POSITRON_
- use m_epc_potential, only : m_epc_dealloc
+ use m_epc_potential, only : m_epc_dealloc, m_epc_dealloc_vlhxc_p
use m_Positron_Wave_Functions,only:m_pWF_deallocate_pzaj_etc
#endif
@@ -80,6 +80,7 @@ subroutine Finalization_of_mpi
#endif
#ifdef _POSITRON_
call m_epc_dealloc()
+ call m_epc_dealloc_vlhxc_p
call m_pWF_deallocate_pzaj_etc()
#endif
call m_ES_dealloc_Dhub()
diff -uprN phase0_2015.01/src_phase/Initial_Electronic_Structure.F90 phase0_2015.01.01/src_phase/Initial_Electronic_Structure.F90
--- phase0_2015.01/src_phase/Initial_Electronic_Structure.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Initial_Electronic_Structure.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 481 $)
!
! SUBROUINE: Initial_Electronic_Structure, Initial_WaveFunctions_ek
!
@@ -31,7 +31,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine Initial_Electronic_Structure
-! $Id: Initial_Electronic_Structure.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: Initial_Electronic_Structure.F90 481 2016-03-25 02:51:57Z jkoga $
use m_Const_Parameters, only : Gauss_distrib_func, from_wave_functions&
& , INITIAL, CONTINUATION, FIXED_CHARGE &
& , FIXED_CHARGE_CONTINUATION, ON, OFF, EXECUT &
@@ -53,7 +53,9 @@ subroutine Initial_Electronic_Structure
& , nfcntn_bin_paw &
& , file_existance_contfiles &
& , m_Files_check_nfzaj_existance, m_Files_check_nfchgt_existance &
- & , m_Files_check_file_existance
+ & , m_Files_check_file_existance &
+ & , m_Files_open_nfcntn_bin_paw,m_Files_close_nfcntn_bin_paw &
+ & , m_Files_nfcntn_bin_paw_exists
use m_Control_Parameters, only : ipri, iprichargedensity, initial_chg, icond, nspin, intzaj &
& , evaluation_eko_diff &
& , skip_alloc_phonon, sw_phonon, sw_calc_force, neg, neg_previous &
@@ -69,7 +71,7 @@ subroutine Initial_Electronic_Structure
use m_Kpoints, only : kv3
use m_PlaneWaveBasisSet, only : kg1, m_pwBS_alloc_ylm_l,kgp,ngabc
use m_PlaneWaveBasisSet, only : m_pwBS_sphrp_l
- use m_PseudoPotential, only : modnrm, m_PP_gfqwei, flg_paw, epc
+ use m_PseudoPotential, only : modnrm, m_PP_gfqwei, flg_paw, epc, m_PP_rd_PAW_parameters
use m_Total_Energy, only : m_TE_set_etotal_old
use m_Electronic_Structure,only: totch, m_ES_gtotch &
& , m_ES_energy_eigen_values_ext &
@@ -234,6 +236,11 @@ subroutine Initial_Electronic_Structure
! ================= 2014/09/19
+! ==== EXP_CELLOPT === 2015/09/24
+ use m_IterationNumbers, only : iteration_unit_cell
+ use m_Control_Parameters, only : sw_read_nfchgt_prev_cell, sw_read_nfzaj_prev_cell
+! ==================== 2015/09/24
+
implicit none
integer :: iloop
! <--
@@ -525,18 +532,24 @@ subroutine Initial_Electronic_Structure
call read_efermi()
if(icond==FIXED_CHARGE .and. ekmode == OFF) call copy_chgq_to_chgqo()
else
- call m_CD_initial_CD_by_Gauss_kt(nfout) ! (intchg) -> chgq_l
+ if (iteration_unit_cell > 1 .and. sw_read_nfchgt_prev_cell == ON ) then
+ call read_charge_density(condition=-4)
+ else
+ call m_CD_initial_CD_by_Gauss_kt(nfout) ! (intchg) -> chgq_l
+ endif
end if
!---- set wave functions ----
- if(intzaj == by_random_numbers) then
+ if ( iteration_unit_cell > 1 .and. sw_read_nfzaj_prev_cell == ON ) then
+ call read_zaj( condition =-4 )
+ else if(intzaj == by_random_numbers) then
call m_ESIW_by_randomnumbers(nfout,kv3,1,neg) ! (rndzaj) -> zaj_l
else if(intzaj == by_pseudo_atomic_orbitals) then
call m_ESIW_by_atomic_orbitals(nfout,kv3,1,neg) ! (paozaj) -> zaj_l
else if(intzaj == by_matrix_diagon) then
else if(intzaj == FILE) then
- call read_zaj()
+ call read_zaj( condition = 1 )
call m_ES_betar_dot_WFs(nfout) ! (fsrfsi)
if(initial_chg == FILE .or. (icond==FIXED_CHARGE.and.ekmode==OFF)) then
else
@@ -663,7 +676,8 @@ contains
use m_Charge_Density, only : m_CD_rd_chgq_noncl &
& , m_CD_rd_chgq_import_frm_collin &
& , m_CD_initCD_by_file_rsp_noncl &
- & , m_CD_adjust_spindensity_noncl
+ & , m_CD_adjust_spindensity_noncl &
+ & , m_CD_import_chgq_prev_cell
integer, intent(in) :: condition
integer :: ispin
integer :: iloop
@@ -703,8 +717,11 @@ contains
else
call m_CD_rd_chgq(nfout,nfchgt,F_CHGT_in_partitioned)
endif
- if ( flg_paw .and. read_charge_hardpart == YES ) then
+ if ( flg_paw .and. read_charge_hardpart == YES .and. m_Files_nfcntn_bin_paw_exists()) then
+ call m_Files_open_nfcntn_bin_paw()
+ call m_PP_rd_PAW_parameters(nfout,nfcntn_bin_paw)
call m_CD_rd_hsr(nfcntn_bin_paw)
+ call m_Files_close_nfcntn_bin_paw()
endif
end if
@@ -723,7 +740,24 @@ contains
!!$ if ( flg_paw .and. ) then
!!$ call m_CD_rd_hsr(nfcntn_bin_paw)
!!$ endif
+
+ else if(condition == -4) then ! coordinate-continuation
+!
+ call m_CD_import_chgq_prev_cell(nfout,nfchgt, F_CHGT_in_partitioned)
+ if ( flg_paw .and. read_charge_hardpart == YES .and. m_Files_nfcntn_bin_paw_exists()) then
+ call m_Files_open_nfcntn_bin_paw()
+ call m_PP_rd_PAW_parameters(nfout,nfcntn_bin_paw)
+ call m_CD_rd_hsr(nfcntn_bin_paw)
+ call m_Files_close_nfcntn_bin_paw()
+ endif
+
+ if ( noncol ) then
+ call m_CD_adjust_spindensity_noncl(nfout)
+ else
+ call m_CD_adjust_spindensity(nfout)
+ endif
end if
+
end subroutine read_charge_density
subroutine read_efermi()
@@ -769,8 +803,8 @@ contains
subroutine EXX()
use m_ES_ExactExchange, only : m_ES_EXX_gather_valence_states, m_ES_EXX_kernel &
- & , m_ES_EXX_occup, sw_rspace_hyb &
- & , m_ES_EXX_init0 &
+ & , m_ES_EXX_occup &
+ & , sw_rspace_hyb, m_ES_EXX_init0 &
#ifndef MEMORY_SAVE_EXX
& , m_ES_EXX_ylm, m_ES_EXX_crotylm
#else
@@ -802,14 +836,24 @@ contains
endif
end subroutine read_occ_mat
- subroutine read_zaj()
- use m_ES_IO, only : m_ESIO_rd_WFs_import_frm_collin
+ subroutine read_zaj( condition )
+ use m_ES_IO, only : m_ESIO_rd_WFs_import_frm_collin, &
+ & m_ESIO_import_WFs_prev_cell
+ integer, intent(in) :: condition
+
call m_Files_open_nfzaj()
- if ( noncol .and. import_collinear_wavefunctions == ON ) then
- call m_ESIO_rd_WFs_import_frm_collin( nfout,nfzaj,F_ZAJ_in_partitioned )
- else
- call m_ESIO_rd_WFs(nfout,nfzaj,F_ZAJ_in_partitioned)
+
+ if ( condition == 1 ) then
+ if ( noncol .and. import_collinear_wavefunctions == ON ) then
+ call m_ESIO_rd_WFs_import_frm_collin( nfout,nfzaj,F_ZAJ_in_partitioned )
+ else
+ call m_ESIO_rd_WFs(nfout,nfzaj,F_ZAJ_in_partitioned)
+ endif
+
+ else if ( condition == -4 ) then ! coordinate-continuation
+ call m_ESIO_import_WFs_prev_cell(nfout,nfzaj,F_ZAJ_in_partitioned)
endif
+
end subroutine read_zaj
subroutine check_neg()
diff -uprN phase0_2015.01/src_phase/Initialization.F90 phase0_2015.01.01/src_phase/Initialization.F90
--- phase0_2015.01/src_phase/Initialization.F90 2015-08-05 14:49:51.000000000 +0900
+++ phase0_2015.01.01/src_phase/Initialization.F90 2016-07-12 12:51:19.000000000 +0900
@@ -160,7 +160,7 @@ contains
subroutine aavers
include 'version.h' ! svn_revision
character(len=72) :: vers, system, codename
- write(vers,'("phase/0 2015.01 Revision:",i5," -- ORG_Parallel --")') svn_revision
+ write(vers,'("phase/0 2015.01.01 Revision:",i5," -- ORG_Parallel --")') svn_revision
codename = 'phaseUnif'
system = ''
diff -uprN phase0_2015.01/src_phase/InputData_Analysis.F90 phase0_2015.01.01/src_phase/InputData_Analysis.F90
--- phase0_2015.01/src_phase/InputData_Analysis.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/InputData_Analysis.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 475 $)
!
! SUBROUINE: cnstr_fcvect_work_alloc, cnstr_fcvect_work_dealloc,
! get_CS_and_ionic_system_data, read_ntyp_natm_natm2, read_altv,
@@ -34,7 +34,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine InputData_Analysis()
-! $Id: InputData_Analysis.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: InputData_Analysis.F90 475 2016-02-23 05:22:18Z jkoga $
use m_Files, only : nfinp, nfout, nfcntn, file_existance_contfiles, file_existance_3contfiles &
& , m_Files_open_nfcntn &
& , m_Files_check_file_names &
@@ -176,10 +176,6 @@ subroutine InputData_Analysis()
call m_Files_open_nfdynm_cif_initially()
if(first_call) call m_CtrlP_rd_accuracy(nfout)
call m_CS_rd_n(nfout)
-#ifndef _EMPIRICAL_
- call m_CtrlP_rd_wfsolver(nfout)
- call m_CtrlP_rd_chargemix(nfout)
-#endif
call m_CtrlP_rd_struc_evol(nfout)
call m_CtrlP_rd_postproc(nfout)
#ifndef _EMPIRICAL_
@@ -190,6 +186,11 @@ subroutine InputData_Analysis()
call m_IS_rd_n(nfout)
call m_IS_set_ionic_mass(nfout)
+#ifndef _EMPIRICAL_
+ call m_CtrlP_rd_wfsolver(nfout,natm)
+ call m_CtrlP_rd_chargemix(nfout)
+#endif
+
! === KT_add ==== 2014/12/29
#ifdef INIT_CHARGE_ATOM_BY_ATOM
call m_IS_set_ionic_charge_atoms(nfout)
@@ -589,7 +590,7 @@ contains
end subroutine InputData_Analysis
subroutine InputData_Analysis_neb()
-! $Id: InputData_Analysis.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: InputData_Analysis.F90 475 2016-02-23 05:22:18Z jkoga $
use m_Files, only : nfout, nfcntn &
& , m_Files_reopen_nfcntn
use m_Ionic_System, only : m_IS_rd_pos_and_v
diff -uprN phase0_2015.01/src_phase/Makefile phase0_2015.01.01/src_phase/Makefile
--- phase0_2015.01/src_phase/Makefile 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile 2016-07-12 12:52:45.000000000 +0900
@@ -0,0 +1,580 @@
+.SUFFIXES:
+.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+
+# Platform : GNU Linux (EM64T/AMD64)
+# Prog. model : MPI parallel
+# Compiler : Intel Fortran compiler
+# BLAS/LAPACK : System-installed MKL
+# FFT : System-installed FFTW3 library
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
+F90 = mpif90
+CC = gcc -m64
+CPP =
+AR = ar -vq
+LINK = mpif90
+F90FLAGS = -traceback
+F77FLAGS = -traceback
+CFLAGS = -O -DINTEL
+
+ESM = yes
+ifdef ESM
+CPPESM=-DENABLE_ESM_PACK
+LESM=-lesm
+else
+CPPESM=
+endif
+
+CPPFLAGS = -DLinux -DFFTW3 -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_POSITRON_ -D_FAST_WAY_ -D_USE_DATE_AND_TIME_ -DUSE_NONBLK_COMM -DRMM_NONLOCAL_NEW ${CPPESM}
+LFLAGS =
+F90FLAGS_FIXED = -extend_source -Fl -fixed
+F90FLAGS_FREE = -extend_source -Fl
+MKLHOME=
+INCLUDE=
+LIBS = -L./ ${LESM} -Wl,--start-group -lmkl_scalapack_lp64 -lmkl_blacs_intelmpi_lp64 -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -Bdynamic -lfftw3 -lpthread
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
+
+ifdef ESM
+ESM_LIB = libesm.a
+else
+ESM_LIB =
+endif
+LAPACK =
+FFTOBJECT =
+OBJ_INPUTPARSE = input_parse.o
+
+
+PHASE_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+PHASE_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_ES_occup.o \
+m_ES_RSB.o \
+m_FiniteElectricField.o \
+m_ES_ExactExchange.o \
+m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
+m_CD_Mag_Moment.o \
+m_epc_potential.o \
+m_Positron_Wave_Functions.o \
+m_ES_WF_mixing.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_WF_by_MatDiagon.o m_ES_dos.o m_Hubbard.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_vdWDF.o \
+m_Ldos.o m_XC_Potential.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_OP_Moment.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o \
+m_UnitCell.o \
+m_constraints.o \
+m_ELF.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o \
+m_Wannier.o m_Wannier90.o m_Replica.o Renewal_of_ChgCtrlParam.o \
+m_LinearResponse_Control.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_Excitation.o \
+m_ES_occup_EPS.o m_Epsilon_ek.o \
+m_LinearResponse_Qpt.o \
+m_rttddft.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+PHASE_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+PHASE_F_OTHERSUBS = mdmain0.o constraint_main.o meta_dynamics.o NEB.o Preparation_for_mpi.o \
+Preparation_for_ESM.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o\
+input_interface.o Initialization.o \
+WriteDownData_onto_Files.o Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o \
+Renewal_of_WaveFunctions.o \
+Renewal_of_pWaveFunctions.o \
+IterationNumbers_Setting.o ChargeDensity_Construction.o \
+ChargeDensity_Mixing.o Renewal_of_Potential.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Renewal_of_pPotential.o Renewal_of_Hubbard_Parameters.o \
+Convergence_Check.o Forces.o \
+Move_Ions.o Initial_MD_Condition.o \
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o miscellaneous.o\
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+Initialization_Epsilon.o Shift_Kpoint.o \
+Reset_Kpoint.o Preparation_for_Calc_Epsilon.o \
+Transition_moment_Epsilon.o Calc_Epsilon.o \
+Nonlinear_Optics_Epsilon.o WriteDownData_onto_Files_Epsilon.o \
+PseudoPotential_ek_Epsilon.o Dealloc_Radr_and_Wos_Epsilon.o \
+mpi_dummy.o WriteDownData_onto_Files_ek.o \
+GaussLeg.o lib_int_deri_add.o \
+rttddft_main.o \
+Potential_Construction.o Potential_Mixing.o ThomasFermiWeiz.o \
+Epsilon_postscf.o vdW.o
+
+# for vc_nl
+NLOBJ = vc_nl.o
+
+ifndef SX_DGEMM
+PHASE_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o \
+gncpp_xc_gga_rad.o \
+decfft_ent.o \
+spg+tetra.o
+else
+PHASE_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+spg+tetra.o \
+dgemm__.o
+endif
+
+EKCAL_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+EKCAL_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_RSB.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_epc_potential.o \
+m_Positron_Wave_Functions.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
+m_CD_Mag_Moment.o \
+m_ES_WF_mixing.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_WF_by_MatDiagon.o m_ES_dos.o m_Hubbard.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_vdWDF.o \
+m_Ldos.o m_XC_Potential.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_constraints.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o\
+m_UnitCell.o \
+m_ELF.o m_Wannier.o \
+m_Wannier90.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o \
+m_LinearResponse_Control.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_Excitation.o \
+m_LinearResponse_Qpt.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+
+EKCAL_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+EKCAL_F_OTHERSUBS = ekmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o\
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+vdW.o
+
+ifndef SX_DGEMM
+EKCAL_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+gncpp_xc_gga_rad.o \
+decfft_ent.o
+else
+EKCAL_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+EPS_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+EPS_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_Positron_Wave_Functions.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_RSB.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_dos.o m_Hubbard.o \
+m_epc_potential.o \
+m_vdWDF.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
+m_CD_Mag_Moment.o \
+m_ES_WF_mixing.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o m_ES_WF_by_MatDiagon.o \
+m_UnitCell.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_Ldos.o m_ELF.o \
+m_constraints.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_Wannier.o m_Wannier90.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_Excitation.o \
+m_ES_occup_EPS.o m_Epsilon_ek.o \
+m_LinearResponse_Control.o \
+m_LinearResponse_Qpt.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+EPS_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+EPS_F_OTHERSUBS = epsmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o\
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+Initialization_Epsilon.o Shift_Kpoint.o \
+Reset_Kpoint.o Preparation_for_Calc_Epsilon.o \
+Transition_moment_Epsilon.o Calc_Epsilon.o \
+Nonlinear_Optics_Epsilon.o WriteDownData_onto_Files_Epsilon.o \
+PseudoPotential_ek_Epsilon.o Dealloc_Radr_and_Wos_Epsilon.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+vdW.o
+
+ifndef SX_DGEMM
+EPS_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o
+else
+EPS_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+TDLR_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+TDLR_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_Positron_Wave_Functions.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_RSB.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_dos.o m_Hubbard.o \
+m_epc_potential.o \
+m_vdWDF.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
+m_CD_Mag_Moment.o \
+m_ES_WF_mixing.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o m_ES_WF_by_MatDiagon.o \
+m_UnitCell.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_Ldos.o m_ELF.o \
+m_constraints.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
+m_Wannier.o m_Wannier90.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_Excitation.o \
+m_ES_occup_EPS.o \
+m_LinearResponse_Control.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_LinearResponse_Qpt.o \
+m_LinearResponse_Tools.o m_LinearResponse_Density.o \
+m_LinearResponse_NonInt.o m_LinearResponse_ALDA.o \
+m_LinearResponse_Kernel.o m_LinearResponse_BS.o \
+m_LinearResponse_Spectrum.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+TDLR_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+TDLR_F_OTHERSUBS = tdlrmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o \
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+PseudoPotential_ek_Epsilon.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+b_LinearResponse_Kernel.o b_LinearResponse_exc.o \
+LinearResponse_Proc.o LinearResponse_Spec.o \
+vdW.o
+
+ifndef SX_DGEMM
+TDLR_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o
+else
+TDLR_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+
+PHASE_OBJECTS = $(FFTOBJECT) $(PHASE_LOWER_MODULES) $(PHASE_UPPER_MODULES) $(PHASE_F_SUBROUTINES) $(PHASE_F_OTHERSUBS) $(PHASE_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+EKCAL_OBJECTS = $(FFTOBJECT) $(EKCAL_LOWER_MODULES) $(EKCAL_UPPER_MODULES) $(EKCAL_F_SUBROUTINES) $(EKCAL_F_OTHERSUBS) $(EKCAL_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+EPS_OBJECTS = $(FFTOBJECT) $(EPS_LOWER_MODULES) $(EPS_UPPER_MODULES) $(EPS_F_SUBROUTINES) $(EPS_F_OTHERSUBS) $(EPS_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+TDLR_OBJECTS = $(FFTOBJECT) $(TDLR_LOWER_MODULES) $(TDLR_UPPER_MODULES) $(TDLR_F_SUBROUTINES) $(TDLR_F_OTHERSUBS) $(TDLR_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+all : phase ekcal epsmain tdlrmain
+
+ifdef ESM
+phase : $(ESM_LIB) $(LAPACK) $(PHASE_OBJECTS) $(NLOBJ)
+ $(LINK) $(PHASE_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+else
+phase : $(LAPACK) $(PHASE_OBJECTS) $(NLOBJ)
+ $(LINK) $(PHASE_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+endif
+
+ekcal : $(LAPACK) $(EKCAL_OBJECTS) $(NLOBJ)
+ $(LINK) $(EKCAL_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+epsmain : $(LAPACK) $(EPS_OBJECTS) $(NLOBJ)
+ $(LINK) $(EPS_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+tdlrmain : $(LAPACK) $(TDLR_OBJECTS) $(NLOBJ)
+ $(LINK) $(TDLR_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+ifdef NO_MPI
+libesm.a:
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="" AR="$(AR)"
+else
+libesm.a:
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
+endif
+
+liblapack.a:
+ cd LAPACK; make F77="$(F90)" F77FLAGS="$(F77FLAGS)" AR="$(AR)"
+
+libblas.a:
+ cd BLAS; make F77="$(F90)" F77FLAGS="$(F77FLAGS)" AR="$(AR)"
+
+$(OBJ_INPUTPARSE):$(@:.o=.c) $(@:.o=.h)
+ $(CC) -c $(CFLAGS) $(@:.o=.c)
+
+.f.o:
+ $(F90) -c $(F77FLAGS) $*.f
+
+.f90.o:
+ $(F90) -c $(F90FLAGS) $*.f90
+
+.F.o:
+ $(F90) -c $(F77FLAGS) $(CPPFLAGS) $*.F
+
+.F90.o:
+ $(F90) -c $(F90FLAGS) $(CPPFLAGS) $*.F90
+
+clean:
+ \rm -f *.o *.mod *.a *.lib *.L *.list phase ekcal epsmain tdlrmain
+ \cd LAPACK; make clean
+ \cd BLAS; make clean
+ \cd EsmPack; make clean
+
+install: phase ekcal epsmain tdlrmain
+ \mv -f phase ../bin/
+ \mv -f ekcal ../bin/
+ \mv -f epsmain ../bin/
+ \mv -f tdlrmain ../bin/
diff -uprN phase0_2015.01/src_phase/Makefile.K phase0_2015.01.01/src_phase/Makefile.K
--- phase0_2015.01/src_phase/Makefile.K 2015-10-18 02:56:57.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.K 2016-07-28 03:57:30.708737196 +0900
@@ -1,6 +1,9 @@
.SUFFIXES:
.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
F90 = mpifrtpx
CC = fccpx
CPP =
@@ -10,7 +13,7 @@ F90FLAGS = -Nsetvalue -Kfast,parallel,op
F77FLAGS = -Nsetvalue -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 -c -V -Qa,d,i,p,t,x -Koptmsg=2
CFLAGS = -DINTEL -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2
-ESM=YES
+ESM = yes
ifdef ESM
CPPESM=-DENABLE_ESM_PACK
LESM=-lesm
@@ -18,15 +21,15 @@ else
CPPESM=
endif
-INCLUDE=-I/home/apps/fftw/3.3/include
-
CPPFLAGS = -DLinux -DFFTW3 -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_POSITRON_ -D_FAST_WAY_ -D_USE_DATE_AND_TIME_ -DUSE_NONBLK_COMM -DRMM_NONLOCAL_NEW -D_USE_SCALAPACK_ -DMULT_PHASE_RSPACE ${CPPESM}
-LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
-LIBS = -L./ ${LESM} -Kopenmp -lm -SSL2MPI -SSL2BLAMP -SCALAPACK \
+LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
+INCLUDE=-I/home/apps/fftw/3.3/include
+LIBS = -L./ ${LESM} -Kopenmp -lm -SSL2MPI -SSL2BLAMP -SCALAPACK \
-L/home/apps/fftw/3.3/lib64 -lfftw3 -lfftw3_omp -lfftw3_mpi $(KLINK) $(EIGEN_LIBS) #/opt/FJSVtclang/GM-1.2.0-13/lib64/libtofupa.o
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
+
ifdef ESM
ESM_LIB = libesm.a
else
@@ -34,9 +37,9 @@ ESM_LIB =
endif
LAPACK =
FFTOBJECT =
-
OBJ_INPUTPARSE = input_parse.o
+
PHASE_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
m_IterationNumbers.o
@@ -57,7 +60,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -181,7 +184,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -294,7 +297,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -312,7 +315,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -409,7 +411,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -427,7 +429,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
@@ -501,6 +503,7 @@ dgemm__.o
endif
+
PHASE_OBJECTS = $(FFTOBJECT) $(PHASE_LOWER_MODULES) $(PHASE_UPPER_MODULES) $(PHASE_F_SUBROUTINES) $(PHASE_F_OTHERSUBS) $(PHASE_OBJECTSF77) $(OBJ_INPUTPARSE)
EKCAL_OBJECTS = $(FFTOBJECT) $(EKCAL_LOWER_MODULES) $(EKCAL_UPPER_MODULES) $(EKCAL_F_SUBROUTINES) $(EKCAL_F_OTHERSUBS) $(EKCAL_OBJECTSF77) $(OBJ_INPUTPARSE)
diff -uprN phase0_2015.01/src_phase/Makefile.frtpx phase0_2015.01.01/src_phase/Makefile.frtpx
--- phase0_2015.01/src_phase/Makefile.frtpx 2015-10-18 02:57:27.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.frtpx 2016-07-28 03:57:43.681118981 +0900
@@ -1,6 +1,9 @@
.SUFFIXES:
.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
F90 = mpifrtpx
CC = fccpx
CPP =
@@ -10,7 +13,7 @@ F90FLAGS = -Nsetvalue -Kfast,parallel,op
F77FLAGS = -Nsetvalue -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 -c -V -Qa,d,i,p,t,x -Koptmsg=2
CFLAGS = -DINTEL -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2
-ESM=YES
+ESM = yes
ifdef ESM
CPPESM=-DENABLE_ESM_PACK
LESM=-lesm
@@ -18,14 +21,14 @@ else
CPPESM=
endif
-INCLUDE=-I/usr/local/fftw/3.3/include
-
CPPFLAGS = -DLinux -DFFTW3 -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_POSITRON_ -D_FAST_WAY_ -D_USE_DATE_AND_TIME_ -DUSE_NONBLK_COMM -DRMM_NONLOCAL_NEW -D_USE_SCALAPACK_ -DMULT_PHASE_RSPACE ${CPPESM}
-LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
-LIBS = -L./ ${LESM} -Kopenmp -SSL2BLAMP -SCALAPACK -L/usr/local/fftw/3.3/lib64 -lfftw3 -lfftw3_omp -lfftw3_mpi $(KLINK) #ScaLAPACK+FFTW3.3
+LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
+INCLUDE=-I/usr/local/fftw/3.3/include
+LIBS = -L./ ${LESM} -Kopenmp -SSL2BLAMP -SCALAPACK -L/usr/local/fftw/3.3/lib64 -lfftw3 -lfftw3_omp -lfftw3_mpi $(KLINK) #ScaLAPACK+FFTW3.3
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
+
ifdef ESM
ESM_LIB = libesm.a
else
@@ -33,9 +36,9 @@ ESM_LIB =
endif
LAPACK =
FFTOBJECT =
-
OBJ_INPUTPARSE = input_parse.o
+
PHASE_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
m_IterationNumbers.o
@@ -56,7 +59,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -180,7 +183,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -293,7 +296,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -311,7 +314,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -408,7 +410,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -426,7 +428,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
@@ -500,6 +502,7 @@ dgemm__.o
endif
+
PHASE_OBJECTS = $(FFTOBJECT) $(PHASE_LOWER_MODULES) $(PHASE_UPPER_MODULES) $(PHASE_F_SUBROUTINES) $(PHASE_F_OTHERSUBS) $(PHASE_OBJECTSF77) $(OBJ_INPUTPARSE)
EKCAL_OBJECTS = $(FFTOBJECT) $(EKCAL_LOWER_MODULES) $(EKCAL_UPPER_MODULES) $(EKCAL_F_SUBROUTINES) $(EKCAL_F_OTHERSUBS) $(EKCAL_OBJECTSF77) $(OBJ_INPUTPARSE)
diff -uprN phase0_2015.01/src_phase/Makefile.gfortran+lapack+fftw+mpi phase0_2015.01.01/src_phase/Makefile.gfortran+lapack+fftw+mpi
--- phase0_2015.01/src_phase/Makefile.gfortran+lapack+fftw+mpi 2015-10-18 03:12:59.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.gfortran+lapack+fftw+mpi 2016-07-28 02:33:49.911020145 +0900
@@ -66,7 +66,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -190,7 +190,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -303,7 +303,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -321,7 +321,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -418,7 +417,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -436,7 +435,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Makefile.gfortran.seq phase0_2015.01.01/src_phase/Makefile.gfortran.seq
--- phase0_2015.01/src_phase/Makefile.gfortran.seq 2015-10-18 04:20:08.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.gfortran.seq 2016-07-28 03:15:55.879420869 +0900
@@ -28,7 +28,6 @@ endif
NO_MPI=YES
CPPFLAGS = -DLinux -D_GNU_FORTRAN_ -DJRCATFFT_WS -DCD_JRCATFFT_WS -D_NO_MPI_ -DDISABLE_VDWDF -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_POSITRON_ -D_FAST_WAY_ -D_USE_DATE_AND_TIME_ -DUSE_NONBLK_COMM -DRMM_NONLOCAL_NEW ${CPPESM}
LFLAGS =
-INCLUDE=-I
LIBS = -L./ -llapack -lblas
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
@@ -64,7 +63,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -188,7 +187,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -301,7 +300,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -319,7 +318,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -416,7 +414,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -434,7 +432,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Makefile.ifort+mkl phase0_2015.01.01/src_phase/Makefile.ifort+mkl
--- phase0_2015.01/src_phase/Makefile.ifort+mkl 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.ifort+mkl 2016-07-12 12:51:19.000000000 +0900
@@ -0,0 +1,579 @@
+.SUFFIXES:
+.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+
+# Platform : GNU Linux (EM64T/AMD64)
+# Prog. model : Serial
+# Compiler : Intel Fortran compiler
+# BLAS/LAPACK : Intel Math Kernel Library (MKL)
+# FFT : Intel MKL with FFTW3 interface
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
+F90 = ifort
+CC = gcc -m64
+CPP =
+AR = ar -vq
+LINK = ifort
+F90FLAGS = -traceback -I./no_mpi/include
+F77FLAGS = -traceback -I./no_mpi/include
+CFLAGS = -O -DINTEL
+
+ESM = yes
+ifdef ESM
+CPPESM=-DENABLE_ESM_PACK
+LESM=-lesm
+else
+CPPESM=
+endif
+NO_MPI=YES
+CPPFLAGS = -DLinux -DFFTW3 -D_NO_MPI_ -D_NO_ARG_DUMMY_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_POSITRON_ -D_FAST_WAY_ -D_USE_DATE_AND_TIME_ -DUSE_NONBLK_COMM -DRMM_NONLOCAL_NEW ${CPPESM}
+LFLAGS =
+F90FLAGS_FIXED = -extend_source -Fl -fixed
+F90FLAGS_FREE = -extend_source -Fl
+MKLHOME=/opt/intel/mkl/lib/intel64
+INCLUDE=-I/opt/intel/mkl/lib/intel64/../../include/fftw
+LIBS = -L./ ${LESM} -L/opt/intel/mkl/lib/intel64 -Wl,--start-group ${MKLHOME}/libmkl_scalapack_lp64.a ${MKLHOME}/libmkl_blacs_intelmpi_lp64.a ${MKLHOME}/libmkl_intel_lp64.a ${MKLHOME}/libmkl_sequential.a ${MKLHOME}/libmkl_core.a -Wl,--end-group -Bdynamic -lpthread
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
+
+ifdef ESM
+ESM_LIB = libesm.a
+else
+ESM_LIB =
+endif
+LAPACK =
+FFTOBJECT =
+OBJ_INPUTPARSE = input_parse.o
+
+
+PHASE_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+PHASE_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_ES_occup.o \
+m_ES_RSB.o \
+m_FiniteElectricField.o \
+m_ES_ExactExchange.o \
+m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
+m_CD_Mag_Moment.o \
+m_epc_potential.o \
+m_Positron_Wave_Functions.o \
+m_ES_WF_mixing.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_WF_by_MatDiagon.o m_ES_dos.o m_Hubbard.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_vdWDF.o \
+m_Ldos.o m_XC_Potential.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_OP_Moment.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o \
+m_UnitCell.o \
+m_constraints.o \
+m_ELF.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o \
+m_Wannier.o m_Wannier90.o m_Replica.o Renewal_of_ChgCtrlParam.o \
+m_LinearResponse_Control.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_Excitation.o \
+m_ES_occup_EPS.o m_Epsilon_ek.o \
+m_LinearResponse_Qpt.o \
+m_rttddft.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+PHASE_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+PHASE_F_OTHERSUBS = mdmain0.o constraint_main.o meta_dynamics.o NEB.o Preparation_for_mpi.o \
+Preparation_for_ESM.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o\
+input_interface.o Initialization.o \
+WriteDownData_onto_Files.o Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o \
+Renewal_of_WaveFunctions.o \
+Renewal_of_pWaveFunctions.o \
+IterationNumbers_Setting.o ChargeDensity_Construction.o \
+ChargeDensity_Mixing.o Renewal_of_Potential.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Renewal_of_pPotential.o Renewal_of_Hubbard_Parameters.o \
+Convergence_Check.o Forces.o \
+Move_Ions.o Initial_MD_Condition.o \
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o miscellaneous.o\
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+Initialization_Epsilon.o Shift_Kpoint.o \
+Reset_Kpoint.o Preparation_for_Calc_Epsilon.o \
+Transition_moment_Epsilon.o Calc_Epsilon.o \
+Nonlinear_Optics_Epsilon.o WriteDownData_onto_Files_Epsilon.o \
+PseudoPotential_ek_Epsilon.o Dealloc_Radr_and_Wos_Epsilon.o \
+mpi_dummy.o WriteDownData_onto_Files_ek.o \
+GaussLeg.o lib_int_deri_add.o \
+rttddft_main.o \
+Potential_Construction.o Potential_Mixing.o ThomasFermiWeiz.o \
+Epsilon_postscf.o vdW.o
+
+# for vc_nl
+NLOBJ = vc_nl.o
+
+ifndef SX_DGEMM
+PHASE_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o \
+gncpp_xc_gga_rad.o \
+decfft_ent.o \
+spg+tetra.o
+else
+PHASE_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+spg+tetra.o \
+dgemm__.o
+endif
+
+EKCAL_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+EKCAL_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_RSB.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_epc_potential.o \
+m_Positron_Wave_Functions.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
+m_CD_Mag_Moment.o \
+m_ES_WF_mixing.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_WF_by_MatDiagon.o m_ES_dos.o m_Hubbard.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_vdWDF.o \
+m_Ldos.o m_XC_Potential.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_constraints.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o\
+m_UnitCell.o \
+m_ELF.o m_Wannier.o \
+m_Wannier90.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o \
+m_LinearResponse_Control.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_Excitation.o \
+m_LinearResponse_Qpt.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+
+EKCAL_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+EKCAL_F_OTHERSUBS = ekmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o\
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+vdW.o
+
+ifndef SX_DGEMM
+EKCAL_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+gncpp_xc_gga_rad.o \
+decfft_ent.o
+else
+EKCAL_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+EPS_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+EPS_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_Positron_Wave_Functions.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_RSB.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_dos.o m_Hubbard.o \
+m_epc_potential.o \
+m_vdWDF.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
+m_CD_Mag_Moment.o \
+m_ES_WF_mixing.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o m_ES_WF_by_MatDiagon.o \
+m_UnitCell.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_Ldos.o m_ELF.o \
+m_constraints.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_Wannier.o m_Wannier90.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_Excitation.o \
+m_ES_occup_EPS.o m_Epsilon_ek.o \
+m_LinearResponse_Control.o \
+m_LinearResponse_Qpt.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+EPS_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+EPS_F_OTHERSUBS = epsmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o\
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+Initialization_Epsilon.o Shift_Kpoint.o \
+Reset_Kpoint.o Preparation_for_Calc_Epsilon.o \
+Transition_moment_Epsilon.o Calc_Epsilon.o \
+Nonlinear_Optics_Epsilon.o WriteDownData_onto_Files_Epsilon.o \
+PseudoPotential_ek_Epsilon.o Dealloc_Radr_and_Wos_Epsilon.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+vdW.o
+
+ifndef SX_DGEMM
+EPS_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o
+else
+EPS_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+TDLR_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+TDLR_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_Positron_Wave_Functions.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_RSB.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_dos.o m_Hubbard.o \
+m_epc_potential.o \
+m_vdWDF.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
+m_CD_Mag_Moment.o \
+m_ES_WF_mixing.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o m_ES_WF_by_MatDiagon.o \
+m_UnitCell.o \
+m_KineticEnergy_Density.o \
+m_KE_mixing.o \
+m_Ldos.o m_ELF.o \
+m_constraints.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_Excitation.o \
+m_ES_occup_EPS.o \
+m_LinearResponse_Control.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_LinearResponse_Qpt.o \
+m_LinearResponse_Tools.o m_LinearResponse_Density.o \
+m_LinearResponse_NonInt.o m_LinearResponse_ALDA.o \
+m_LinearResponse_Kernel.o m_LinearResponse_BS.o \
+m_LinearResponse_Spectrum.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o \
+m_SpinOrbit_ForceTheorem.o
+
+TDLR_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+TDLR_F_OTHERSUBS = tdlrmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+UnitaryTransform_WF.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o \
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+PseudoPotential_ek_Epsilon.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+b_LinearResponse_Kernel.o b_LinearResponse_exc.o \
+LinearResponse_Proc.o LinearResponse_Spec.o \
+vdW.o
+
+ifndef SX_DGEMM
+TDLR_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o
+else
+TDLR_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+
+PHASE_OBJECTS = $(FFTOBJECT) $(PHASE_LOWER_MODULES) $(PHASE_UPPER_MODULES) $(PHASE_F_SUBROUTINES) $(PHASE_F_OTHERSUBS) $(PHASE_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+EKCAL_OBJECTS = $(FFTOBJECT) $(EKCAL_LOWER_MODULES) $(EKCAL_UPPER_MODULES) $(EKCAL_F_SUBROUTINES) $(EKCAL_F_OTHERSUBS) $(EKCAL_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+EPS_OBJECTS = $(FFTOBJECT) $(EPS_LOWER_MODULES) $(EPS_UPPER_MODULES) $(EPS_F_SUBROUTINES) $(EPS_F_OTHERSUBS) $(EPS_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+TDLR_OBJECTS = $(FFTOBJECT) $(TDLR_LOWER_MODULES) $(TDLR_UPPER_MODULES) $(TDLR_F_SUBROUTINES) $(TDLR_F_OTHERSUBS) $(TDLR_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+all : phase ekcal epsmain tdlrmain
+
+ifdef ESM
+phase : $(ESM_LIB) $(LAPACK) $(PHASE_OBJECTS) $(NLOBJ)
+ $(LINK) $(PHASE_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+else
+phase : $(LAPACK) $(PHASE_OBJECTS) $(NLOBJ)
+ $(LINK) $(PHASE_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+endif
+
+ekcal : $(LAPACK) $(EKCAL_OBJECTS) $(NLOBJ)
+ $(LINK) $(EKCAL_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+epsmain : $(LAPACK) $(EPS_OBJECTS) $(NLOBJ)
+ $(LINK) $(EPS_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+tdlrmain : $(LAPACK) $(TDLR_OBJECTS) $(NLOBJ)
+ $(LINK) $(TDLR_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+ifdef NO_MPI
+libesm.a:
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="" AR="$(AR)"
+else
+libesm.a:
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
+endif
+
+liblapack.a:
+ cd LAPACK; make F77="$(F90)" F77FLAGS="$(F77FLAGS)" AR="$(AR)"
+
+libblas.a:
+ cd BLAS; make F77="$(F90)" F77FLAGS="$(F77FLAGS)" AR="$(AR)"
+
+$(OBJ_INPUTPARSE):$(@:.o=.c) $(@:.o=.h)
+ $(CC) -c $(CFLAGS) $(@:.o=.c)
+
+.f.o:
+ $(F90) -c $(F77FLAGS) $*.f
+
+.f90.o:
+ $(F90) -c $(F90FLAGS) $*.f90
+
+.F.o:
+ $(F90) -c $(F77FLAGS) $(CPPFLAGS) $*.F
+
+.F90.o:
+ $(F90) -c $(F90FLAGS) $(CPPFLAGS) $*.F90
+
+clean:
+ \rm -f *.o *.mod *.a *.lib *.L *.list phase ekcal epsmain tdlrmain
+ \cd LAPACK; make clean
+ \cd BLAS; make clean
+ \cd EsmPack; make clean
+
+install: phase ekcal epsmain tdlrmain
+ \mv -f phase ../bin/
+ \mv -f ekcal ../bin/
+ \mv -f epsmain ../bin/
+ \mv -f tdlrmain ../bin/
diff -uprN phase0_2015.01/src_phase/Makefile.ifort+mpi phase0_2015.01.01/src_phase/Makefile.ifort+mpi
--- phase0_2015.01/src_phase/Makefile.ifort+mpi 2015-10-18 13:05:00.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.ifort+mpi 2016-07-28 01:44:48.646331806 +0900
@@ -72,7 +72,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -196,7 +196,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -309,7 +309,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -327,7 +327,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -424,7 +423,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -442,7 +441,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Makefile.ifort+omp phase0_2015.01.01/src_phase/Makefile.ifort+omp
--- phase0_2015.01/src_phase/Makefile.ifort+omp 2015-10-18 13:34:57.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.ifort+omp 2016-07-28 02:02:00.574829082 +0900
@@ -72,7 +72,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -196,7 +196,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -309,7 +309,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -327,7 +327,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -424,7 +423,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -442,7 +441,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Makefile.ifort.seq phase0_2015.01.01/src_phase/Makefile.ifort.seq
--- phase0_2015.01/src_phase/Makefile.ifort.seq 2015-10-18 13:06:47.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.ifort.seq 2016-07-28 02:05:06.200309150 +0900
@@ -72,7 +72,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -196,7 +196,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -309,7 +309,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -327,7 +327,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -424,7 +423,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -442,7 +441,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Makefile.mpiifort+mkl phase0_2015.01.01/src_phase/Makefile.mpiifort+mkl
--- phase0_2015.01/src_phase/Makefile.mpiifort+mkl 2015-08-05 16:29:15.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.mpiifort+mkl 2016-07-12 12:51:19.000000000 +0900
@@ -67,7 +67,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -191,7 +191,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -304,7 +304,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -322,7 +322,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -419,7 +418,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -437,7 +436,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Makefile.tmpl phase0_2015.01.01/src_phase/Makefile.tmpl
--- phase0_2015.01/src_phase/Makefile.tmpl 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Makefile.tmpl 2016-07-12 12:51:19.000000000 +0900
@@ -19,7 +19,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -143,7 +143,7 @@ m_ES_RSB.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
@@ -256,7 +256,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -274,7 +274,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -371,7 +370,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
m_ES_WF_mixing.o \
string.o m_db.o \
@@ -389,7 +388,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase/Move_Ions.F90 phase0_2015.01.01/src_phase/Move_Ions.F90
--- phase0_2015.01/src_phase/Move_Ions.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Move_Ions.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 482 $)
!
! SUBROUINE: Move_Ions, wd_cps_and_forces
!
@@ -33,11 +33,11 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine Move_Ions
-! $Id: Move_Ions.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Move_Ions.F90 482 2016-04-08 08:40:45Z jkoga $
use m_Control_Parameters, only : iprimd, c_iteration2GDIIS &
& , m_CtrlP_what_is_mdalg &
& , m_CtrlP_set_gdiisoptmode &
- & , sw_charge_predictor,sw_wf_predictor,sw_rspace
+ & , sw_charge_predictor,sw_wf_predictor,sw_rspace,af
use m_Const_Parameters, only : DP, TEMPERATURE_CONTROL, VERLET &
&, BLUEMOON, QUENCHED_CONSTRAINT, QUENCHED_MD, NORMAL_MODE_ANALYSIS &
&, HYPERPLANE_ADAPTIVE_COORDINATE, HAC, T_CONTROL, GDIIS, ORDINA &
@@ -50,7 +50,8 @@ subroutine Move_Ions
& , m_IS_cp_cps2cpo,m_IS_wd_pos_and_v &
& , m_IS_phonon_force, m_IS_cg, m_IS_cg2 &
& , m_IS_evaluate_v_verlet &
- & , m_IS_update_cps_history
+ & , m_IS_update_cps_history &
+ & , m_IS_force_af_symmetry
!!$ & , forcmx_constraint_quench, almda, mdmode &
use m_Force, only : forc_l, forcmx
use m_IterationNumbers, only : iteration_ionic,iteration
@@ -150,6 +151,8 @@ subroutine Move_Ions
endif
! ============================================================== 13.0B
+ if (af/=0) call m_IS_force_af_symmetry(nfout)
+
if(iprimd >= 2) call m_IS_wd_forc(forc_l)
if(sw_rspace==ON)then
diff -uprN phase0_2015.01/src_phase/NEB.F90 phase0_2015.01.01/src_phase/NEB.F90
--- phase0_2015.01/src_phase/NEB.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/NEB.F90 2016-07-12 12:51:19.000000000 +0900
@@ -106,6 +106,9 @@ subroutine do_neb()
if (.not.pp_generated) then
call PseudoPotential_Construction
pp_generated = .true.
+#ifdef ENABLE_ESM_PACK
+ call Preparation_for_ESM()
+#endif
else
if ( flg_paw ) then
if ( itr > 1 .or. neb%cond%condition == 1 ) then
diff -uprN phase0_2015.01/src_phase/Postprocessing.F90 phase0_2015.01.01/src_phase/Postprocessing.F90
--- phase0_2015.01/src_phase/Postprocessing.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Postprocessing.F90 2016-07-12 12:51:19.000000000 +0900
@@ -50,7 +50,7 @@
!
!$$#ifndef PARA3D
subroutine Postprocessing(ignore_convergence)
-! $Id: Postprocessing.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Postprocessing.F90 489 2016-05-24 04:15:54Z ktagami $
use m_Const_Parameters, only : DP, ON, OFF, FORCE_CONVERGED, INITIAL, CONTINUATION &
& , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION &
& , Gauss_distrib_func, EK, SCF &
@@ -86,7 +86,7 @@ subroutine Postprocessing(ignore_converg
use m_Ionic_System, only : natm, natm2, ityp, iwei, iatomn, pos &
& , m_IS_pack_all_ions_in_uc &
& , m_IS_set_natm_prim,m_IS_set_napt_prim
- use m_PseudoPotential, only : ival
+ use m_PseudoPotential, only : ival, flg_paw
use m_Files, only : nfout,nfdos,nfchr,nfwfk,nfldos,nfelf &
& , nfvlc, nfcntn_bin_stm &
& , m_Files_open_nfdos, m_Files_open_nfchr &
@@ -165,7 +165,8 @@ subroutine Postprocessing(ignore_converg
use m_Wannier90, only : m_Wan90_gen_amat, m_Wan90_gen_mmat, m_Wan90_wd_eig, &
& m_Wan90_write_unk, &
& m_Wan90_gen_mmat_mpi, &
- & m_Wan90_wd_eig_mpi, m_Wan90_write_unk_mpi
+ & m_Wan90_wd_eig_mpi, m_Wan90_write_unk_mpi, &
+ & m_Wan90_gen_mat_spn
!!$ use m_Files, only : m_Files_open_nfdos, m_Files_close_nfdos
@@ -241,9 +242,10 @@ subroutine Postprocessing(ignore_converg
! ============== 13.2S
use m_Control_Parameters, only : sw_wf_squared_rspace, charge_filetype, &
- & sw_wf_integ_moment
+ & sw_wf_integ_moment, sw_calc_contact_density
use m_ES_IO, only : m_ESIO_wd_Wfn_squared_noncl, &
& m_ESIO_wd_Wfn_integ_magmom
+ use m_PAW_ChargeDensity, only : m_PAWCD_calc_contact_density
implicit none
@@ -312,7 +314,6 @@ subroutine Postprocessing(ignore_converg
end if
end if
-! ============== KT_add ====================== 13.0E
if ( m_CtrlP_way_of_smearing() == Fermi_Dirac ) then
if ( ekmode == ON ) then
call m_ESoc_count_charge_belowEF_ek( nfout )
@@ -320,7 +321,6 @@ subroutine Postprocessing(ignore_converg
call m_ESoc_count_charge_belowEF( nfout )
endif
endif
-! ============================================ 13.0E
! -------- Population ----
! ==== KT_add ===== 2014/09/01
@@ -333,34 +333,19 @@ subroutine Postprocessing(ignore_converg
! ================ 2014/09/01
if(sw_orb_popu == ON) then
-! ========================== Modified by K. Tagami ========= 0.4 and 0.6
-! call m_ES_phir_dot_WFs(nfout)
-! call m_ES_sym_comp(nfout)
-! call m_ES_orbital_population(nfout)
-!
if ( ekmode == OFF .and. sw_calc_force == OFF ) then
call m_ES_phir_dot_WFs(nfout)
call m_ES_sym_comp(nfout)
-! ================== modified by K. Tagami ===================== 11.0
-! call m_ES_orbital_population(nfout)
-!
if ( noncol ) then
call m_ES_orbital_population_noncl( nfout )
else
call m_ES_orbital_population(nfout)
endif
-! ============================================================== 11.0
-
endif
-! =============================================================
+
end if
! --------- DOS ------
-!
-! ================================ modified by K. Tagami ============ 11.0
-!! if(sw_dos == ON) call calc_totaldos()
- ! contained in this file, calculate total dos
-!
if (sw_dos == ON) then
if ( noncol ) then
call m_ESdos_alloc_dos_wght_noncl()
@@ -371,18 +356,15 @@ subroutine Postprocessing(ignore_converg
call calc_totaldos()
endif
end if
-! =================================================================== 11.0
! ---- LDOS ----------
!
if(sw_ldos == ON) then
-! =================== added by K. Tagami =============== 11.0
if ( noncol ) then
call calc_localdos_noncl()
else
call calc_localdos()
endif
-! ======================================================= 11.0
end if
! ------ Charge Distrib ----
@@ -470,10 +452,8 @@ subroutine Postprocessing(ignore_converg
!
if (sw_fine_STM_simulation == ON) then
if ( noncol ) then
-!!$ call write_potential_for_STM
call write_potential_for_STM_noncl
else
-!!$ call write_potential_for_STM_noncl
call write_potential_for_STM
endif
endif
@@ -488,13 +468,15 @@ subroutine Postprocessing(ignore_converg
end if
! =============================== added by K. Tagami ============= 11.0
- if ( noncol ) goto 650
+ if ( noncol ) goto 620
! ================================================================ 11.0
if (sw_wannier == ON) then
call m_Wan_opt_Omega(nfout)
end if
+620 continue
+
if (sw_wannier90 == ON) then
call m_Wan90_gen_amat(nfout)
#ifndef USE_MPI_WANNIER90
@@ -505,6 +487,7 @@ subroutine Postprocessing(ignore_converg
call m_Wan90_gen_mmat_mpi(nfout)
call m_Wan90_wd_eig_mpi(nfout)
if ( sw_write_unk_file == ON ) call m_Wan90_write_unk_mpi(nfout)
+ if ( noncol ) call m_Wan90_gen_mat_spn
#endif
end if
@@ -607,6 +590,10 @@ subroutine Postprocessing(ignore_converg
call m_ESIO_wd_Wfn_integ_magmom
endif
endif
+ if ( sw_calc_contact_density == ON ) then
+ if ( flg_paw ) call m_PAWCD_calc_contact_density
+ endif
+
call tstatc_wd0()
@@ -717,7 +704,6 @@ contains
!!$ call m_Files_close_nfdos()
end subroutine calc_totaldos
-! =============================== added by K. Tagami ===================== 11.0
subroutine calc_totaldos_noncl()
if(.not.check_if_metalic_flag.or.ignore_convergence) call m_ESoc_check_if_metalic(nfout)
@@ -762,9 +748,7 @@ contains
end if
end subroutine calc_totaldos_noncl
-! ========================================================================= 11.0
-! ===================== added by K. Tagami ====================== 11.0
subroutine calc_localdos()
if (ekmode == OFF) then
@@ -915,9 +899,7 @@ contains
call m_Ldos_dealloc_weiwsc_etc()
end subroutine calc_localdos_noncl
-! ============================================================== 11.0
-! ========================= added by K. Tagami =============== 11.0
subroutine calc_spatial_chg_distrib
integer :: iloop, iloop2
@@ -1134,9 +1116,8 @@ contains
end if
end subroutine calc_partial_charge_noncl
-! ============================================================ 11.0
-! ============================ added by K. Tagami ================= 11.0
+
subroutine write_potential_for_STM
integer :: ismax
@@ -1223,14 +1204,9 @@ contains
end subroutine write_potential_for_STM_noncl
-! ================================================================= 11.0
-!================================== modified by K. Tagami ========== 11.0
-! subroutine wd_fine_STM_parameters()
-!
subroutine wd_fine_STM_parameters( ismax )
integer, intent(in) :: ismax
-! ================================================================= 11.0
integer :: ik
write(nfout,'(" !!STM: kg(kng) = ",i8)') kg
@@ -1273,12 +1249,8 @@ contains
end do
end subroutine check_neordr_nrvf_ordr
-! ====================================== modified by K. Tagami ========== 11.0
-! subroutine wd_ArraySize_Parameters_For_STM(nf_bin)
-!
subroutine wd_ArraySize_Parameters_For_STM( nf_bin, ismax )
integer, intent(in) :: ismax
-! ======================================================================== 11.0
integer, intent(in) :: nf_bin
if(mype == 0) then
@@ -1370,9 +1342,15 @@ subroutine Postprocessing_k
use m_Electronic_Structure, only : m_ES_cp_eko_l_to_eko_ek2
! ============== 13.2S
- use m_Control_Parameters, only : sw_wf_squared_rspace, sw_wf_integ_moment
+ use m_Control_Parameters, only : sw_wf_squared_rspace, sw_wf_integ_moment, &
+ & sw_orb_popu, &
+ & sw_print_wf_orb_projection
use m_Files, only : nfout
- use m_ES_IO, only : m_ESIO_wd_Wfn_squared_noncl, m_ESIO_wd_Wfn_integ_magmom
+ use m_ES_IO, only : m_ESIO_wd_Wfn_squared_noncl, m_ESIO_wd_Wfn_integ_magmom, &
+ & m_ESIO_wd_WFn_orb_proj
+ use m_ES_nonlocal, only : m_ES_phir_dot_WFs
+ use m_Nonlocal_Potential, only : m_NLP_phir_dot_PWs
+ use m_Kpoints, only : kv3, vkxyz
implicit none
@@ -1380,15 +1358,12 @@ subroutine Postprocessing_k
if(nk_in_the_process == 1) call m_Ldos_wd_natm2_and_totch()
call m_Ldos_alloc_weiwsc_etc()
-! ========================== modified by K. Tagami =================== 11.0
-! call m_Ldos_cal()
-!
if ( noncol ) then
call m_Ldos_cal_noncl()
else
call m_Ldos_cal()
endif
-! =================================================================== 11.0
+
call m_Ldos_dealloc_weiwsc_etc()
end if
! === KT_add === 13.2S
@@ -1405,5 +1380,10 @@ subroutine Postprocessing_k
if ( sw_wf_integ_moment == ON ) call m_ESIO_wd_Wfn_integ_magmom
endif
+ if ( sw_orb_popu == ON .and. sw_print_wf_orb_projection == ON ) then
+ call m_ES_phir_dot_WFs( nfout )
+ call m_ESIO_wd_WFn_orb_proj
+ endif
+
!$$#endif
end subroutine Postprocessing_k
diff -uprN phase0_2015.01/src_phase/Preparation.F90 phase0_2015.01.01/src_phase/Preparation.F90
--- phase0_2015.01/src_phase/Preparation.F90 2015-09-14 15:16:57.000000000 +0900
+++ phase0_2015.01.01/src_phase/Preparation.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 458 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 474 $)
!
! SUBROUINE: fft_box_finding_way, Preparation, Preparation_ek
!
@@ -36,8 +36,17 @@
#define _INCLUDE_EXX_
#endif
+#ifdef FJ_TIMER
+# define __TIMER_FJ_START_w_BARRIER(str,a) call mpi_barrier(str,ierr) ; call timer_sta(a)
+# define __TIMER_FJ_START(a) call timer_sta(a)
+# define __TIMER_FJ_STOP(a) call timer_end(a)
+#else
+# define __TIMER_FJ_START(a)
+# define __TIMER_FJ_STOP(a)
+#endif
+
subroutine Preparation()
-! $Id: Preparation.F90 458 2015-09-09 06:05:42Z ktagami $
+! $Id: Preparation.F90 474 2016-02-09 09:32:53Z yamasaki $
use m_Const_Parameters, only:DP,FILE,GENERAL,OUTER,INNER,SIMPLE_CUBIC &
& ,HEXAGONAL,TETRAHEDRON &
& ,INITIAL,CONTINUATION,FIXED_CHARGE &
@@ -204,6 +213,10 @@ subroutine Preparation()
use m_ES_WF_by_MatDiagon, only : m_ESmat_set_reduced_basis_mode
+! ==== EXP_CELLOPT === 2015/09/24
+ use m_PlaneWaveBasisSet, only : m_pwBS_store_prev_kg1_kgp
+! ==================== 2015/09/24
+
implicit none
integer :: outer_or_inner
include 'mpif.h'
@@ -240,6 +253,7 @@ subroutine Preparation()
call m_CD_force_dealloc()
call m_ESrmm_dealloc_r_norm_flag()
call m_ESsubmat_dealloc()
+ call m_pwBS_store_prev_kg1_kgp
endif
call m_IS_gdiis_reset()
call m_IS_CG_reset()
@@ -312,15 +326,10 @@ subroutine Preparation()
if(symmetry_method == AUTOMATIC) then
call m_CS_SG_auto_gnrt_sym_op(.true.,nfout) ! -(m_CS_SpaceGroup) -> nopr,af
else
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(31)
-#endif
+ __TIMER_FJ_START(31)
call m_CS_gnrt_symmetry_operations(.true.,nfout) ! -(m_Crystal_Structure) -> nopr,af
!!$ call m_CS_gnrt_symm_operators_tl(.true.,nfout) ! -(m_Crystal_Structure) -> nopr,af
-#ifdef FJ_TIMER
- call timer_end(31)
-#endif
+ __TIMER_FJ_STOP(31)
end if
call m_CS_alloc_op_tau(nfout)
call m_CS_alloc_op_tau_tl(nfout)
@@ -328,15 +337,10 @@ subroutine Preparation()
call m_CS_SG_auto_gnrt_sym_op(paramset,nfout) ! paramset == .false.
call m_IS_symmetrize_atom_pos(nfout) ! -> cps,pos
else
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(31)
-#endif
+ __TIMER_FJ_START(31)
call m_CS_gnrt_symmetry_operations(paramset,nfout) ! paramset == .false.
call m_CS_gnrt_symm_operators_tl(paramset,nfout) ! -(m_Crystal_Structure) -> nopr,af
-#ifdef FJ_TIMER
- call timer_end(31)
-#endif
+ __TIMER_FJ_STOP(31)
end if
call m_CS_SG_print_space_group_name(nfout)
@@ -365,15 +369,10 @@ subroutine Preparation()
call m_IS_inv_sym_off(nfout) ! -> inversion_symmetry
end if
call m_IS_alloc_napt()
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(31)
-#endif
+ __TIMER_FJ_START(31)
call m_CS_wd_op_and_tau(nfout)
call m_IS_symm_check_of_pos()
-#ifdef FJ_TIMER
- call timer_end(31)
-#endif
+ __TIMER_FJ_STOP(31)
if(ekmode /= GRID .and. sw_phonon == ON) then
call m_Phonon_alloc_qvec()
@@ -464,37 +463,22 @@ subroutine Preparation()
if(icond == PREPARATION_ONLY .or. icond == INITIAL .or. icond == CONTINUATION .or. &
& icond==COORDINATE_CONTINUATION) then
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=paramset) ! -> kg1, nbase,iba (when paramset==.false.)
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
else if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) then
!!$ if(ekmode == OFF)&
!!$ & stop ' ! combination of ekmode and icond is illegal (Preparation)'
call m_Files_close_files_initial0()
call m_Files_open_nfeng(icond)
if(ekmode == OFF .and. fixed_charge_k_parallel == ALL_AT_ONCE) then
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=paramset) ! -> kg1, nbase,iba (when paramset==.false.)
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
else
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=.true.) ! -> kg1, iba
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
call m_Kp_alloc_kpoints_ek() ! -> kv3_ek (=kv3), allocate(vkxyz_ek,qwgt_ek)
call m_Kp_cp_vkxyz_to_vkxyz_ek()
if(fixed_charge_k_parallel == ONE_BY_ONE) then
@@ -509,14 +493,9 @@ subroutine Preparation()
call m_pwBS_cp_iba_to_iba_ek()
if(icond == FIXED_CHARGE_CONTINUATION) &
& call m_ES_cp_iconv(numk_tmp,iconv_ek_tmp)
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=.false.) ! -> kg1, iba
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
end if
else
stop ' icond is illegal (Preparation)'
@@ -532,6 +511,9 @@ subroutine Preparation()
call m_pwBS_exxCD()
endif
! ========== ======================================= 13.0F
+ if(ipri>=1) write(nfout,'(" _INCLUDE_EXX_ is defined")')
+#else
+ if(ipri>=1) write(nfout,'(" _INCLUDE_EXX_ is not defined")')
#endif
if(sw_ldos == ON) then
diff -uprN phase0_2015.01/src_phase/Preparation_for_ESM.F90 phase0_2015.01.01/src_phase/Preparation_for_ESM.F90
--- phase0_2015.01/src_phase/Preparation_for_ESM.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Preparation_for_ESM.F90 2016-07-12 12:51:19.000000000 +0900
@@ -9,7 +9,7 @@ subroutine Preparation_for_ESM()
use m_FFT, only : fft_box_size_CD
use m_Crystal_Structure, only : altv
use m_Parallelization, only : npes,mype, ista_kngp, iend_kngp, mpi_comm_group
- use m_PlaneWaveBasisSet, only : ngabc,igfp_l
+ use m_PlaneWaveBasisSet, only : ngabc,igfp_l,kgp
implicit none
include 'mpif.h'
@@ -32,25 +32,29 @@ subroutine Preparation_for_ESM()
do i=1,natm
ival_at(i) = ival(ityp(i))
enddo
- allocate(ngabc_esm(3,1:iend_kngp-ista_kngp+1));ngabc_esm=0
+! allocate(ngabc_esm(3,1:iend_kngp-ista_kngp+1));ngabc_esm=0
+ allocate(ngabc_esm(3,1:kgp));ngabc_esm=0
do i=1,3
do j=ista_kngp,iend_kngp
- ngabc_esm(i,j-ista_kngp+1) = ngabc(j,i)
+ ngabc_esm(i,j) = ngabc(j,i)
enddo
enddo
+ call mpi_allreduce(mpi_in_place,ngabc_esm,3*kgp,mpi_integer,mpi_sum,mpi_comm_group,ierr)
allocate(cps_tmp(3,natm))
do i=1,3
do j=1,natm
cps_tmp(i,j) = cps(j,i)
enddo
enddo
- allocate(igfp_l_esm(1:iend_kngp-ista_kngp+1));igfp_l_esm=0
+ allocate(igfp_l_esm(1:kgp));igfp_l_esm=0
do i=ista_kngp,iend_kngp
- igfp_l_esm(i-ista_kngp+1) = igfp_l(i)
+ igfp_l_esm(i) = igfp_l(i)
enddo
+ call mpi_allreduce(mpi_in_place,igfp_l_esm,kgp,mpi_integer,mpi_sum,mpi_comm_group,ierr)
+
call Esm_interface_map_parameters(natm,ival_at,cps_tmp,1.0d0,altv, &
& fft_box_size_CD(1,0),fft_box_size_CD(2,0),fft_box_size_CD(3,0), &
- & esm_bc_c,.false.,iend_kngp-ista_kngp+1,nspin,ngabc_esm, &
+ & esm_bc_c,.false.,kgp,nspin,ngabc_esm, &
& igfp_l_esm,igfp_l_esm,esm_w,2.0d0*esm_e_field, esm_izwall, &
& esm_z_wall, esm_bar_height,esm_bar_width)
call Esm_interface_set_communicator(mpi_comm_group)
diff -uprN phase0_2015.01/src_phase/PseudoPotential_Construction.F90 phase0_2015.01.01/src_phase/PseudoPotential_Construction.F90
--- phase0_2015.01/src_phase/PseudoPotential_Construction.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/PseudoPotential_Construction.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 483 $)
!
! SUBROUINE: check_gncpp_type, PP_construction_paramset
! PseudoPotential_Construction, PseudoPotential_ek
@@ -38,7 +38,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine PseudoPotential_Construction
-! $Id: PseudoPotential_Construction.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: PseudoPotential_Construction.F90 483 2016-04-27 04:02:48Z ktagami $
use m_PseudoPotential, only : m_PP_alloc0_ps_ntyp, m_PP_alloc_ps_ntyp &
& , m_PP_dealloc_ps_ntyp &
& , m_PP_set_mmesh, m_PP_set_nloc &
@@ -89,7 +89,7 @@ subroutine PseudoPotential_Construction
& , sw_wannier, sw_berry_phase, corecharge_cntnbin, sw_fef &
& , ekmode, fixed_charge_k_parallel, continuation_using_ppdata &
& , m_CtrlP_set_ppprinted,sw_rspace, sw_rspace_hyb, sw_hybrid_functional &
- & , sw_ldos, sw_rspace_ldos, m_CtrlP_rspace_integ_all_OK
+ & , sw_ldos, sw_rspace_ldos, m_CtrlP_rspace_integ_all_OK,nmax_G_hyb
use m_PlaneWaveBasisSet, only : kgp,gr_l,ngshell,ngshell_range
use m_Const_Parameters, only : OLD,ON, SPHERICAL_HARMONICS, NO
use m_Files, only : m_Files_open_ps_files,m_Files_close_ps_files,nfcntn_bin &
@@ -360,26 +360,26 @@ subroutine PseudoPotential_Construction
& .and. ekmode==ON ) then
! =================13.0S
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl
-! ==========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl
+#endif
if(sw_orb_popu == ON) then
call m_PP_make_qorb(nfout)
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_phir_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> phig
-! ===========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_phir_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> phig
+#endif
call m_PP_cnstrct_crotylm(nfout) !-> crotylm
end if
if(sw_use_add_proj == ON) then
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_add_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl_add
-! ===========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_add_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl_add
+#endif
end if
if(intzaj == by_pseudo_atomic_orbitals) then
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_paor_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> paog
-! ===========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_paor_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> paog
+#endif
end if
if(num_projectors > 0) then
diff -uprN phase0_2015.01/src_phase/Renewal_of_ChgCtrlParam.f90 phase0_2015.01.01/src_phase/Renewal_of_ChgCtrlParam.f90
--- phase0_2015.01/src_phase/Renewal_of_ChgCtrlParam.f90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Renewal_of_ChgCtrlParam.f90 2016-07-12 12:51:19.000000000 +0900
@@ -10,7 +10,8 @@ subroutine Renewal_of_Chg_Ctrl_Param
use m_Const_Parameters, only : MSD, CG, SD, LMSD, LMCG,lmeazyCG, lmmsd
use m_Control_Parameters, only : m_CtrlP_solver_for_WFs_now, intzaj
- use m_IterationNumbers, only : iteration, iteration_ionic, iteration_electronic
+ use m_IterationNumbers, only : iteration, iteration_ionic, iteration_electronic, &
+ & iteration_unit_cell
use m_Control_Parameters, only : sw_update_charge_hsr, eval_energy_before_charge
use m_Control_Parameters, only : sw_recomposing, sw_force_simple_mixing
@@ -41,7 +42,10 @@ subroutine Renewal_of_Chg_Ctrl_Param
& nmax_intermid_lambda, &
& edelta_change_lambda_first, &
& edelta_change_lambda_last, &
- & max_iterations_mag_constraint
+ & max_iter_elec_mag_constraint, &
+ & max_iter_ion_mag_constraint, &
+ & max_iter_cell_mag_constraint, &
+ & sw_fix_charge_after_constraint
! ================= KT_add =================== 13.0XX
use m_Control_Parameters, only : sw_calc_ekin_density, &
@@ -59,17 +63,19 @@ subroutine Renewal_of_Chg_Ctrl_Param
& edelta_start_wf_mixing
! =========================== 13.0U3
+ use m_Parallelization, only : mype
+
implicit none
real(kind=DP) :: edeltab_per_atom, edeltb_per_atom, edelta
-! ----------------------- UUU
- if ( sw_monitor_atomcharge == ON ) then
- if ( iteration_ionic >1 .and. iteration_electronic ==1 ) then
- call m_CD_set_rad_cov_default
- call m_CD_set_rad_cov_now
- endif
- endif
+! -----------------------
+! if ( sw_monitor_atomcharge == ON ) then
+! if ( iteration_ionic >1 .and. iteration_electronic ==1 ) then
+! call m_CD_set_rad_cov_default
+! call m_CD_set_rad_cov_now
+! endif
+! endif
! ------------------
edelta = m_TE_what_is_edeltb_now()
@@ -290,25 +296,50 @@ contains
logical, save :: First = .true.
logical, save :: mag_constraint_is_over = .false.
logical, save :: lambda_is_changed
- real(kind=DP), save :: lambda_org, lambda_old
+ integer, save :: sw_fix_charge_after_constr_org
+
+ real(kind=DP), save :: lambda_org, lambda_old, lambda_00
integer :: i, nn
real(kind=DP) :: c1, ratio
+ if ( First ) then
+ lambda_org = mag_constraint_lambda;
+ lambda_old = mag_constraint_lambda
+ sw_fix_charge_after_constr_org = sw_fix_charge_after_constraint
+ istep = 1
+ First = .false.
+ else
+! if ( iteration_unit_cell > 1 .and. iteration_ionic == 1 &
+! & .and. iteration_electronic == 1 ) then
+! mag_constraint_is_over = .false.
+! mag_constraint_lambda = lambda_org
+!! istep = 1; count = 0
+! endif
+ if ( iteration_electronic == 1 ) then
+ mag_constraint_is_over = .false.
+ mag_constraint_lambda = lambda_org
+ sw_fix_charge_after_constraint = sw_fix_charge_after_constr_org
+ istep = 1; count = 0
+ endif
+ endif
+
if ( damping_method_mag_constraint == 0 ) return
- if ( mag_constraint_is_over ) return
- if ( iteration_ionic > 1 ) then
+ if ( iteration_ionic > max_iter_ion_mag_constraint ) then
+ mag_constraint_is_over = .true.
+ mag_constraint_lambda = 0.0d0;
+ endif
+ if ( iteration_unit_cell > max_iter_cell_mag_constraint ) then
mag_constraint_is_over = .true.
mag_constraint_lambda = 0.0d0;
- return
endif
- if ( First ) then
- lambda_org = mag_constraint_lambda;
- lambda_old = mag_constraint_lambda
- istep = 1
- First = .false.
+ if ( mag_constraint_is_over ) then
+ if ( sw_fix_charge_after_constraint == ON ) then
+ sw_update_charge_total = OFF
+ endif
+ return
endif
lambda_is_changed = .false.
@@ -346,17 +377,28 @@ contains
endif
case (ABRUPT)
- if ( iteration_electronic > max_iterations_mag_constraint ) then
+ if ( iteration_electronic > max_iter_elec_mag_constraint ) then
mag_constraint_lambda = 0.0d0
lambda_is_changed = .true.
mag_constraint_is_over = .true.
endif
+ c1 = abs( edeltab_per_atom )
+
+ if ( c1 < edelta_change_lambda_last ) then
+ count = count + 1
+ if ( count == succession ) then
+ mag_constraint_lambda = 0.0d0
+ mag_constraint_is_over = .true.
+ lambda_is_changed = .true.
+ endif
+ endif
+
case (LINEAR)
- ratio = dble( iteration_electronic ) / dble(max_iterations_mag_constraint)
+ ratio = dble( iteration_electronic ) / dble(max_iter_elec_mag_constraint)
ratio = 1.0D0 -ratio
- if ( iteration_electronic <= max_iterations_mag_constraint ) then
+ if ( iteration_electronic <= max_iter_elec_mag_constraint ) then
mag_constraint_lambda = lambda_org *ratio
lambda_is_changed = .true.
else
@@ -364,6 +406,14 @@ contains
mag_constraint_is_over = .true.
endif
+ c1 = abs( edeltab_per_atom )
+ if ( c1 < edelta_change_lambda_first ) then
+ count = count + 1
+ if ( count == succession ) then
+ mag_constraint_is_over = .true.
+ lambda_is_changed = .true.
+ endif
+ endif
end select
if ( lambda_is_changed ) then
@@ -373,7 +423,7 @@ contains
endif
lambda_old = mag_constraint_lambda
-
+!
end subroutine update_lambda_mag_constraint
! === KT_add === 13.0U3
diff -uprN phase0_2015.01/src_phase/Renewal_of_pPotential.f90 phase0_2015.01.01/src_phase/Renewal_of_pPotential.f90
--- phase0_2015.01/src_phase/Renewal_of_pPotential.f90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Renewal_of_pPotential.f90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! SUBROUINE: Renewal_of_pPotential
!
@@ -23,17 +23,28 @@
! Science and Technology (MEXT) of Japan.
!
subroutine Renewal_of_pPotential()
-! $Id: Renewal_of_pPotential.f90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Renewal_of_pPotential.f90 472 2015-11-28 09:01:17Z ktagami $
use m_Files, only : nfout
- use m_ES_Intgr_VlhxcQlm, only : m_ESiVQ_integrate_VlhxcQlm
+!! use m_ES_Intgr_VlhxcQlm, only : m_ESiVQ_integrate_VlhxcQlm
use m_Charge_Density, only : chgq_l
- use m_epc_potential, only : m_epc_alloc, m_epc_cal_potential,m_epc_ESlhxc_potential,vepc_l
+ use m_epc_potential, only : m_epc_alloc, m_epc_cal_potential, &
+ & m_epc_ESlhxc_potential, vepc_l, &
+ & m_epc_ESlhxc_potential_mod
+ use m_Control_Parameters, only : positron_method
+ use m_Const_Parameters, only : Positron_CONV
+
implicit none
call m_epc_alloc()
call m_epc_cal_potential(nfout,chgq_l) ! chgq_l -> vepc_l, tchgq_l
! (xcfft) -> vxc_l
- call m_epc_ESlhxc_potential(nfout) ! vepc_l, tchgq_l -> vlhxc_l
- call m_ESiVQ_integrate_VlhxcQlm(nfout) ! (lclchh) -> vlhxcQ
+
+ if ( positron_method == Positron_CONV ) then
+ call m_epc_ESlhxc_potential(nfout) ! vepc_l, tchgq_l -> vlhxc_l
+ else
+ call m_epc_ESlhxc_potential_mod(nfout)
+ endif
+
+!! call m_ESiVQ_integrate_VlhxcQlm(nfout) ! (lclchh) -> vlhxcQ
end subroutine Renewal_of_pPotential
diff -uprN phase0_2015.01/src_phase/Renewal_of_pWaveFunctions.F90 phase0_2015.01.01/src_phase/Renewal_of_pWaveFunctions.F90
--- phase0_2015.01/src_phase/Renewal_of_pWaveFunctions.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/Renewal_of_pWaveFunctions.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! SUBROUINE: Renewal_of_pWaveFunctions
!
@@ -25,7 +25,7 @@
! Science and Technology (MEXT) of Japan.
!
subroutine Renewal_of_pWaveFunctions()
-! $Id: Renewal_of_pWaveFunctions.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Renewal_of_pWaveFunctions.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Const_Parameters, only : ON, OFF, DP, ORTHONORMALIZATION &
& , CG, SD, MSD, SUBMAT, MATRIXDIAGON, lmMSD, lmSD, lmCG
use m_IterationNumbers, only : iteration, iteration_positron_wf
@@ -43,6 +43,14 @@ subroutine Renewal_of_pWaveFunctions()
& , m_pWF_wd_pzaj &
& , m_pWF_submat &
& , m_pWF_evolve_wfs_again
+
+! === POSITRON SCF ===
+ use m_Const_Parameters, only : Positron_CONV, Positron_GGGC, BAND_Energy, TOTAL_Energy
+ use m_Control_Parameters, only : positron_method
+ use m_Total_Energy, only : m_TE_tell_total_energy
+ use m_Positron_Wave_Functions, only : pchg_l, pchgo_l
+! =====
+
implicit none
integer :: isolver, precon, sw_submat
real(kind=DP) :: dtim
@@ -79,6 +87,8 @@ subroutine Renewal_of_pWaveFunctions()
#endif
end if
+ pchgo_l = pchg_l
+
contains
subroutine Renew_pWF_by_lmSDorlmCG(isolver,precon,dtim)
integer, intent(in) :: isolver,precon
@@ -88,13 +98,27 @@ contains
real(kind=DP) :: dtim_new = 0.d0, dtim_msdv
integer :: isolver_core, mode, what_is_the_pcore_solver
+ integer :: energy_evaluation_lmm
+
+ if ( positron_method == Positron_CONV ) then
+ energy_evaluation_lmm = BAND_ENERGY
+ else if ( positron_method == Positron_GGGC ) then
+ energy_evaluation_lmm = TOTAL_ENERGY
+ energy_evaluation_lmm = BAND_ENERGY
+ endif
+
isolver_core = what_is_the_pcore_solver(isolver) ! -(in this file)
mode = ORTHONORMALIZATION
call m_pWF_copy_pzaj_to_pzaj_old()
- etotal(1) = m_pWF_tell_band_energy()
+ if ( energy_evaluation_lmm == TOTAL_ENERGY ) then
+ etotal(1) = m_TE_tell_total_energy()
+ else if ( energy_evaluation_lmm == BAND_ENERGY ) then
+ etotal(1) = m_pWF_tell_band_energy()
+ endif
+
if(ipripositron >= 2) write(nfout,'(" !! etotal(1) = ",f10.6)') etotal(1)
dtim_msdv = m_CtrlP_dtim_1Dsearch_now(dtim)
if(ipripositron >= 2) write(nfout,'(" !! dtim_msdv = ",f8.4)') dtim_msdv
@@ -108,13 +132,23 @@ contains
! ~~~~~~~~~~~~~~~~~~~~~~~~~
!!$ end if
- etotal(2) = m_pWF_tell_band_energy()
+ if ( energy_evaluation_lmm == TOTAL_ENERGY ) then
+ etotal(2) = m_TE_tell_total_energy()
+ else if(energy_evaluation_lmm == BAND_ENERGY) then
+ etotal(2) = m_pWF_tell_band_energy()
+ endif
+
if(ipripositron >= 2) write(nfout,'(" !! etotal(2) = ",f10.6)') etotal(2)
!!$ if(isolver_core == CG .or. isolver_core == eazyCG) mode = NORMALIZATION
call m_pWF_evolve_WFs_again(nfout,mode,dtim_msdv,factor*dtim_msdv)
- etotal(3) = m_pWF_tell_band_energy()
+ if ( energy_evaluation_lmm == TOTAL_ENERGY ) then
+ etotal(3) = m_TE_tell_total_energy()
+ else if(energy_evaluation_lmm == BAND_ENERGY) then
+ etotal(3) = m_pWF_tell_band_energy()
+ endif
+
if(ipripositron >= 2) write(nfout,'(" !! etotal(3) = ",f10.6)') etotal(3)
dtim_new = m_CtrlP_decide_dtim_1Dsearch(nfout,etotal,dtim_msdv,factor)
mode = ORTHONORMALIZATION
@@ -125,19 +159,20 @@ contains
end subroutine Renewal_of_pWaveFunctions
subroutine Solve_pWaveFunctions()
-! $Id: Renewal_of_pWaveFunctions.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Renewal_of_pWaveFunctions.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Control_parameters, only : pev_max_iteration, ipripositron
use m_IterationNumbers, only : iteration_positron_wf, m_Iter_positron_incre
use m_Files, only : nfout
use m_Positron_Wave_Functions, only : m_pWF_construct_pcharge &
& , m_pWF_charge_rspace, m_pWF_wd_pev &
& , m_pWF_wlifetime
- use m_Electronic_Structure, only : m_ES_wd_vlhxcQ
+!! use m_Electronic_Structure, only : m_ES_wd_vlhxcQ
implicit none
logical :: pEigenValues_are_Converged
- call Initial_pWaveFunctions()
- if(ipripositron >= 2) call m_ES_wd_vlhxcQ()
+!! call Initial_pWaveFunctions()
+!! if(ipripositron >= 2) call m_ES_wd_vlhxcQ()
+
Solve_pWaveFunction: do
call m_Iter_positron_incre()
call Renewal_of_pWaveFunctions()
@@ -198,8 +233,16 @@ subroutine Initial_pWaveFunctions()
& , m_pWF_alloc_afft_etc &
& , m_pWF_dealloc_afft_etc &
& , m_pWF_wd_pzaj
+
+! == POSITRON SCF === 2015/11/28
+ use m_epc_Potential, only : m_epc_alloc, m_epc_alloc_vlhxc_p
+! =================== 2015/11/28
+
implicit none
+ call m_epc_alloc
+ call m_epc_alloc_vlhxc_p
+
call m_pWF_allocate_pzaj_etc()
if(intpzaj == by_random_numbers) then
diff -uprN phase0_2015.01/src_phase/b_PseudoPotential_EXX.F90 phase0_2015.01.01/src_phase/b_PseudoPotential_EXX.F90
--- phase0_2015.01/src_phase/b_PseudoPotential_EXX.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/b_PseudoPotential_EXX.F90 2016-07-12 12:51:19.000000000 +0900
@@ -3,6 +3,7 @@ subroutine alloc_qitg_exx()
use m_PlaneWaveBasisSet, only : kgp
use m_ES_ExactExchange, only : nqmk, qitg_exx
use m_Control_Parameters, only : nmax_G_hyb
+ use m_Const_Parameters, only : ON
implicit none
#if defined(MEMORY_SAVE_EXX) && defined(MEMORY_SAVE_MORE_EXX)
if(.not.allocated(qitg_exx)) allocate(qitg_exx(nmax_G_hyb,nqitg))
@@ -28,12 +29,12 @@ subroutine qitgft_qmk(it,nmm_il3,mm_il3,
end subroutine qitgft_qmk
#else
subroutine qitgft_qmk(it,nmm_il3,mm_il3,qrsps_mm,lcmax,h)
- use m_Const_Parameters, only : DP, PAI4, DELTA
+ use m_Const_Parameters, only : DP, PAI4, DELTA, ON
use m_Control_Parameters, only : nmax_G_hyb
use m_Crystal_Structure, only : rltv
use m_PlaneWaveBasisSet, only : ngabc,kgp
use m_PseudoPotential, only : mmesh,nmesh,rmax,radr,wos,nqitg_sp
- use m_Parallelization, only : mpi_comm_group,ista_kngp,iend_kngp,npes,ierr
+ use m_Parallelization, only : mpi_comm_group,ista_kngp,iend_kngp,npes,ierr,ista_kngp_exx,iend_kngp_exx
use m_ES_ExactExchange, only : nqmk, qmk, qitg_exx
use m_Timing, only : tstatc0_begin, tstatc0_end
implicit none
@@ -70,6 +71,7 @@ subroutine qitgft_qmk(it,nmm_il3,mm_il3,
end do
iend_kngp0 = iend_kngp
if(iend_kngp0.gt.nmax_G_hyb) iend_kngp0 = nmax_G_hyb
+
do ik=1,nqmk
do i = ista_kngp, iend_kngp0
kg(1:3) = qmk(ik,1:3) + ngabc(i,1:3)
@@ -111,16 +113,22 @@ subroutine qitgft_qmk(it,nmm_il3,mm_il3,
qitg_t(i,iq) = qitg_exx_l(i,iq)
end do
end do
- call mpi_allreduce(qitg_t,qitg_exx(1,mm0+1,ik),nmax_G_hyb*nqitg_sp(it),mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(qitg_t,qitg_exx(1,mm0+1,ik),nmax_G_hyb*nqitg_sp(it) &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ do iq=1,nqitg_sp(it)
+ do i=ista_kngp,iend_kngp0
+ qitg_exx(i,mm0+iq,ik) = qitg_t(i,iq)
+ enddo
+ enddo
deallocate(qitg_t)
else
do iq=1,nqitg_sp(it)
-
do i=1,nmax_G_hyb
qitg_exx(i,mm0+iq,ik) = qitg_exx_l(i,iq)
end do
end do
end if
+
end do ! ik
deallocate(qitg_exx_l)
diff -uprN phase0_2015.01/src_phase/configure phase0_2015.01.01/src_phase/configure
--- phase0_2015.01/src_phase/configure 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/configure 2016-07-12 12:51:19.000000000 +0900
@@ -343,6 +343,7 @@ fi
bllib_netlib="Netlib BLAS/LAPACK"
bllib_acml="AMD Core Math Library (ACML)"
bllib_mkl="Intel Math Kernel Library (MKL)"
+bllib_mkl_sys="System-installed MKL"
bllib_sunperf="Sun Performance Library"
bllib_scsl="SGI Cray Scientific Library (SCSL)"
bllib_essl="IBM Engineering and Scientific Subroutine Library (ESSL)"
@@ -357,6 +358,7 @@ add_option "${bllib_netlib}"
case ${sel_comp} in
"${gnu_compiler}"|"${g95_compiler}"|"${intel_compiler}")
add_option "${bllib_mkl}"
+add_option "${bllib_mkl_sys}"
;;
esac
;;
@@ -477,6 +479,20 @@ esac
;;
esac
;;
+"${bllib_mkl_sys}")
+case ${sel_plat} in
+"${gnu_linux_ia32}")
+bldir=""
+bllib="-Wl,--start-group -lmkl_scalapack_core -lmkl_blacs_intelmpi -lmkl_intel -lmkl_sequential -lmkl_core -Wl,--end-group -Bdynamic"
+use_pthread="yes"
+ ;;
+"${gnu_linux_amd64}")
+bldir=""
+bllib="-Wl,--start-group -lmkl_scalapack_lp64 -lmkl_blacs_intelmpi_lp64 -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -Bdynamic"
+use_pthread="yes"
+ ;;
+esac
+ ;;
"${bllib_mkl}")
case ${sel_plat} in
"${gnu_linux_ia32}")
@@ -609,6 +625,7 @@ esac
# FFT library selection
fftlib_jrcat="Built-in FFT subroutnes"
fftlib_fftw3="FFTW3 library"
+fftlib_fftw3_sys="System-installed FFTW3 library"
fftlib_mkl_fftw3="Intel MKL with FFTW3 interface"
#fftlib_mkl_fftw3_gnu="Intel MKL with FFTW3 interface library built by gcc"
fftlib_acml="AMD Core Math Library (ACML)"
@@ -625,10 +642,11 @@ add_option "${fftlib_jrcat}"
case ${sel_plat} in
"${gnu_linux_ia32}"|"${gnu_linux_amd64}"|"${windows_mingw_ia32}"|"${windows_mingw_amd64}"|"${windows_sua_ia32}"|"${windows_sua_amd64}")
add_option "${fftlib_fftw3}"
+add_option "${fftlib_fftw3_sys}"
#add_option "${fftlib_acml}"
case ${sel_comp} in
"${gnu_compiler}"|"${g95_compiler}"|"${intel_compiler}")
-if [ "${sel_bllib}" = "${bllib_mkl}" ];then
+if [ "${sel_bllib}" = "${bllib_mkl}" -o "${sel_bllib}" = "${bllib_mkl_sys}" ];then
add_option "${fftlib_mkl_fftw3}"
#add_option "${fftlib_mkl_fftw3_gnu}"
fi
@@ -679,127 +697,132 @@ fftdir="/usr/local/lib"
;;
"${fftlib_acml}")
fftlib="-lacml"
-case ${sel_comp} in
-"${gnu_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/gfortran32/lib"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/gfortran64/lib"
- ;;
-esac
- ;;
-"${intel_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/ifort32/lib"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/ifort64/lib"
- ;;
-"${windows_mingw_ia32}")
-fftlib="libacml_dll.lib"
-fftdir="/c/progra~1/AMD/acml5.3.0/ifort32/lib"
- ;;
-"${windows_mingw_amd64}")
-fftlib="libacml_dll.lib"
-fftdir="/c/acml5.3.0/ifort64/lib"
- ;;
-esac
- ;;
-"${pgi_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/pgi32/lib"
;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/pgi64/lib"
- ;;
-"${windows_mingw_ia32}")
-fftlib="libacml_dll.lib"
-fftdir="/c/progra~1/AMD/acml5.3.0/pgi32/lib"
- ;;
-"${windows_mingw_amd64}")
-fftlib="libacml_dll.lib"
-fftdir="/c/acml5.3.0/win64/lib"
- ;;
-esac
- ;;
-"${pathscale_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/pathscale32/lib"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/pathscale64/lib"
- ;;
-esac
- ;;
-"${sun_studio}")
-case ${sel_plat} in
-"${sun_solaris_ia32}")
-fftdir="/opt/acml5.3.0/sun32/lib"
- ;;
-"${sun_solaris_amd64}")
-fftdir="/opt/acml5.3.0/sun64/lib"
- ;;
-esac
- ;;
-esac
- ;;
-"${fftlib_mkl}")
-fftlib=""
-fftdir="/opt/intel/mkl/interfaces/fftw3xf"
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/intel/mkl/9.1/lib/32"
-fftlib="${fftlib} -lmkl_ia32 -lguide"
-use_pthread="yes"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/intel/mkl/9.1/lib/em64t"
-fftlib="${fftlib} -lmkl_em64t -lguide"
-use_pthread="yes"
- ;;
-"${gnu_linux_ipf}")
-fftdir="/opt/intel/mkl/9.1/lib/64"
-fftlib="${fftlib} -lmkl_ipf -lguide"
-use_pthread="yes"
- ;;
-"${intel_mac_32bit}")
-fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/32"
-fftlib="${fftlib} -lmkl_ia32"
- ;;
-"${intel_mac_64bit}")
-fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/em64t"
-fftlib="${fftlib} -lmkl_em64t"
- ;;
-"${windows_mingw_ia32}")
-fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/ia32/lib"
-fftlib="fftw3xf_ms.lib mkl_c_dll.lib"
- ;;
-"${windows_mingw_amd64}")
-fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/em64t/lib"
-fftlib="fftw3xf_ms.lib mkl_dll.lib"
- ;;
-esac
- ;;
-"${fftlib_scsl}")
-fftdir=""
-fftlib="-lscs"
- ;;
-"${fftlib_matrix}")
-fftdir=""
-fftlib="-lmatmpp_sc"
- ;;
-"${fftlib_ssl2}")
-fftdir=""
-fftlib="-lssl2vp"
- ;;
-"${fftlib_asl}")
+"${fftlib_fftw3_sys}")
+fftlib="-lfftw3"
fftdir=""
-fftlib="-lasl"
+
+#case ${sel_comp} in
+#"${gnu_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/gfortran32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/gfortran64/lib"
+# ;;
+#esac
+# ;;
+#"${intel_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/ifort32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/ifort64/lib"
+# ;;
+#"${windows_mingw_ia32}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/progra~1/AMD/acml5.3.0/ifort32/lib"
+# ;;
+#"${windows_mingw_amd64}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/acml5.3.0/ifort64/lib"
+# ;;
+#esac
+# ;;
+#"${pgi_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/pgi32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/pgi64/lib"
+# ;;
+#"${windows_mingw_ia32}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/progra~1/AMD/acml5.3.0/pgi32/lib"
+# ;;
+#"${windows_mingw_amd64}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/acml5.3.0/win64/lib"
+# ;;
+#esac
+# ;;
+#"${pathscale_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/pathscale32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/pathscale64/lib"
+# ;;
+#esac
+# ;;
+#"${sun_studio}")
+#case ${sel_plat} in
+#"${sun_solaris_ia32}")
+#fftdir="/opt/acml5.3.0/sun32/lib"
+# ;;
+#"${sun_solaris_amd64}")
+#fftdir="/opt/acml5.3.0/sun64/lib"
+# ;;
+#esac
+# ;;
+#esac
+# ;;
+#"${fftlib_mkl}")
+#fftlib=""
+#fftdir="/opt/intel/mkl/interfaces/fftw3xf"
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/intel/mkl/9.1/lib/32"
+#fftlib="${fftlib} -lmkl_ia32 -lguide"
+#use_pthread="yes"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/intel/mkl/9.1/lib/em64t"
+#fftlib="${fftlib} -lmkl_em64t -lguide"
+#use_pthread="yes"
+# ;;
+#"${gnu_linux_ipf}")
+#fftdir="/opt/intel/mkl/9.1/lib/64"
+#fftlib="${fftlib} -lmkl_ipf -lguide"
+#use_pthread="yes"
+# ;;
+#"${intel_mac_32bit}")
+#fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/32"
+#fftlib="${fftlib} -lmkl_ia32"
+# ;;
+#"${intel_mac_64bit}")
+#fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/em64t"
+#fftlib="${fftlib} -lmkl_em64t"
+# ;;
+#"${windows_mingw_ia32}")
+#fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/ia32/lib"
+#fftlib="fftw3xf_ms.lib mkl_c_dll.lib"
+# ;;
+#"${windows_mingw_amd64}")
+#fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/em64t/lib"
+#fftlib="fftw3xf_ms.lib mkl_dll.lib"
+# ;;
+#esac
+# ;;
+#"${fftlib_scsl}")
+#fftdir=""
+#fftlib="-lscs"
+# ;;
+#"${fftlib_matrix}")
+#fftdir=""
+#fftlib="-lmatmpp_sc"
+# ;;
+#"${fftlib_ssl2}")
+#fftdir=""
+#fftlib="-lssl2vp"
+# ;;
+#"${fftlib_asl}")
+#fftdir=""
+#fftlib="-lasl"
;;
esac
@@ -867,7 +890,7 @@ use_dgemm="yes"
#ESM
use_esm=""
-if [ "${sel_fftlib}" = "${fftlib_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" ];then
+if [ "${sel_fftlib}" = "${fftlib_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" -o "${sel_fftlib}" = "${fftlib_fftw3_sys}" ];then
echo "Do you want to enable the ESM feature? (yes/no) [yes]"
read use_esm
#echo "${use_esm}" >> config
@@ -1172,7 +1195,7 @@ cppflags="$cppflags -DJRCATFFT_WS -DCD_J
;;
esac
;;
-"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}")
+"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}"|"${fftlib_fftw3_sys}")
cppflags="$cppflags -DFFTW3"
esm="YES"
;;
@@ -1220,7 +1243,7 @@ cppflags="$cppflags -D_NO_MPI_"
esac
fi
-if [ "${sel_fftlib}" != "${fftlib_fftw3}" -a "${sel_fftlib}" != "${fftlib_mkl_fftw3}" -a "${sel_fftlib}" != "${fftlib_mkl_fftw3_gnu}" ];then
+if [ "${sel_fftlib}" != "${fftlib_fftw3}" -a "${sel_fftlib}" != "${fftlib_mkl_fftw3}" -a "${sel_fftlib}" != "${fftlib_mkl_fftw3_gnu}" -a "${sel_fftlib}" != "${fftlib_fftw3_sys}" ];then
cppflags="$cppflags -DDISABLE_VDWDF"
fi
@@ -1455,17 +1478,20 @@ esac
########################################
case ${sel_fftlib} in
-"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}")
+"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}"|"${fftlib_fftw3_sys}")
libs="-L./ \${LESM} ${libs}"
esac
-if [ "${sel_fftlib}" = "${fftlib_fftw3}" ];then
-fftincludedir="${fftdir}/../include"
-fi
-if [ "${sel_fftlib}" = "${fftlib_mkl_fftw3}" ];then
-fftincludedir="${bldir}/../../include/fftw"
-elif [ "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" ];then
-fftincludedir="${bldir}/../../include/fftw"
+fftincludedir="INCLUDE="
+if [ "${sel_fftlib}" = "${fftlib_fftw3}" ] && [ -n "${fftdir}" ];then
+fftincludedir="INCLUDE=-I${fftdir}/../include"
+fi
+if [ "${sel_fftlib}" = "${fftlib_mkl_fftw3}" ] && [ -n "${bldir}" ];then
+fftincludedir="INCLUDE=-I${bldir}/../../include/fftw"
+elif [ "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" ] && [ -n "${bldir}" ];then
+fftincludedir="INCLUDE=-I${bldir}/../../include/fftw"
+elif [ "${sel_fftlib}" = "${fftlib_fftw3_sys}" ];then
+fftincludedir="INCLUDE="
fi
cat <<here > Makefile
@@ -1502,7 +1528,7 @@ LFLAGS = ${lflags}
F90FLAGS_FIXED = ${f90flags_fixed}
F90FLAGS_FREE = ${f90flags_free}
MKLHOME=${bldir}
-INCLUDE=-I${fftincludedir}
+${fftincludedir}
LIBS = ${libs}
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
diff -uprN phase0_2015.01/src_phase/constraint_main.F90 phase0_2015.01.01/src_phase/constraint_main.F90
--- phase0_2015.01/src_phase/constraint_main.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/constraint_main.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 494 $)
!
! SUBROUINE: constrained_dynamics
!
@@ -45,6 +45,11 @@ subroutine constrained_dynamics()
use m_Control_Parameters, only : printable, icond, icond_org
use m_Files, only : nfout
use m_Parallelization, only : nrank_conf, mype_conf, conf_para
+#ifdef PAW3D
+ use m_PseudoPotential, only : mmesh
+ use m_Ionic_System, only : natm
+ use m_Parallelization, only : m_Parallel_init_mpi_paw_3D
+#endif
implicit none
diff -uprN phase0_2015.01/src_phase/input_interface.F90 phase0_2015.01.01/src_phase/input_interface.F90
--- phase0_2015.01/src_phase/input_interface.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/input_interface.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 475 $)
!
! FUNCTION: getUnitId, setUnit, updateUnits, clearUnitFlag, setDefaultUnits,
! realConvByUnit, f_openInputFile, f_closeInputFile, f_selectTop,
@@ -17,7 +17,7 @@
!
!
!=======================================================================
-! $Id: input_interface.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: input_interface.F90 475 2016-02-23 05:22:18Z jkoga $
!
!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!$! interface functions
@@ -376,7 +376,8 @@ integer function f_selectBlock( blocktag
if( iret < 0 ) then
f_selectBlock = iret
iret = f_selectParentBlock()
- print '( "A unit with the same dimension as [", a, "] has been already given in the block [", a, "]." )', trim(unit), trim(blocktag)
+ print '( "A unit with the same dimension as [", a, "] has been already given in the block [", a, "]." )'&
+ & , trim(unit), trim(blocktag)
return
end if
end do
diff -uprN phase0_2015.01/src_phase/m_CD_Mag_Moment.f90 phase0_2015.01.01/src_phase/m_CD_Mag_Moment.f90
--- phase0_2015.01/src_phase/m_CD_Mag_Moment.f90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_CD_Mag_Moment.f90 2016-07-12 12:51:19.000000000 +0900
@@ -1,5 +1,5 @@
module m_CD_Mag_Moment
-! $Id: m_CD_Mag_Moment.f90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_CD_Mag_Moment.f90 476 2016-03-10 08:30:50Z yamasaki $
use m_Control_Parameters, only : noncol, ndim_magmom, kimg, iprimagmom, ON, OFF
use m_Const_Parameters, only : DP, PAI4, Bohr
@@ -514,7 +514,7 @@ contains
ik = ista_k
call new_radr_and_wos(ik,it) ! --> radr, wos
- rcut = rad_cov_default( iatomn(it) )
+ rcut = rad_cov_default( nint(iatomn(it) )) ! Revised according to a report from ASMS Co.ltd, 10 March 2016.
Do il1=1, lpsmax(it)
! if ( il1 == iloc(it) ) cycle
diff -uprN phase0_2015.01/src_phase/m_CD_mixing.F90 phase0_2015.01.01/src_phase/m_CD_mixing.F90
--- phase0_2015.01/src_phase/m_CD_mixing.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_CD_mixing.F90 2016-07-12 12:51:19.000000000 +0900
@@ -62,7 +62,7 @@
#endif
module m_CD_mixing
-! $Id: m_CD_mixing.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_CD_mixing.F90 492 2016-05-31 03:06:04Z jkoga $
use m_Const_Parameters, only : BUCS, DP, OFF &
& , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
& , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
@@ -94,8 +94,10 @@ module m_CD_mixing
! ==============================================================================
! === Added by tkato 2011/11/09 ================================================
use m_Control_Parameters, only : sw_mix_bothspins_sametime &
- , sw_recomposing_hsr, sw_force_simple_mixing_hsr
- use m_Ionic_System, only : ityp, natm
+ , sw_recomposing_hsr, sw_force_simple_mixing_hsr &
+ , num_proj_elems, proj_group, proj_attribute, num_projectors &
+ , max_projs
+ use m_Ionic_System, only : ityp, natm,iproj_group
use m_PseudoPotential, only : ilmt, nlmt
use m_Charge_Density, only : hsr, hsro
!===============================================================================
@@ -115,6 +117,8 @@ module m_CD_mixing
use m_Control_Parameters, only : sw_mix_charge_hardpart, sw_mix_charge_with_ekindens
! =============== 2014/09/16
+ use m_Orbital_Population, only : om,omold,ommix
+
implicit none
! --> T. Yamasaki 03 Aug. 2009
real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
@@ -185,7 +189,10 @@ module m_CD_mixing
! ========================== adde by K. Tagami ========================== 5.0
integer :: nsize_rho_hsr
+ integer :: nsize_rho_hsr0
+ integer :: nsize_rho_om
integer, private, allocatable :: imap_hsr(:) ! d(nsize_rho_hsr)
+ integer, private, allocatable :: imap_om(:) ! d(nsize_rho_hsr)
real(kind=DP),private,allocatable, dimension(:,:) :: rho_hsr, rhoo_hsr
! d(nsize_rho_hsr,nspin)
@@ -198,6 +205,7 @@ module m_CD_mixing
real(DP),private,allocatable,target,dimension(:,:,:,:) :: urec_hsr
real(DP),private,allocatable,dimension(:,:,:) :: d0_hsr_h
+ logical,allocatable,dimension(:) :: diag_elem
logical, save :: first = .true.
@@ -245,6 +253,16 @@ module m_CD_mixing
real(kind=DP), pointer :: ekinq_l(:,:,:), ekinqo_l(:,:,:)
! ============== 2014/09/19
+ integer, public, allocatable :: i2lp(:) ! d(num_projectors)
+
+! ================================ modified by K. Tagami ================ 11.0
+! integer, private :: max2lp ! max. of i2lp
+ integer, public :: max2lp ! max. of i2lp
+! ======================================================================= 11.0
+
+ integer, private :: l1max ! max. of l1
+ integer, private :: nyymax
+
! --- contained subroutines ---
! 7. m_CD_prepare_precon <-(ChargeDensity_Mixing)
! 10. m_CD_simple_mixing <-(ChargeDensity_Mixing)
@@ -646,10 +664,22 @@ contains
tmp = max(gg/(gg+q0),amin)
!!$ agg = amix_cprec*gg/(gg+q0)
agg = amix_cprec*tmp
- c_p(i,:) = agg * pmix(:)
+
+! === 2015/09/29
+!!! c_p(i,:) = agg * pmix(:)
+
+ c_p(i,1) = agg * pmix(1)
+ c_p(i,2:nspin_m) = amix_cprec * pmix(2:nspin_m)
+! === 2015/09/29
+
end do
if (mype == 0) then
- c_p(1,:) = amix_cprec*fg2 * pmix(:)
+! === 2015/09/29
+! c_p(1,:) = amix_cprec*fg2 * pmix(:)
+
+ c_p(1,1) = amix_cprec*fg2 * pmix(1)
+ c_p(1,2:nspin_m) = amix_cprec * pmix(2:nspin_m)
+! === 2015/09/29
end if
else
do is = 1, ndim_magmom
@@ -2618,9 +2648,10 @@ contains
end subroutine m_CD_mix_broyden2
! ===================== added by K. Tagami ============================== 5.0
- subroutine m_CD_mix_broyden2_with_hsr(nfout,rmx)
+ subroutine m_CD_mix_broyden2_with_hsr(nfout,rmx,mixocc)
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
+ logical, intent(in) :: mixocc
integer :: iter,j,mxiter,icr,jcr
!!$ real(DP) :: v_dF(nspin),vF(nspin)
@@ -2634,9 +2665,10 @@ contains
if (previous_waymix /= BROYD2.or.force_dealloc) then
force_dealloc = .false.
if ( first ) then
- call create_map_func(.true.)
- call alloc_rho_hsr
- call create_map_func(.false.)
+ if(mixocc) call set_i2lp_max2lp()
+ call create_map_func(.true.,mixocc)
+ call alloc_rho_hsr(mixocc)
+ call create_map_func(.false.,mixocc)
first = .false.
endif
call mix_dealloc_previous()
@@ -2655,6 +2687,10 @@ contains
else
call map_hsr_to_rho( hsr, rho_hsr )
call map_hsr_to_rho( hsro,rhoo_hsr )
+ if(mixocc)then
+ call map_om_to_rho( om, rho_hsr )
+ call map_om_to_rho( omold,rhoo_hsr )
+ endif
endif
! ========================================================================= 11.0
@@ -2752,7 +2788,6 @@ contains
call mix_broyden_dealloc2 !-(m_CD)
call mix_broyden_dealloc2_hsr
-
endif
! ============================== modified by K. Tagami ================= 11.0
@@ -2780,6 +2815,7 @@ contains
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
else
call map_rho_to_hsr( hsr, rho_hsr )
+ if(mixocc) call map_rho_to_om( om, rho_hsr )
endif
deallocate(rmxtrc)
@@ -3760,10 +3796,11 @@ contains
end subroutine m_CD_mix_pulay
!!$ 11.07 AS Pulay version of 'sw_mix_charge_hardpart'
- subroutine m_CD_mix_pulay_with_hsr(nfout,rmx)
+ subroutine m_CD_mix_pulay_with_hsr(nfout,rmx,mixocc)
integer, parameter :: iRho = 1, iResid = 2
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
+ logical, intent(in) :: mixocc
integer :: iter, mxiter
real(DP),pointer,dimension(:) :: e_wk, f_wk, ww1, finv
integer, pointer,dimension(:) :: ip
@@ -3777,9 +3814,10 @@ contains
if(previous_waymix /= PULAY.or.force_dealloc) then
force_dealloc = .false.
if ( first ) then
- call create_map_func(.true.)
- call alloc_rho_hsr
- call create_map_func(.false.)
+ if(mixocc) call set_i2lp_max2lp()
+ call create_map_func(.true.,mixocc)
+ call alloc_rho_hsr(mixocc)
+ call create_map_func(.false.,mixocc)
first = .false.
endif
call mix_dealloc_previous()
@@ -3798,6 +3836,10 @@ contains
else
call map_hsr_to_rho( hsr, rho_hsr )
call map_hsr_to_rho( hsro,rhoo_hsr )
+ if(mixocc)then
+ call map_om_to_rho( om, rho_hsr )
+ call map_om_to_rho( omold,rhoo_hsr )
+ endif
endif
! ========================================================================= 11.0
@@ -3920,6 +3962,7 @@ contains
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
else
call map_rho_to_hsr( hsr, rho_hsr )
+ if(mixocc) call map_rho_to_om( om, rho_hsr )
endif
deallocate(rmxtrc)
@@ -4342,10 +4385,11 @@ contains
!!$ 11.07 AS Pulay version of 'sw_mix_charge_hardpart'
! ========================= added by K. Tagami ===================== 5.0
- subroutine create_map_func(paramset)
- logical :: paramset
+ subroutine create_map_func(paramset,mixocc)
+ logical :: paramset,mixocc
integer :: n, ia, it
integer :: lmt1, lmt2
+ integer :: ig,m2,m1,i,ip
n=0
do ia=1,natm
@@ -4355,13 +4399,36 @@ contains
do lmt2 = lmt1, ilmt(it)
n=n+1
- if(.not.paramset) &
- & imap_hsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
+ if(.not.paramset) then
+ imap_hsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
+ diag_elem(n) = lmt1.eq.lmt2
+ endif
end do
end do
end do
- nsize_rho_hsr = n
+ nsize_rho_hsr0 = n
+ nsize_rho_hsr = nsize_rho_hsr0
! ================================ added by K. Tagami ============ 11.0
+ if(mixocc)then
+ n=0
+ do ia=1,natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+ do i=1,num_proj_elems(ig)
+ ip=proj_group(i,ig)
+ it = proj_attribute(ip)%ityp
+ do m2=1,i2lp(ip)
+ do m1=m2,i2lp(ip)
+ n=n+1
+ if(.not.paramset) &
+ & imap_om(n) = m1 + max2lp*(m2-1 + max2lp*( i-1 + max_projs*( ia-1 ) ) )
+ end do
+ end do
+ end do
+ enddo
+ nsize_rho_om = n
+ nsize_rho_hsr = nsize_rho_hsr0+nsize_rho_om
+ endif
if ( noncol ) then
nsize_rho_hsr_realpart = n
@@ -4382,20 +4449,69 @@ contains
! ================================================================= 11.0
end subroutine create_map_func
- subroutine alloc_rho_hsr
+ subroutine alloc_rho_hsr(mixocc)
+ logical, intent(in) :: mixocc
+ if ( noncol ) then
+ nspin_m = ndim_magmom
+ else
+ nspin_m = nspin/(af+1)
+ endif
+ if ( noncol ) then
+ nspin_m = ndim_magmom
+ allocate( rho_hsr( nsize_rho_hsr,ndim_magmom)); rho_hsr = 0.0d0
+ allocate( rhoo_hsr(nsize_rho_hsr,ndim_magmom));rhoo_hsr = 0.0d0
+ else
+ nspin_m = nspin/(af+1)
+ allocate( rho_hsr( nsize_rho_hsr,nspin_m)); rho_hsr = 0.0d0
+ allocate( rhoo_hsr(nsize_rho_hsr,nspin_m));rhoo_hsr = 0.0d0
+ endif
! ================================ modified by K. Tagami ============== 11.0
! allocate( rho_hsr( nsize_rho_hsr,nspin)); rho_hsr = 0.0d0
! allocate( rhoo_hsr(nsize_rho_hsr,nspin));rhoo_hsr = 0.0d0
- allocate( rho_hsr( nsize_rho_hsr,ndim_magmom)); rho_hsr = 0.0d0
- allocate( rhoo_hsr(nsize_rho_hsr,ndim_magmom));rhoo_hsr = 0.0d0
! ====================================================================== 11.0
- allocate( imap_hsr(nsize_rho_hsr) ); imap_hsr = 0
+ allocate( imap_hsr(nsize_rho_hsr0) ); imap_hsr = 0
+ allocate(diag_elem(nsize_rho_hsr0));diag_elem=.false.
+ if(mixocc)then
+ allocate( imap_om(nsize_rho_om) ); imap_om = 0
+ endif
end subroutine alloc_rho_hsr
+ subroutine set_i2lp_max2lp()
+ integer :: it,ip
+ integer, parameter :: ntau0=2
+
+! =========================== added by K. Tagami ====================== 11.0
+ integer :: nsize
+! ===================================================================== 11.0
+
+ allocate(i2lp(num_projectors))
+ do ip=1,num_projectors
+ i2lp(ip) = 2*proj_attribute(ip)%l+1
+ end do
+ max2lp = 0
+ do ip=1,num_projectors
+ if(i2lp(ip) > max2lp) then
+ max2lp = i2lp(ip)
+ l1max = proj_attribute(ip)%l+1
+ end if
+ end do
+
+! =========================== modified by K. Tagami ====================== 11.0
+!!
+!! nyymax = ntau0*l1max**2*(l1max**2+1)/2
+!
+ nsize = ntau0*( 2*( l1max -1 )+1 )
+ nyymax = nsize *( nsize +1 ) /2
+
+ end subroutine set_i2lp_max2lp
+
subroutine dealloc_rho_hsr
deallocate(rho_hsr)
deallocate(rhoo_hsr)
deallocate(imap_hsr)
+ deallocate(diag_elem)
+ if(allocated(imap_om)) deallocate(imap_om)
+ if(allocated(i2lp)) deallocate(i2lp)
end subroutine dealloc_rho_hsr
subroutine map_hsr_to_rho( hsr,rho )
@@ -4406,7 +4522,7 @@ contains
do is=1,nspin,(af+1)
rho(:,is)=0.d0
- do i=1,nsize_rho_hsr
+ do i=1,nsize_rho_hsr0
rho(i,is) = hsr( imap_hsr(i),is )
end do
end do
@@ -4434,6 +4550,55 @@ contains
end subroutine map_hsr_to_rho_noncl
! ===================================================================== 11.0
+ subroutine map_om_to_rho(om,rho)
+ real(kind=DP), intent(in) :: om(max2lp*max2lp*max_projs*natm,nspin)
+ real(kind=DP), intent(out) :: rho(nsize_rho_hsr,nspin)
+
+ integer :: i,is
+
+ do is=1,nspin,(af+1)
+ do i=nsize_rho_hsr0+1,nsize_rho_hsr
+ rho(i,is) = om(imap_om(i-nsize_rho_hsr0),is)
+ end do
+ end do
+ end subroutine map_om_to_rho
+
+ subroutine map_rho_to_om(om,rho)
+ real(kind=DP), intent(out) :: om(max2lp*max2lp*max_projs*natm,nspin)
+ real(kind=DP), intent(in) :: rho(nsize_rho_hsr,nspin)
+ integer :: i,is,ia,ig,ip,it,m1,m2
+
+ do is=1,nspin,(af+1)
+ do i=nsize_rho_hsr0+1,nsize_rho_hsr
+ om(imap_om(i-nsize_rho_hsr0),is) = rho(i,is)
+ end do
+ end do
+ call symmetrize(om)
+
+ contains
+
+ subroutine symmetrize(om)
+ real(kind=DP), intent(inout) :: om(max2lp,max2lp,max_projs,natm,nspin)
+
+ do is=1,nspin,(af+1)
+ do ia=1,natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+ do i=1,num_proj_elems(ig)
+ ip=proj_group(i,ig)
+ it = proj_attribute(ip)%ityp
+ do m2=1,i2lp(ip)
+ do m1=m2,i2lp(ip)
+ if(m1/=m2) om(m2,m1,i,ia,is) = om(m1,m2,i,ia,is)
+ end do
+ end do
+ end do
+ end do
+ end do
+ end subroutine symmetrize
+
+ end subroutine map_rho_to_om
+
subroutine map_rho_to_hsr( hsr,rho )
real(kind=DP), intent(out) :: hsr( natm *nlmt *nlmt, nspin )
real(kind=DP), intent(in) :: rho( nsize_rho_hsr,nspin )
@@ -4442,8 +4607,8 @@ contains
do is=1,nspin,(af+1)
- hsr(1:nsize_rho_hsr,is) = 0.0d0
- do i=1,nsize_rho_hsr
+ hsr(1:nsize_rho_hsr0,is) = 0.0d0
+ do i=1,nsize_rho_hsr0
hsr(imap_hsr(i),is) = rho(i,is)
end do
end do
@@ -5154,9 +5319,10 @@ contains
end subroutine renew_d_br_intg
- subroutine m_CD_mix_broyden2_intg(nfout,rmx)
+ subroutine m_CD_mix_broyden2_intg(nfout,rmx,mixocc)
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
+ logical, intent(in) :: mixocc
integer :: iter,j,mxiter,icr,jcr
integer :: id_sname = -1
@@ -5170,9 +5336,9 @@ contains
if ( sw_mix_charge_hardpart == ON ) then
if ( first ) then
- call create_map_func(.true.)
- call alloc_rho_hsr
- call create_map_func(.false.)
+ call create_map_func(.true.,mixocc)
+ call alloc_rho_hsr(mixocc)
+ call create_map_func(.false.,mixocc)
first = .false.
endif
endif
@@ -5194,6 +5360,10 @@ contains
else
call map_hsr_to_rho( hsr, rho_hsr )
call map_hsr_to_rho( hsro,rhoo_hsr )
+ if(mixocc) then
+ call map_om_to_rho(om, rho_hsr)
+ call map_om_to_rho(omold, rho_hsr)
+ endif
endif
endif
@@ -5259,6 +5429,7 @@ contains
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
else
call map_rho_to_hsr( hsr, rho_hsr )
+ if(mixocc) call map_rho_to_om(om,rho_hsr)
endif
endif
@@ -5463,9 +5634,10 @@ contains
end subroutine mix_pulay_dealloc2_intg
- subroutine m_CD_mix_pulay_intg(nfout,rmx)
+ subroutine m_CD_mix_pulay_intg(nfout,rmx,mixocc)
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
+ logical, intent(in) :: mixocc
integer, parameter :: iRho = 1, iResid = 2
integer :: iter, mxiter
@@ -5483,9 +5655,10 @@ contains
if ( sw_mix_charge_hardpart == ON ) then
if ( first ) then
- call create_map_func(.true.)
- call alloc_rho_hsr
- call create_map_func(.false.)
+ call set_i2lp_max2lp()
+ call create_map_func(.true.,mixocc)
+ call alloc_rho_hsr(mixocc)
+ call create_map_func(.false.,mixocc)
first = .false.
endif
endif
@@ -5501,6 +5674,10 @@ contains
else
call map_hsr_to_rho( hsr, rho_hsr )
call map_hsr_to_rho( hsro,rhoo_hsr )
+ if(mixocc) then
+ call map_om_to_rho(om, rho_hsr)
+ call map_om_to_rho(omold, rho_hsr)
+ endif
endif
allocate(rmxtrc(nspin_m))
@@ -5566,6 +5743,7 @@ contains
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
else
call map_rho_to_hsr( hsr, rho_hsr )
+ if(mixocc) call map_rho_to_om(om,rho_hsr)
endif
deallocate(rmxtrc)
@@ -6282,4 +6460,27 @@ contains
end subroutine m_CD_simple_mixing_intg
! ====== 2014/09/19
+ subroutine m_CD_hsr_diff(nfout)
+ integer, intent(in) :: nfout
+ integer :: i,j,ndiag,nnondiag
+ real(kind=DP) :: sumhsr_diag,sumhsr_nondiag
+ sumhsr_diag = 0.d0
+ sumhsr_nondiag = 0.d0
+ ndiag = 0
+ nnondiag = 0
+ do i=1,nspin_m
+ do j=1,nsize_rho_hsr
+ if(diag_elem(j))then
+ sumhsr_diag = sumhsr_diag+abs(rhoo_hsr(j,i)-rho_hsr(j,i))
+ ndiag = ndiag+1
+ else
+ sumhsr_nondiag = sumhsr_nondiag+abs(rhoo_hsr(j,i)-rho_hsr(j,i))
+ nnondiag = nnondiag+1
+ endif
+ enddo
+ enddo
+ if(printable) write(nfout,'(a,f15.10)') '!** dhsr_diag ',sumhsr_diag/dble(ndiag)
+ if(printable) write(nfout,'(a,f15.10)') '!** dhsr_nondiag',sumhsr_nondiag/dble(nnondiag)
+ end subroutine m_CD_hsr_diff
+
end module m_CD_mixing
diff -uprN phase0_2015.01/src_phase/m_CS_Magnetic.F90 phase0_2015.01.01/src_phase/m_CS_Magnetic.F90
--- phase0_2015.01/src_phase/m_CS_Magnetic.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_CS_Magnetic.F90 2016-07-12 12:51:19.000000000 +0900
@@ -21,7 +21,7 @@ module m_CS_Magnetic
! ============= 2014/08/14
! == KT_add === 2014/08/26
- use m_Control_Parameters, only : SpinOrbit_mode, noncol
+ use m_Control_Parameters, only : SpinOrbit_mode, noncol, iprisym
use m_Const_Parameters, only : Neglected
use m_Ionic_System, only : mag_moment0_atoms, ionic_charge_atoms, &
& mag_moment0_atoms_is_defined
@@ -46,6 +46,8 @@ module m_CS_Magnetic
integer, allocatable :: magmom_dir_inversion_opr_flag(:)
! ============= 2014/08/14
+ complex(kind=CMPLDP), allocatable :: op_spinor(:,:,:)
+
contains
! ------------------------------------------------------------------------
@@ -1082,4 +1084,104 @@ contains
end subroutine m_CS_set_inverse_operation
+ subroutine m_CS_set_op_spinor
+ integer :: i, j
+ real(kind=DP) :: k1, k2, k3, ux, uy, uz, c1, c2, c3
+ real(kind=DP) :: sinth, costh, theta, s1, determinant
+!
+ real(kind=DP), parameter :: delta = 1.0D-4
+ complex(kind=CMPLDP), parameter :: zi = ( 0.0d0, 1.0d0 )
+!
+ real(kind=DP), allocatable :: op_work(:,:,:)
+!
+ allocate( op_work(3,3,nopr) ); op_work = op
+ if ( .not. allocated( op_spinor ) ) allocate( op_spinor(2,2,nopr) )
+
+ Do i=1, nopr
+ call calc_determinant( op(:,:,i), determinant )
+ if ( determinant < 0 ) then
+ op_work(1,1,i) = -op_work(1,1,i)
+ op_work(2,2,i) = -op_work(2,2,i)
+ op_work(3,3,i) = -op_work(3,3,i)
+ endif
+
+ costh = ( op_work(1,1,i) +op_work(2,2,i) +op_work(3,3,i) -1.0d0 ) /2.0d0
+ sinth = sqrt( 1.0d0 -costh**2 )
+
+ theta = acos( costh )
+!
+ if ( sinth > delta ) then
+ k1 = ( op_work(3,2,i) -op_work(2,3,i) ) /2.0d0
+ k2 = ( op_work(1,3,i) -op_work(3,1,i) ) /2.0d0
+ k3 = ( op_work(2,1,i) -op_work(1,2,i) ) /2.0d0
+
+ ux = k1 /sinth; uy = k2 /sinth; uz = k3 /sinth
+ else
+ if ( costh > 1.0 -delta ) then
+ ux = 0.0d0; uy = 0.0d0; uz = 1.0d0
+ theta = 0.0d0
+ else if ( costh < -1.0 +delta ) then
+ k1 = ( op_work(1,1,i) + 1.d0 )/2.0d0
+ k2 = ( op_work(2,2,i) + 1.d0 )/2.0d0
+ k3 = ( op_work(3,3,i) + 1.d0 )/2.0d0
+
+ ux = sqrt(k1); uy = sqrt(k2); uz = sqrt(k3)
+
+ if ( uz > delta ) then
+ if ( op_work(1,3,i) < 0 ) ux = -ux
+ if ( op_work(2,3,i) < 0 ) uy = -uy
+ else
+ if ( op_work(1,2,i) < 0 ) uy = -uy
+ endif
+
+ endif
+ endif
+
+#if 0
+ write(*,*) "i = ", i, "costh = ", costh, "sinth = ", sinth
+ write(*,'(4(A,F10.2))') "Axis: ux = ", ux, ", uy = ", uy, ", uz = ", uz, &
+ & ", Angle = ", theta /PAI *180.0d0
+ write(*,*)
+#endif
+
+ c1 = cos( theta /2.0d0 ); s1 = sin( theta /2.0d0 );
+
+ op_spinor(1,1,i) = c1 -zi *uz *s1
+ op_spinor(1,2,i) = ( -zi *ux -uy ) *s1
+ op_spinor(2,1,i) = ( -zi *ux +uy ) *s1
+ op_spinor(2,2,i) = c1 +zi *uz *s1
+!
+ if ( determinant < 0 ) op_spinor(:,:,i) = zi *op_spinor(:,:,i)
+ End Do
+!
+ if ( iprisym > 1 ) then
+ write(nfout,*) '*** symmetry operation for spinor ***'
+ Do i=1, nopr
+ write(nfout,*) ' #symmetry op. = ', i
+ write(nfout,'(A,F8.4,A,F8.4,2A,F8.4,A,F8.4,A)') &
+ & '( ', real(op_spinor(1,1,i)), ', ', &
+ & aimag(op_spinor(1,1,i)), ' I ) ', &
+ & '( ',real(op_spinor(1,2,i)), ', ', &
+ & aimag(op_spinor(1,2,i)), ' I )'
+ write(nfout,'(A,F8.4,A,F8.4,2A,F8.4,A,F8.4,A)') &
+ & '( ', real(op_spinor(2,1,i)), ', ', &
+ & aimag(op_spinor(2,1,i)), ' I ) ', &
+ & '( ',real(op_spinor(2,2,i)), ', ', &
+ & aimag(op_spinor(2,2,i)), ' I )'
+ End Do
+ endif
+ deallocate( op_work )
+
+ contains
+
+ subroutine calc_determinant( a, determinant )
+ real(kind=DP), intent(in) :: a(3,3)
+ real(kind=DP), intent(out) :: determinant
+ determinant = a(1,1)*( a(2,2)*a(3,3) -a(2,3)*a(3,2) ) &
+ & -a(1,2)*( a(2,1)*a(3,3) -a(2,3)*a(3,1) ) &
+ & +a(1,3)*( a(2,1)*a(3,2) -a(2,2)*a(3,1) )
+ end subroutine calc_determinant
+
+ end subroutine m_CS_set_op_spinor
+
end module m_CS_Magnetic
diff -uprN phase0_2015.01/src_phase/m_Charge_Density.F90 phase0_2015.01.01/src_phase/m_Charge_Density.F90
--- phase0_2015.01/src_phase/m_Charge_Density.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Charge_Density.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 478 $)
!
! MODULE: m_Charge_Density
!
@@ -86,7 +86,7 @@
#endif
module m_Charge_Density
-! $Id: m_Charge_Density.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Charge_Density.F90 478 2016-03-12 12:28:48Z ktagami $
use m_Const_Parameters, only : BUCS, DP, PAI2, DIRECT,OFF,zi,SKIP &
& , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
& , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
@@ -194,6 +194,13 @@ module m_Charge_Density
use m_Electronic_Structure,only : fsr_add_l, fsi_add_l
! ==================== 2014/08/25
+! ==== EXP_CELLOPT === 2015/09/24
+ use m_Parallelization, only : ista_fftph, iend_fftph, idisp_fftp, nel_fftp, npes_cdfft
+ use m_PlaneWaveBasisSet, only : kgp_prev
+ use m_FFT, only : m_FFT_CD_direct, m_FFT_CD_inverse_c
+! ==================== 2015/09/24
+
+
implicit none
real(kind=DP),public,target,allocatable,dimension(:,:,:) :: chgq_l, chgqo_l ! d(ista_kngp:iend_kngp,kimg,nspin)
@@ -622,6 +629,7 @@ contains
& write(nfout,96) "OLD",chg_t(1,OLD)*univol,chg_t(2,OLD)*univol,totch_old*univol
if(ipritotalcharge>=1) &
& write(nfout,96) "NEW",chg_t(1,NEXT)*univol,chg_t(2,NEXT)*univol,totch_new*univol
+ if ( ipritotalcharge_0 >=2 ) call m_CD_calc_abs_magetization( nfout )
else
if((ipritotalcharge >= 2 .and. iteration_electronic==1).or.ipritotalcharge>=3) &
& write(nfout,98) "OLD",totch_old*univol
@@ -692,6 +700,7 @@ contains
& ' My:', totch_new(3)*univol, &
& ' Mz:', totch_new(4)*univol
endif
+ if ( ipritotalcharge_0 >=2 ) call m_CD_calc_abs_magetization( nfout )
end subroutine m_CD_check_noncl
! ===================================================================== 11.0
@@ -1612,7 +1621,7 @@ contains
crotylm_paw(m,jj,iopr,ia)
hsi(ia,lmt1,lmt2,1) = &
hsi(ia,lmt1,lmt2,1) + &
- weight * &
+ weight *weight2 * &
hsi_tmp(ja,lmt3,lmt4,1)* &
crotylm_paw(n,ii,iopr,ia)* &
crotylm_paw(m,jj,iopr,ia)
@@ -4315,6 +4324,349 @@ contains
call phase_error_wo_filename(ierror, nfout, nfchgt, __LINE__, __FILE__)
end subroutine m_CD_rd_chgq
+! ===== EXP_CELLOPT ==== 2015/09/24
+ subroutine m_CD_import_chgq_prev_cell(nfout,nfchgt, F_CHGT_partitioned)
+ integer, intent(in) :: nfout, nfchgt
+ logical, intent(in) :: F_CHGT_partitioned
+ integer :: i,j,k,is, ip
+ real(kind=DP), allocatable, dimension(:,:,:) :: chgq_mpi
+
+ real(kind=DP) :: totch_here
+
+ integer :: id_sname = -1
+ integer :: ierror
+
+ call tstatc0_begin('m_CD_import_chgq_prev_cell ',id_sname,1)
+ chgq_l = 0.0d0
+
+ if(F_CHGT_partitioned) then
+ stop "Not supported"
+ else
+ allocate(chgq_mpi1(kgp_prev,kimg,ndim_magmom)); chgq_mpi1 = 0.d0
+ if (mype==0) then
+ rewind nfchgt
+ read(nfchgt, end = 9999, err = 9999) chgq_mpi1
+ endif
+
+ if (npes > 1) then
+ call mpi_bcast( chgq_mpi1, kgp_prev*kimg*ndim_magmom, &
+ & mpi_double_precision, 0, mpi_comm_group, ierr )
+ endif
+
+ do k = 1, ndim_magmom
+ do j = 1, kimg
+ do i = ista_kngp, iend_kngp !for mpi
+ if ( i > kgp_prev ) cycle
+ chgq_l(i,j,k) = chgq_mpi1(i,j,k)
+ enddo
+ enddo
+ enddo
+ deallocate(chgq_mpi1)
+ end if
+ call remove_imaginary_charge
+
+ total_charge = 0.d0
+ if(mype == 0) then
+ if ( noncol ) then
+ do is = 1, 1
+ total_charge = total_charge + chgq_l(1,1,is)*univol
+ end do
+ else
+ do is = 1, nspin, af+1
+ total_charge = total_charge + chgq_l(1,1,is)*univol
+ end do
+ endif
+ end if
+ if ( mype == 0 ) then
+ chgq_l(1,:,:) = chgq_l(1,:,:) *totch /total_charge
+ endif
+!
+ total_charge = totch
+
+ call tstatc0_end(id_sname)
+
+ return
+9999 continue
+ ierror = EOF_REACHED
+ call phase_error_wo_filename(ierror, nfout, nfchgt, __LINE__, __FILE__)
+
+ contains
+
+ subroutine remove_imaginary_charge
+ integer :: iloop, i, j, ip
+ real(kind=DP) :: rinplw
+ real(kind=DP), allocatable :: afft(:), afft_mpi1(:), afft_mpi2(:), afft_mpi3(:)
+ real(kind=DP),parameter :: D_min = 1.d-40
+
+ call m_FFT_alloc_CD_box()
+
+ allocate(afft(ista_fftp:iend_fftp)); afft =0.0d0
+ allocate(afft_mpi1(nfftp)); afft_mpi1 = 0.0d0
+ if(npes >= 2) then
+ allocate(afft_mpi2(mp_fftp)); afft_mpi2 = 0.0d0
+ allocate(afft_mpi3(mp_fftp)); afft_mpi3 = 0.0d0
+ end if
+
+ rinplw = 1.d0 /product(fft_box_size_CD(1:3,1))
+
+ do iloop = 1, ndim_magmom
+ afft = 0.0d0; afft_mpi1 = 0.d0
+
+ do j = 1, kimg
+ do i = ista_kngp, iend_kngp !for mpi
+ ip = (igfp_l(i)-1)*kimg + j
+ ! afft_mpi1(ip) = afft_mpi1(ip) + chgq_l(i,j,iloop) !mpi
+ afft_mpi1(ip) = chgq_l(i,j,iloop) !mpi
+ end do
+ end do
+
+ if (npes >= 2) then
+ call mpi_barrier(mpi_comm_group,ierr)
+ do j = 0, npes-1
+
+ do i = nis_fftp(j),nie_fftp(j)
+ afft_mpi2(i-nis_fftp(j)+1) = afft_mpi1(i)
+ end do
+ call mpi_allreduce(afft_mpi2,afft_mpi3,mp_fftp &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+
+ if(j == mype) then
+ do i = ista_fftp, iend_fftp
+ afft(i) = afft_mpi3(i - ista_fftp + 1)
+ end do
+ end if
+ end do
+ else
+ afft = afft_mpi1
+ end if
+
+ call m_FFT_CD_inverse_c(nfout,afft) ! G-->R space
+ Do i=ista_fftp, iend_fftp, 2
+ afft(i+1) = 0.0d0
+ End Do
+!
+ if ( .not. noncol ) then
+ Do i=ista_fftp, iend_fftp, 2
+ afft(i) = max( afft(i), D_min )
+ End Do
+ else if ( iloop == 1 ) then
+ Do i=ista_fftp, iend_fftp, 2
+ afft(i) = max( afft(i), D_min )
+ End Do
+ endif
+ call m_FFT_CD_direct( nfout, afft ) ! R-- >G space
+ !
+ if(npes >= 2) then
+ call mpi_allgatherv( afft, nel_fftp(mype), mpi_double_precision, &
+ & afft_mpi1, nel_fftp, idisp_fftp, &
+ & mpi_double_precision, mpi_comm_group, ierr )
+ else
+ afft_mpi1 = afft
+ end if
+
+ do j = 1, kimg
+ do i = ista_kngp, iend_kngp !for mpi
+ ip = (igfp_l(i)-1)*kimg + j
+ chgq_l(i,j,iloop) = afft_mpi1(ip)
+ end do
+ end do
+ End do
+ chgq_l = chgq_l *rinplw
+!
+ deallocate( afft ); deallocate( afft_mpi1 )
+ if ( npes >=2 ) then
+ deallocate( afft_mpi2 ); deallocate( afft_mpi3 )
+ endif
+ call m_FFT_dealloc_CD_box()
+
+ end subroutine remove_imaginary_charge
+
+ end subroutine m_CD_import_chgq_prev_cell
+
+ subroutine m_CD_calc_abs_magetization( nfout )
+ use m_FFT, only : m_FFT_coef_CD_integration_kt
+
+ integer, intent(in) :: nfout
+ real(kind=DP), allocatable :: f2or1(:)
+
+ call m_FFT_alloc_CD_box()
+
+ allocate( f2or1(ista_fftph:iend_fftph) ); f2or1 = 0.0d0
+ call m_FFT_coef_CD_integration_kt( ista_fftph, iend_fftph, f2or1 )
+!
+ if ( noncol ) then
+ call case_noncollinear
+ else
+ call case_collinear
+ endif
+
+ call m_FFT_dealloc_CD_box()
+ deallocate( f2or1 )
+
+ contains
+
+ subroutine case_noncollinear
+ integer :: iloop, i, j, ip
+ real(kind=DP) :: rinplw, csum, csum_mpi
+ real(kind=DP), allocatable :: afft(:), afft_mpi1(:), afft_mpi2(:), afft_mpi3(:)
+
+ allocate(afft(ista_fftp:iend_fftp)); afft =0.0d0
+ allocate(afft_mpi1(nfftp)); afft_mpi1 = 0.0d0
+ if(npes >= 2) then
+ allocate(afft_mpi2(mp_fftp)); afft_mpi2 = 0.0d0
+ allocate(afft_mpi3(mp_fftp)); afft_mpi3 = 0.0d0
+ end if
+
+ rinplw = 1.d0 /product(fft_box_size_CD(1:3,1))
+
+ do iloop = 2, ndim_magmom
+ afft = 0.0d0; afft_mpi1 = 0.d0
+
+ do j = 1, kimg
+ do i = ista_kngp, iend_kngp !for mpi
+ ip = (igfp_l(i)-1)*kimg + j
+ afft_mpi1(ip) = abs( chgq_l(i,j,iloop) )
+ end do
+ end do
+
+ if (npes >= 2) then
+ call mpi_barrier(mpi_comm_group,ierr)
+ do j = 0, npes-1
+ do i = nis_fftp(j),nie_fftp(j)
+ afft_mpi2(i-nis_fftp(j)+1) = afft_mpi1(i)
+ end do
+ call mpi_allreduce(afft_mpi2,afft_mpi3,mp_fftp &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ if(j == mype) then
+ do i = ista_fftp, iend_fftp
+ afft(i) = afft_mpi3(i - ista_fftp + 1)
+ end do
+ end if
+ end do
+ else
+ afft = afft_mpi1
+ end if
+
+ call m_FFT_CD_inverse_c(nfout,afft) ! G-->R space
+!
+ csum = 0.0d0
+ Do i=ista_fftph, iend_fftph
+ csum = csum + f2or1(i) *abs( afft(2*i-1) )
+ End Do
+ if ( npes > 1 ) then
+ call mpi_allreduce( csum, csum_mpi, 1, mpi_double_precision, mpi_sum, &
+ & mpi_comm_group,ierr )
+ csum = csum_mpi /rinplw *univol
+ else
+ csum = csum /rinplw *univol
+ endif
+!
+ if ( iloop == 2 ) then
+ write(nfout,'(A,F14.8)') ' ! absolute magnetization (x) = ', csum
+ else if ( iloop == 3 ) then
+ write(nfout,'(A,F14.8)') ' ! absolute magnetization (y) = ', csum
+ else if ( iloop == 4 ) then
+ write(nfout,'(A,F14.8)') ' ! absolute magnetization (z) = ', csum
+ endif
+ End do
+
+ write(nfout,*)
+
+ deallocate( afft ); deallocate( afft_mpi1 )
+ if ( npes >=2 ) then
+ deallocate( afft_mpi2 ); deallocate( afft_mpi3 )
+ endif
+
+ end subroutine case_noncollinear
+
+ subroutine case_collinear
+ integer :: iloop, i, j, ip
+ real(kind=DP) :: rinplw, csum, csum_mpi
+ real(kind=DP), allocatable :: afft(:), afft_mpi1(:), afft_mpi2(:), afft_mpi3(:)
+ real(kind=DP), allocatable :: bfft(:)
+
+ allocate(afft(ista_fftp:iend_fftp)); afft =0.0d0
+ allocate(bfft(ista_fftp:iend_fftp)); bfft =0.0d0
+
+ allocate(afft_mpi1(nfftp)); afft_mpi1 = 0.0d0
+ if(npes >= 2) then
+ allocate(afft_mpi2(mp_fftp)); afft_mpi2 = 0.0d0
+ allocate(afft_mpi3(mp_fftp)); afft_mpi3 = 0.0d0
+ end if
+
+ rinplw = 1.d0 /product(fft_box_size_CD(1:3,1))
+
+ Do iloop=1, nspin
+ afft = 0.0d0; afft_mpi1 = 0.d0
+ do j = 1, kimg
+ do i = ista_kngp, iend_kngp !for mpi
+ ip = (igfp_l(i)-1)*kimg + j
+ afft_mpi1(ip) = chgq_l(i,j,iloop)
+ end do
+ end do
+
+ if (npes >= 2) then
+ call mpi_barrier(mpi_comm_group,ierr)
+ do j = 0, npes-1
+ do i = nis_fftp(j),nie_fftp(j)
+ afft_mpi2(i-nis_fftp(j)+1) = afft_mpi1(i)
+ end do
+ call mpi_allreduce(afft_mpi2,afft_mpi3,mp_fftp &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ if(j == mype) then
+ do i = ista_fftp, iend_fftp
+ afft(i) = afft_mpi3(i - ista_fftp + 1)
+ end do
+ end if
+ end do
+ else
+ afft = afft_mpi1
+ end if
+
+ call m_FFT_CD_inverse_c(nfout,afft) ! G-->R space
+ if ( iloop == 1 ) then
+ bfft = bfft +afft
+ else
+ bfft = bfft -afft
+! bfft = bfft +afft
+ endif
+ End Do
+
+ csum = 0.0d0
+ if ( kimg == 1 ) then
+ Do i=ista_fftph, iend_fftph
+ csum = csum + f2or1(i) *abs( bfft(2*i-1) )
+ End Do
+ else
+ Do i=ista_fftph, iend_fftph
+ csum = csum + f2or1(i) *abs( bfft(2*i-1) )
+ End Do
+! Do i=ista_fftp, iend_fftp, kimg
+! csum = csum +abs( bfft(i) )
+! End Do
+ endif
+
+ if ( npes > 1 ) then
+ call mpi_allreduce( csum, csum_mpi, 1, mpi_double_precision, mpi_sum, &
+ & mpi_comm_group,ierr )
+ csum = csum_mpi *rinplw *univol
+ else
+ csum = csum /rinplw *univol
+ endif
+!
+ write(nfout,'(A,F14.8)') ' ! absolute magnetization (z) = ', csum
+ write(nfout,*)
+
+ deallocate( afft ); deallocate( afft_mpi1 ); deallocate( bfft )
+ if ( npes >=2 ) then
+ deallocate( afft_mpi2 ); deallocate( afft_mpi3 )
+ endif
+
+ end subroutine case_collinear
+
+ end subroutine m_CD_calc_abs_magetization
+! ====================== 2015/09/24
+
! ============================ added by K. Tagami ======================= 11.0
subroutine m_CD_rd_chgq_import_frm_collin(nfout,nfchgt, F_CHGT_partitioned)
integer, intent(in) :: nfout, nfchgt
@@ -4737,9 +5089,13 @@ contains
! & + op_in_gsp(ii,3,no) *mag_work(ngp,1:kimg,3)
! End Do
Do ii=1, 3
- mag_tmp(1:kimg,ii) = op(ii,1,invop(no)) *mag_work(ngp,1:kimg,1) &
- & + op(ii,2,invop(no)) *mag_work(ngp,1:kimg,2) &
- & + op(ii,3,invop(no)) *mag_work(ngp,1:kimg,3)
+! ! Following three lines are revised according to a report from ASMS Co.ltd, 10 March 2016.
+ mag_tmp(1:kimg,ii) = op(ii,1,int(invop(no))) *mag_work(ngp,1:kimg,1) &
+ & + op(ii,2,int(invop(no))) *mag_work(ngp,1:kimg,2) &
+ & + op(ii,3,int(invop(no))) *mag_work(ngp,1:kimg,3)
+!!$ mag_tmp(1:kimg,ii) = op(ii,1,invop(no)) *mag_work(ngp,1:kimg,1) &
+!!$ & + op(ii,2,invop(no)) *mag_work(ngp,1:kimg,2) &
+!!$ & + op(ii,3,invop(no)) *mag_work(ngp,1:kimg,3)
End Do
! == KT_add === 2014/12/29
@@ -7656,6 +8012,27 @@ contains
end subroutine m_CD_hardpart_hsr_add_noncl
! ======================== 2014/08/25
+ subroutine m_CD_keep_retrieve_hsr(keep)
+ logical, intent(in) :: keep
+ real(kind=DP),allocatable,dimension(:,:,:,:),save :: hsr_tmp
+ real(kind=DP),allocatable,dimension(:,:,:,:),save :: hsi_tmp
+ if(keep)then
+ if ( noncol ) then
+ if (.not.allocated(hsr_tmp)) allocate(hsr_tmp(natm,nlmt,nlmt,ndim_magmom)); hsr_tmp = hsr
+ if (.not.allocated(hsi_tmp)) allocate(hsi_tmp(natm,nlmt,nlmt,ndim_magmom)); hsi_tmp = hsi_tmp
+ else
+ if(.not.allocated(hsr_tmp)) allocate(hsr_tmp(natm,nlmt,nlmt,nspin)); hsr_tmp = hsr
+ endif
+ else
+ hsr = hsr_tmp
+ deallocate(hsr_tmp)
+ if ( noncol ) then
+ hsi = hsi_tmp
+ deallocate(hsi_tmp)
+ endif
+ endif
+ end subroutine m_CD_keep_retrieve_hsr
+
subroutine m_CD_keep_chgq_l()
! =============================== modified y K. Tagami =============== 11.0
!! allocate(chgq_tmp(ista_kngp:iend_kngp,kimg,nspin)); chgq_tmp = 0.d0
diff -uprN phase0_2015.01/src_phase/m_Const_Parameters.F90 phase0_2015.01.01/src_phase/m_Const_Parameters.F90
--- phase0_2015.01/src_phase/m_Const_Parameters.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Const_Parameters.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_Const_Parameters
!
@@ -32,7 +32,7 @@
!
!***************************************************************
module m_Const_Parameters
-! $Id: m_Const_Parameters.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Const_Parameters.F90 472 2015-11-28 09:01:17Z ktagami $
implicit none
integer, parameter :: DRIVER_GENERAL=0, DRIVER_CONSTRAINT=1, DRIVER_NEB=2, DRIVER_PHONON=3 &
@@ -363,6 +363,11 @@ end type unitlist
integer, parameter :: BULK = 1
integer, parameter :: DEFECT = 2
+integer, parameter :: Positron_CONV = 1 ! zero-density limit, non-scf
+ ! calc p- wfns once
+integer, parameter :: Positron_GGGC = 2 ! zero-density limit, scf
+ ! update e- and p- wfns successively
+integer, parameter :: Positron_PSN = 3 ! fully two-component scf
! ========================== KT_mod =================== 13.0B
!integer, parameter :: unit_list_size = 50
diff -uprN phase0_2015.01/src_phase/m_Control_Parameters.F90 phase0_2015.01.01/src_phase/m_Control_Parameters.F90
--- phase0_2015.01/src_phase/m_Control_Parameters.F90 2015-09-14 15:17:49.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Control_Parameters.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 453 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 492 $)
!
! MODULE: m_Control_Parameters
!
@@ -49,7 +49,7 @@
!
module m_Control_Parameters
! (m_CtrlP)
-! $Id: m_Control_Parameters.F90 453 2015-09-01 05:22:55Z ktagami $
+! $Id: m_Control_Parameters.F90 492 2016-05-31 03:06:04Z jkoga $
!
! This module "m_Control_Parameters" holds parameters that give
! methods and calculational conditions in jobs.
@@ -109,13 +109,10 @@ module m_Control_Parameters
! ============================================================== 11.0
use m_ErrorMessages, only : INVALID_CHARGE_MIXING
-! ====== KT_add ========================================= 13.0E
- use m_Const_Parameters, only : FERMI_DIRAC, CONST_kB
-! ========= ============================================= 13.0E
-
-! ====== KT_add ========================================= 13.0U3
- use m_Const_Parameters, only : STEPWISE
-! ========= ============================================= 13.0U3
+! ====== KT_add ========================================= 13.0E, 13.0U3, positron
+ use m_Const_Parameters, only : FERMI_DIRAC, CONST_kB, STEPWISE, &
+ & Positron_CONV, Positron_GGGC, Positron_PSN
+! ======================================================= 13.0E, 13.0U3, positron
implicit none
include 'mpif.h'
@@ -230,6 +227,15 @@ module m_Control_Parameters
real(kind=DP) :: epsilon_ele
integer :: sw_positron_file = ON
integer :: positron_filetype = CUBE
+
+ integer :: positron_method = Positron_CONV
+
+ character(len("positron_method")),private,parameter :: &
+ & tag_positron_method = "positron_method"
+ character(len("conv")),private,parameter :: tag_conv = "conv"
+ character(len("gggc")),private,parameter :: tag_gggc = "gggc"
+ character(len("psn")),private,parameter :: tag_psn = "psn"
+
character(len=LEN_TITLE) :: positron_title(5)
data positron_title / &
& "positron density", "valence electron density", "e-p pair density" &
@@ -570,6 +576,7 @@ module m_Control_Parameters
#endif
! === KT_add === 13.1R
+ integer :: sw_raman = OFF
integer :: sw_phonon_with_epsilon = OFF
integer :: sw_calc_dielectric_tensor = OFF
! ============== 13.1R
@@ -657,6 +664,19 @@ module m_Control_Parameters
integer :: sw_neglect_stress_offdiagonal = OFF
! ==== 2014/11/22
+! ==== EXP_CELLOPT === 2015/09/24
+! -----------------------
+! read nfchgt.data of previous cell
+! -----------------------
+ character(len("sw_read_nfchgt_prev_cell")),private,parameter :: &
+ & tag_sw_read_nfchgt_prev_cell = "sw_read_nfchgt_prev_cell"
+ character(len("sw_read_nfzaj_prev_cell")),private,parameter :: &
+ & tag_sw_read_nfzaj_prev_cell = "sw_read_nfzaj_prev_cell"
+
+ integer :: sw_read_nfchgt_prev_cell = OFF
+ integer :: sw_read_nfzaj_prev_cell = OFF
+! ==================== 2015/09/24
+
! -------------------
! symmetry during optimization
! ------------------
@@ -856,6 +876,7 @@ module m_Control_Parameters
character(len("none")),private,parameter :: tag_none = "none"
character(len("0")),private,parameter :: tag_0 = "0"
character(len("unit_matrix")),private,parameter :: tag_unit_matrix = "unit_matrix"
+ character(len("spin_polarized")),private,parameter :: tag_spin_polarized = "spin_polarized"
! === For restart lm+MSD! by tkato 2012/02/16 ==================================
character(len("dtim_previous")), private, parameter :: tag_dtim_previous = "dtim_previous"
! ==============================================================================
@@ -1098,6 +1119,7 @@ module m_Control_Parameters
!!$ real(kind=DP),private :: edelta_change_to_rmm = 1.d-7
real(kind=DP),private :: edelta_change_to_rmm = 1.d-3
real(kind=DP),private :: edelta_change_to_rmm_md = 1.d-3
+ logical,private :: edelta_rmm_given = .false.
integer,public :: rmm_save_memory_mode = OFF
character(len("rmm")),private,parameter :: tag_rmm = "rmm"
character(len("imGSrmm")),private,parameter :: tag_imGSrmm = "imgsrmm"
@@ -1147,11 +1169,17 @@ module m_Control_Parameters
real(kind=DP) :: damp = 1.d0
integer :: submat_period = 1
real(kind=DP) :: submat_critical_ratio = 1.d-15
+#ifdef _USE_SCALAPACK_
+ integer :: sw_scalapack = ON
+#else
integer :: sw_scalapack = OFF
+#endif
#ifdef _DEFAULT_HOUSEHOLDER_
integer :: method_scalapack = HOUSEHOLDER
-#else
+#elif _DEFAULT_DIVIDEandCONQUER_
integer :: method_scalapack = DIVIDEandCONQUER
+#else
+ integer :: method_scalapack = HOUSEHOLDER
#endif
!finteger :: block_size = 64
integer :: block_size = 0
@@ -1442,12 +1470,16 @@ module m_Control_Parameters
& tag_sw_mix_charge_hardpart = "sw_mix_charge_hardpart"
character(len("sw_mix_bothspins_sametime")), private, parameter :: &
& tag_sw_mix_bothspins_sametime = "sw_mix_bothspins_sametime"
+ character(len("sw_mix_occ_matrix")),private,parameter :: &
+ & tag_sw_mix_occ_matrix = "sw_mix_occ_matrix"
!!$ integer :: sw_mix_charge_hardpart = OFF
!!$ integer :: sw_mix_bothspins_sametime = OFF
integer :: sw_mix_charge_hardpart = OFF
integer :: sw_mix_bothspins_sametime = ON
!
!
+ integer :: sw_mix_occ_matrix = OFF
+
character(len("sw_force_simple_mixing_hsr")), private, parameter :: &
& tag_sw_force_simplemix_hsr = "sw_force_simple_mixing_hsr"
character(len("sw_recomposing_hsr")), private, parameter :: &
@@ -1642,6 +1674,7 @@ module m_Control_Parameters
integer,public :: dos_method = Gauss_distrib_func
integer,public :: sw_dos_gaussdistrib = OFF
integer,public :: dos_subroutine = 5
+
real(kind=DP),public :: deltaE_dos = 1.d-4
real(kind=DP),public :: variance_dos_GaussD = 1.d-6
integer,public :: nwd_dos_window_width = 10
@@ -1760,7 +1793,17 @@ module m_Control_Parameters
character(len("ry")),private,parameter :: tag_ry = "ry"
character(len("rz")),private,parameter :: tag_rz = "rz"
-! ---- WaveFuction Squared
+! ---- WaveFunction Orb-projection
+ integer :: sw_print_wf_orb_projection = OFF
+ integer :: wf_orb_proj_print_format = 0
+ character(len("wf_orb_projection")),private,parameter :: &
+ & tag_wf_orb_projection = "wf_orb_projection"
+ character(len("sw_print_wf_orb_projection")),private,parameter :: &
+ & tag_sw_print_wf_orb_projection = "sw_print_wf_orb_projection"
+ character(len("wf_orb_proj_print_format")),private,parameter :: &
+ & tag_wf_orb_proj_print_format = "wf_orb_proj_print_format"
+
+! ---- WaveFunction Squared
integer :: sw_wf_squared_rspace = OFF
integer,public :: wf_squared_filetype = CUBE
integer,public :: ik_wf_squared = 1
@@ -1805,7 +1848,7 @@ module m_Control_Parameters
! --- approximate DFT+U : Hubbard model ---
integer :: sw_hubbard = OFF
integer :: sw_constraint = OFF
- integer :: initial_occmat = SPIN_POLARIZED
+ integer :: initial_occmat = OFF
real(kind=DP) :: initial_occmat_factor=1.d0
integer :: const_site = 0
real(kind=DP) :: const_alpha = 0.d0
@@ -2071,6 +2114,7 @@ module m_Control_Parameters
character(len("always")), private, parameter :: tag_always = "always"
character(len("minimal")), private, parameter :: tag_minimal = "minimal"
+
! ======= KT_add === 13.0Y
! Partial Core correction ( paw, hybrid,... )
!
@@ -2322,6 +2366,13 @@ module m_Control_Parameters
integer :: lmax_rsb = 3
real(kind=DP) :: eps_rsb = 1.d-2
+! --- msb effect
+ character(len("msb")), private, parameter :: &
+ & tag_msb = "msb"
+ character(len("sw_calc_contact_density")), private, parameter :: &
+ & tag_sw_calc_contact_density = "sw_calc_contact_density"
+ integer :: sw_calc_contact_density = off
+
! ================= KT_add === 13.0S
!-- CoreLevels
!
@@ -2437,6 +2488,7 @@ module m_Control_Parameters
integer :: nr12=3000,nk=1500
real(kind=DP) :: maxk=10.d0,r12max=30.0d0
logical :: oneshot = .true.
+ logical :: sw_save_memory_vdw = .true.
logical :: force_exx_energy1=.false.
@@ -2543,6 +2595,10 @@ contains
if(printable) &
& write(nfout,'(" !** rmm_precal_phase_matm(redefined) = ",i10," <<m_CtrlP_check_matm>>")') rmm_precal_phase_matm
end if
+ if(.not.edelta_rmm_given)then
+ edelta_change_to_rmm = 1.d-3/dble(natm)
+ edelta_change_to_rmm_md = 1.d-3/dble(natm)
+ endif
end subroutine m_CtrlP_check_matm
subroutine alloc_w_solver(n)
@@ -3095,12 +3151,12 @@ contains
logical :: tf
call strncmp0(trim(rstr), tag_bulk, tf)
if(tf) then
- sw_positron = BULK
+ sw_positron = BULK; positron_method = Positron_CONV
goto 1001
end if
call strncmp0(trim(rstr), tag_defect, tf)
if(tf) then
- sw_positron = DEFECT
+ sw_positron = DEFECT; positron_method = Positron_GGGC
goto 1001
end if
1001 continue
@@ -3164,8 +3220,10 @@ contains
if( f_getStringValue( tag_smearing_method, rstr,LOWER) == 0) then
call set_smearing_method(rstr) ! way_of_smearing
end if
- if( f_getRealValue( tag_smearing_width, dret, "hartree") == 0) width = dret
- if(way_of_smearing == TETRAHEDRON) width_tetra = width
+ if( f_getRealValue( tag_smearing_width, dret, "hartree") == 0) then
+ width = dret
+ if(way_of_smearing == TETRAHEDRON) width_tetra = width
+ endif
if( f_selectBlock( tag_tetrahedron) == 0) then
if( f_getIntValue( tag_dimension, iret ) == 0) idimtetra = iret
if( f_getIntValue( tag_sw_correction, iret ) == 0) sw_correction = iret
@@ -3291,6 +3349,28 @@ contains
if( f_getIntValue( tag_f3, iret ) == 0) reduction_factor_exx(3) = iret
iret = f_selectParentBlock()
end if
+ if(f_getStringValue(tag_functional_type,rstr,LOWER)==0)then
+ if(rstr.eq.tag_pbe0) then
+ write(nfout,'(a)') ' !** functional_type : PBE0'
+ alpha_exx = 0.25d0
+ sw_screened_exchange = OFF
+ sw_exchange_only = OFF
+ else if (rstr.eq.tag_hse06) then
+ write(nfout,'(a)') ' !** functional_type : HSE06'
+ alpha_exx = 0.25d0
+ omega_exx = 0.106d0
+ sw_screened_exchange = ON
+ sw_exchange_only = OFF
+ else if (rstr.eq.tag_hf) then
+ write(nfout,'(a)') ' !** functional_type : HF (Hartree-Fock)'
+ alpha_exx = 1.d0
+ sw_screened_exchange = OFF
+ sw_exchange_only = ON
+ else
+ write(nfout,'(a)') ' !** WARNING : invalid functional_type : '//trim(rstr)
+ endif
+ endif
+
if( f_getRealValue( tag_alpha, dret, "") == 0) alpha_exx = dret
if( f_getRealValue( tag_omega, dret, "") == 0) omega_exx = dret
if( f_getRealValue( tag_omega_hf, dret, "") == 0) omega_exx = dret
@@ -3314,6 +3394,7 @@ contains
endif
endif
+
! ============================= KT_Test ============================ 12.5Exp
nmax_G_hyb = -1
if( f_getIntValue( tag_nmax_G_hyb, iret ) == 0 ) then
@@ -3408,27 +3489,6 @@ contains
if(rstr.eq.tag_minimal) potential_update = 2
endif
- if(f_getStringValue(tag_functional_type,rstr,LOWER)==0)then
- if(rstr.eq.tag_pbe0) then
- write(nfout,'(a)') ' !** functional_type : PBE0'
- alpha_exx = 0.25d0
- sw_screened_exchange = OFF
- sw_exchange_only = OFF
- else if (rstr.eq.tag_hse06) then
- write(nfout,'(a)') ' !** functional_type : HSE06'
- alpha_exx = 0.25d0
- omega_exx = 0.106d0
- sw_screened_exchange = ON
- sw_exchange_only = OFF
- else if (rstr.eq.tag_hf) then
- write(nfout,'(a)') ' !** functional_type : HF (Hartree-Fock)'
- alpha_exx = 1.d0
- sw_screened_exchange = OFF
- sw_exchange_only = ON
- else
- write(nfout,'(a)') ' !** WARNING : invalid functional_type : '//trim(rstr)
- endif
- endif
if(ipriinputfile>=1) then
write(nfout,'(" <<< Hybrid functional method >>>")')
if(sw_exchange_only==ON) &
@@ -3809,6 +3869,20 @@ contains
end if
! ------- Positron start
+ iret = f_getStringValue(tag_positron_method,rstr,LOWER)
+ if( rstr == tag_CONV ) then
+ positron_method = Positron_CONV; sw_positron = BULK
+ else if( rstr == tag_GGGC ) then
+ positron_method = Positron_GGGC; sw_positron = DEFECT
+ else if( rstr == tag_PSN ) then
+ positron_method = Positron_PSN; sw_positron = DEFECT
+ stop "Positron-PSN : Not implemented"
+ end if
+ if ( sw_positron /= OFF ) then
+ write(nfout,*) "!** Positron_method is set to ", positron_method
+ if ( gmax_positron < 0.01 ) call getgmax_positron()
+ endif
+
if(sw_positron /= OFF) then
npeg = 1
num_extra_pev = 0
@@ -4431,6 +4505,7 @@ write(nfout,'(" !** sw_screening_correct
if(f_getRealValue(tag_a1,dret,'')==0) a1 = dret
if(f_getRealValue(tag_a2,dret,'')==0) a2 = dret
if(f_getIntValue(tag_eval_kernel_by_interpolation,iret)==0) eval_kernel_by_interpolation = iret == ON
+ if(f_getIntValue(tag_save_memory_mode,iret)==0) sw_save_memory_vdw = iret == ON
iret = f_selectParentBlock()
endif
@@ -4466,7 +4541,6 @@ write(nfout,'(" !** sw_screening_correct
subroutine set_initial_occmat(rstr)
character(len=FMAXVALLEN),intent(in) :: rstr
logical :: tf
- initial_occmat = SPIN_POLARIZED
call strncmp2(rstr, FMAXVALLEN, tag_off, len(tag_off), tf)
if(.not.tf) call strncmp0(trim(rstr),tag_off, tf)
if(.not.tf) call strncmp0(trim(rstr),tag_none,tf)
@@ -4482,6 +4556,12 @@ write(nfout,'(" !** sw_screening_correct
goto 1001
endif
+ call strncmp0(trim(rstr), tag_spin_polarized, tf)
+ if(tf) then
+ initial_occmat = SPIN_POLARIZED
+ goto 1001
+ endif
+
call strncmp0(trim(rstr), tag_initial_es, tf)
if(tf) then
sw_initial_es = ON
@@ -4685,8 +4765,8 @@ write(nfout,'(" !** sw_screening_correct
end subroutine m_CtrlP_rd_accuracy
#ifndef _EMPIRICAL_
- subroutine m_CtrlP_rd_wfsolver(nfout)
- integer, intent(in) :: nfout
+ subroutine m_CtrlP_rd_wfsolver(nfout,natm)
+ integer, intent(in) :: nfout,natm
integer :: f_selectBlock, f_getIntValue, f_getRealValue, f_getStringValue
integer :: f_selectParentBlock, f_selectTop
integer :: iret,i,ba
@@ -4712,9 +4792,9 @@ write(nfout,'(" !** sw_screening_correct
! determine the default value for the davidson-related variables
if(neg/nrank_e<4) then
sw_divide_subspace=OFF
+ if(printable) write(nfout,'(" !** REMARK: sw_divide_subspace is set to OFF ")')
sw_divide_subspace_changed = .true.
sw_npartition_changed = .true.
- if(printable) write(nfout,'(" !** REMARK: sw_divide_subspace is set to OFF ")')
else
npartition_david = neg/(nblock*nrank_e)
if (npartition_david<1) npartition_david = 1
@@ -4724,7 +4804,7 @@ write(nfout,'(" !** sw_screening_correct
if(.not.explict_solver)then
tag_solver_of_WF_is_found = .true.
- call configure_wf_solver(solver_set)
+ call configure_wf_solver(solver_set,natm)
meg = neg
endif
@@ -4881,6 +4961,11 @@ write(nfout,'(" !** sw_screening_correct
end if
! ---- rmm ---
+ if( explict_solver )then
+ edelta_change_to_rmm = 1.e-3/dble(natm)
+ edelta_change_to_rmm_md = 1.e-3/dble(natm)
+ endif
+
if( f_selectBlock( tag_rmm) == 0) then
if(ipriinputfile >= 2 .and. printable) write(nfout,'(" !** -- tag_rmm is found --")')
if( f_getIntValue(tag_imGSrmm, iret) == 0) imGSrmm = iret
@@ -4891,9 +4976,11 @@ write(nfout,'(" !** sw_screening_correct
if( f_getRealValue(tag_edelta_change_to_rmm,dret,'hartree')==0) then
edelta_change_to_rmm = dret
edelta_change_to_rmm_md = dret
+ edelta_rmm_given = .true.
endif
if(f_getRealValue(tag_edelta_change_to_rmm_md,dret,'hartree')==0)then
edelta_change_to_rmm_md = dret
+ edelta_rmm_given = .true.
endif
if( f_getIntValue(tag_save_memory_mode, iret) == 0) rmm_save_memory_mode = iret
iret = f_selectParentBlock()
@@ -4963,6 +5050,11 @@ write(nfout,'(" !** sw_screening_correct
write(nfout,'(" !** before_renewal= OFF")')
end if
end if
+
+!!$!BRANCH_P 3D_Parallel
+!!$ if(nrank_k>=2) sw_scalapack = OFF
+!!$ ! This is a tentative default setting until scalapack parallelization is completed for nrank_k>=2
+!!$!BRANCH_P_END 3D_Parallel
if( f_selectBlock( tag_scalapack) == 0) then
if( f_getIntValue(tag_sw_scalapack, iret) == 0) sw_scalapack = iret
#ifndef _USE_SCALAPACK_
@@ -5086,8 +5178,11 @@ write(nfout,'(" !** sw_screening_correct
iret = f_selectParentBlock()
else
max_subspace_size = 4*neg ! default value
- if(ipriinputfile >= 2 .and. printable) &
- & write(nfout,'(" !* tag_davidson is not found")')
+!!$ if(ipriinputfile >= 2 .and. printable) &
+ if(ipriinputfile >= 1 .and. printable) then
+ write(nfout,'(" !* tag_davidson is not found")')
+ write(nfout,'(" !** max_subspace_size = ",i6)') max_subspace_size
+ end if
end if
! ---- Modified Davidson ---
@@ -5205,19 +5300,19 @@ write(nfout,'(" !** sw_screening_correct
1001 continue
end subroutine set_energy_evaluation
- subroutine configure_wf_solver(solver_set)
- integer, intent(in) :: solver_set
+ subroutine configure_wf_solver(solver_set,natm)
+ integer, intent(in) :: solver_set,natm
integer :: i
if(solver_set == LMM_RMM)then
call alloc_w_solver(2)
w_solver(1)%solver = lmMSD
w_solver(1)%subspace_rotation = ON
- w_solver(1)%till_n_iter = 2
+ w_solver(1)%till_n_iter = 5
w_solver(2)%solver = RMM3
w_solver(2)%till_n_iter = -1
w_solver(2)%subspace_rotation = ON
- edelta_change_to_rmm = 1.d-4
- edelta_change_to_rmm_md = 1.d-4
+ edelta_change_to_rmm = 1.d-4/dble(natm)
+ edelta_change_to_rmm_md = 1.d-4/dble(natm)
n_WF_solvers_before = 2
n_WF_solvers_after = 0
n_WF_solvers_all = n_WF_solvers_before + n_WF_solvers_after
@@ -5226,18 +5321,25 @@ write(nfout,'(" !** sw_screening_correct
call alloc_w_solver(4)
if(icond==INITIAL .or. icond==CONTINUATION .or. icond==AUTOMATIC)then
w_solver(1)%solver = MDDAVIDSON
+ w_solver(3)%solver = MDDAVIDSON
else
w_solver(1)%solver = MDKOSUGI
+ w_solver(3)%solver = MDKOSUGI
+ endif
+ if(sw_hubbard==ON) then
+ w_solver(1)%solver = MDKOSUGI
+ w_solver(3)%solver = MDKOSUGI
endif
- if(sw_hubbard==ON) w_solver(1)%solver = MDKOSUGI
-
! === KT_add === 2015/01/05
- if ( noncol ) w_solver(1)%solver = MDDAVIDSON
+ if ( noncol ) then
+ w_solver(1)%solver = MDDAVIDSON
+ w_solver(3)%solver = MDDAVIDSON
+ endif
! ============== 2015/01/05
! w_solver(1)%solver = MDKOSUGI
w_solver(1)%subspace_rotation = ON
- w_solver(1)%till_n_iter = 2
+ w_solver(1)%till_n_iter = 5
w_solver(1)%precon = ON
w_solver(1)%before_or_after_convergence = BEFORE
w_solver(2)%solver = RMM3
@@ -5245,9 +5347,9 @@ write(nfout,'(" !** sw_screening_correct
w_solver(2)%till_n_iter = -1
w_solver(2)%subspace_rotation = ON
w_solver(2)%before_or_after_convergence = BEFORE
- w_solver(3)%solver = MDDAVIDSON
+ !!w_solver(3)%solver = MDDAVIDSON
w_solver(3)%subspace_rotation = ON
- w_solver(3)%till_n_iter = 1
+ w_solver(3)%till_n_iter = 5
w_solver(3)%precon = ON
w_solver(3)%before_or_after_convergence = AFTER
w_solver(4)%solver = RMM3
@@ -5255,8 +5357,8 @@ write(nfout,'(" !** sw_screening_correct
w_solver(4)%till_n_iter = -1
w_solver(4)%subspace_rotation = ON
w_solver(4)%before_or_after_convergence = AFTER
- edelta_change_to_rmm = 1.d-3
- edelta_change_to_rmm_md = 1.d-3
+ edelta_change_to_rmm = 1.d-3/dble(natm)
+ edelta_change_to_rmm_md = 1.d-3/dble(natm)
n_WF_solvers_before = 2
n_WF_solvers_after = 2
n_WF_solvers_all = n_WF_solvers_before + n_WF_solvers_after
@@ -5300,15 +5402,15 @@ write(nfout,'(" !** sw_screening_correct
!!$if (sw_hubbard==ON.or.nspin>1) sw_divide_subspace=OFF
if (printable) write(nfout,'(" !** applied wavefunction solver set : davidson")')
endif
- if (n_WF_solvers_before>1)then
- if(intzaj == by_matrix_diagon)then
- do i=1,n_WF_solvers_before-1
- w_solver(i)%till_n_iter = i+1
- enddo
- else
- w_solver(1)%till_n_iter = 1
- endif
- endif
+ !if (n_WF_solvers_before>1)then
+ ! if(intzaj == by_matrix_diagon)then
+ ! do i=1,n_WF_solvers_before-1
+ ! w_solver(i)%till_n_iter = i+4
+ ! enddo
+ ! else
+ ! w_solver(1)%till_n_iter = 5
+ ! endif
+ !endif
end subroutine configure_wf_solver
subroutine set_wfsolvers(prealloc,msol,nbase,ba,iret)
@@ -5831,9 +5933,19 @@ write(nfout,'(" !** sw_screening_correct
write(nfout,*) '!** sw_neglect_stress_offdiagonal is ', iret
endif
! === 2014/11/22
-
! ======== 13.1AS
+! === EXP_CELLOPT === 2015/09/24
+ if ( f_getIntValue( tag_sw_read_nfchgt_prev_cell, iret ) ==0 ) then
+ sw_read_nfchgt_prev_cell = iret
+ write(nfout,*) '!** sw_read_nfchgt_prev_cell is ', iret
+ endif
+ if ( f_getIntValue( tag_sw_read_nfzaj_prev_cell, iret ) ==0 ) then
+ sw_read_nfzaj_prev_cell = iret
+ write(nfout,*) '!** sw_read_nfzaj_prev_cell is ', iret
+ endif
+! ================== 2015/09/24
+
iret = f_selectParentBlock()
endif
@@ -6063,6 +6175,8 @@ write(nfout,'(" !** sw_screening_correct
endif
! ======================================================================= 5.0
+ if(f_getIntValue(tag_sw_mix_occ_matrix,iret)==0) sw_mix_occ_matrix = iret
+
! ================================ added by K. Tagami ================== 11.0
if (f_getIntValue( tag_sw_mix_imaginary_hardpart,iret ) == 0 ) then
sw_mix_imaginary_hardpart = iret
@@ -7195,6 +7309,23 @@ write(nfout,'(" !** sw_screening_correct
iret = f_selectParentBlock()
end if
+ if ( f_selectBlock( tag_wf_orb_projection ) == 0 ) then
+ if ( f_getIntValue( tag_sw_print_wf_orb_projection, iret ) == 0 ) then
+ sw_print_wf_orb_projection = iret
+ endif
+ if ( f_getIntValue( tag_wf_orb_proj_print_format, iret ) == 0 ) then
+ if ( iret < 0 .or. iret > 1 ) iret = 0
+ wf_orb_proj_print_format = iret
+ endif
+ if (ipriinputfile >= 1) then
+ write(nfout,'(A,I6)') " !** sw_print_wf_orb_projection = ", &
+ & sw_print_wf_orb_projection
+ write(nfout,'(A,i6,A)') "!** wf_orb_proj_print_format = ", &
+ & wf_orb_proj_print_format, " ( 0: {l m t}, 1: {j l mj t} )"
+ endif
+ iret = f_selectParentBlock()
+ endif
+
if( f_selectBlock( tag_wf_squared ) == 0 ) then
if( f_getIntValue( tag_sw_wf_squared_rspace, iret) == 0) &
& sw_wf_squared_rspace = iret
@@ -7224,6 +7355,14 @@ write(nfout,'(" !** sw_screening_correct
iret = f_selectParentBlock()
endif
+ if( f_selectBlock( tag_msb ) == 0) then
+ if( f_getIntValue( tag_sw_calc_contact_density, iret) == 0) then
+ sw_calc_contact_density = iret
+ write(nfout,*) "!** sw_calc_contact_density is ", iret
+ endif
+ iret = f_selectParentBlock()
+ endif
+
if( f_selectBlock( tag_elf) == 0) then
if(ipriinputfile >= 2) write(nfout,'(" !* tag_elf")')
if( f_getIntValue( tag_sw_elf, iret) == 0) sw_elf = iret
@@ -8844,9 +8983,9 @@ write(nfout,'(" !** sw_screening_correct
if(printable) write(6,'(" iconvergence_previous_job is reset " &
& ,i2,", because neg_previous < neg")') iconvergence_previous_job
end if
- if(sw_optimize_lattice==ON)then
- iconvergence_previous_job = 0
- endif
+ !if(sw_optimize_lattice==ON)then
+ ! iconvergence_previous_job = 0
+ !endif
end subroutine m_CtrlP_rd_iconvergence
subroutine m_CtrlP_reset_iconvergence
diff -uprN phase0_2015.01/src_phase/m_Crystal_Structure.F90 phase0_2015.01.01/src_phase/m_Crystal_Structure.F90
--- phase0_2015.01/src_phase/m_Crystal_Structure.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Crystal_Structure.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 464 $)
!
! MODULE: m_Crystal_Structure
!
@@ -33,7 +33,7 @@
!
module m_Crystal_Structure
! (m_CS)
-! $Id: m_Crystal_Structure.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Crystal_Structure.F90 464 2015-09-23 14:29:53Z ktagami $
!!$ use m_Files, only : nfout,nfopgr,nfmatbp &
use m_Timing, only : tstatc0_begin, tstatc0_end
use m_Control_Parameters, only : ipri, af, m_CtrlP_set_af, m_CtrlP_set_nspin_and_af &
@@ -272,8 +272,10 @@ module m_Crystal_Structure
character(len("level_of_projection_paw_charge")), private, parameter :: &
& tag_level_projection_paw_charge = "level_of_projection_paw_charge"
+! --- magnetic moment
character(len("axis")),private,parameter :: tag_axis = "axis"
character(len("direction")),private,parameter :: tag_direction = "direction"
+ character(len("moment")),private,parameter :: tag_moment = "moment"
character(len("magnetic_moment")),private,parameter :: tag_magnetic_moment &
& = "magnetic_moment"
@@ -384,18 +386,31 @@ module m_Crystal_Structure
character(len("edelta_change_lambda_last")), private, parameter :: &
& tag_edelta_change_lambda_last = "edelta_change_lambda_last"
!
- character(len("max_iterations_constraint")), private, parameter :: &
- & tag_max_iterations_constraint = "max_iterations_constraint"
+ character(len("max_iter_elec_mag_constraint")), private, parameter :: &
+ & tag_max_iter_elec_mag_constr = "max_iter_elec_mag_constraint"
+ character(len("max_iter_ion_mag_constraint")), private, parameter :: &
+ & tag_max_iter_ion_mag_constr = "max_iter_ion_mag_constraint"
+ character(len("max_iter_cell_mag_constraint")), private, parameter :: &
+ & tag_max_iter_cell_mag_constr = "max_iter_cell_mag_constraint"
!
+ character(len("sw_fix_charge_after_constraint")), private, parameter :: &
+ & tag_sw_fix_charge_after_constr = "sw_fix_charge_after_constraint"
+
integer, parameter :: nmax_intermid_lambda = 100
!
integer :: sw_magnetic_constraint = OFF
integer :: mag_constraint_type = 0
- integer :: damping_method_mag_constraint = 0
- integer :: num_intermid_lambda = 0
- integer :: max_iterations_mag_constraint = 0
+ integer :: damping_method_mag_constraint = ABRUPT
+ integer :: num_intermid_lambda = 2
+!
+ integer :: max_iter_elec_mag_constraint = 50
+ integer :: max_iter_ion_mag_constraint = 1
+! integer :: max_iter_cell_mag_constraint = 100
+ integer :: max_iter_cell_mag_constraint = 1
+
+ integer :: sw_fix_charge_after_constraint = OFF
!
- real(kind=DP) :: mag_constraint_lambda = 0.0d0
+ real(kind=DP) :: mag_constraint_lambda = 0.20d0
real(kind=DP) :: edelta_change_lambda_first = 1.0D-4 ! hartree
real(kind=DP) :: edelta_change_lambda_last = 1.0D-4 ! hartree
! ======================================================== 13.0U
@@ -1294,9 +1309,9 @@ contains
if ( damping_method_mag_constraint == ABRUPT .or. &
& damping_method_mag_constraint == LINEAR ) then
- if ( f_getIntValue( tag_max_iterations_constraint, iret ) == 0 ) then
- if ( iret < 0 ) max_iterations_mag_constraint = 0
- max_iterations_mag_constraint = iret
+ if ( f_getIntValue( tag_max_iter_elec_mag_constr, iret ) == 0 ) then
+ if ( iret < 0 ) max_iter_elec_mag_constraint = 0
+ max_iter_elec_mag_constraint = iret
endif
endif
@@ -1313,10 +1328,27 @@ contains
if ( damping_method_mag_constraint == ABRUPT .or. &
& damping_method_mag_constraint == LINEAR ) then
- write(nfout,*) '! max_iterations_mag_constraint is ', &
- & max_iterations_mag_constraint
+ write(nfout,*) '! max_iter_elec_mag_constraint is ', &
+ & max_iter_elec_mag_constraint
endif
+ if ( f_getIntValue( tag_max_iter_ion_mag_constr, iret ) == 0 ) then
+ if ( iret < 0 ) max_iter_ion_mag_constraint = 0
+ max_iter_ion_mag_constraint = iret
+ endif
+ if ( f_getIntValue( tag_max_iter_cell_mag_constr, iret ) == 0 ) then
+ if ( iret < 0 ) max_iter_cell_mag_constraint = 0
+ max_iter_cell_mag_constraint = iret
+ endif
+
+ if ( f_getIntValue( tag_sw_fix_charge_after_constr, iret ) == 0 ) then
+ sw_fix_charge_after_constraint = iret
+ write(nfout,*) '! sw_fix_charge_after_constraint is ', &
+ & sw_fix_charge_after_constraint
+ endif
+
+ write(nfout,*) '! max_iter_ion_mag_constraint is ', max_iter_ion_mag_constraint
+ write(nfout,*) '! max_iter_cell_mag_constraint is ', max_iter_cell_mag_constraint
write(nfout,*) '! *********************************************** '
@@ -1356,6 +1388,9 @@ contains
if ( f_getRealValue( tag_norm, dret, "" ) == 0 ) then
norm = dret
end if
+ if ( f_getRealValue( tag_moment, dret, "" ) == 0 ) then
+ norm = dret
+ end if
if ( f_getRealValue( tag_theta, dret, "" ) == 0 ) then
theta = dret
end if
@@ -1373,8 +1408,10 @@ contains
else
if ( f_getRealValue( tag_norm, dret, "" ) == 0 ) then
- norm = dret
- mag_moment0_global(1) = norm
+ norm = dret; mag_moment0_global(1) = norm
+ end if
+ if ( f_getRealValue( tag_moment, dret, "" ) == 0 ) then
+ norm = dret; mag_moment0_global(1) = norm
end if
endif
@@ -1410,7 +1447,8 @@ contains
mag_direc0_global(2) = 0.0d0
mag_direc0_global(3) = 1.0d0
- if ( f_selectBlock( tag_direction ) == 0 ) then
+ if ( f_selectBlock( tag_direction ) == 0 .or. &
+ & f_selectBlock( tag_magnetic_moment ) == 0 ) then
if( f_getRealValue( tag_mdx, dret, '') == 0 ) then
mdx = dret; Flag = 1
@@ -1421,6 +1459,16 @@ contains
if( f_getRealValue( tag_mdz, dret, '') == 0 ) then
mdz = dret; Flag = 1
endif
+
+ if( f_getRealValue( tag_mx, dret, '') == 0 ) then
+ mdx = dret; Flag = 1
+ endif
+ if( f_getRealValue( tag_my, dret, '') == 0 ) then
+ mdy = dret; Flag = 1
+ endif
+ if( f_getRealValue( tag_mz, dret, '') == 0 ) then
+ mdz = dret; Flag = 1
+ endif
cnorm = sqrt( mdx**2 + mdy**2 + mdz**2 )
if ( abs(cnorm) > 1.0E-4 ) then
diff -uprN phase0_2015.01/src_phase/m_ES_ExactExchange.F90 phase0_2015.01.01/src_phase/m_ES_ExactExchange.F90
--- phase0_2015.01/src_phase/m_ES_ExactExchange.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_ExactExchange.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 485 $)
!
! MODULE: m_ES_ExactExchange
!
@@ -35,7 +35,7 @@ module m_ES_ExactExchange
use m_Electronic_Structure,only: totch,zaj_l,occup_l,neordr,eko_l,vnlph_l,fsr_l,fsi_l
use m_NonLocal_Potential, only : snl
use m_PlaneWaveBasisSet, only : ngabc,igf,kg1,kg,kgp,nbase,nbmx,iba,m_pwBS_kinetic_energies &
- & , nbase_gamma,igfp_l,ngpt_l,m_pwBS_sphrp_exx,kgp_exx, igfp_exx
+ & , nbase_gamma,igfp_l,ngpt_l,m_pwBS_sphrp_exx,kgp_exx, igfp_exx, n_rGpv
use m_Kpoints, only : kv3,vkxyz,kv3_ek,vkxyz_ek,k_symmetry,qwgt,qwgt_ek,mp_index &
& , m_Kp_sample_mesh, kshift
use m_FFT, only : nfft,fft_box_size_WF &
@@ -50,7 +50,7 @@ module m_ES_ExactExchange
& , nlmta,lmta,lmtt,ltp,mtp,taup,nloc,m_PP_find_maximum_l &
& , m_PP_tell_lmtt_l_m_tau &
& , m_PP_set_index_arrays1,m_PP_set_index_arrays2 &
- & , radr,xh,rmax,nmesh,mmesh, qrspspw
+ & , radr,xh,rmax,nmesh,mmesh, qrspspw, nlmtt
use m_Files, only : nfout
use m_Timing, only : tstatc0_begin,tstatc0_end
@@ -70,6 +70,8 @@ module m_ES_ExactExchange
& , nrank_e,nrank_k,myrank_e,map_e,ista_e,iend_e,istep_e,idisp_e &
& , map_z,np_e,mpi_k_world,mpi_e_world,myrank_k,map_k,ista_k,iend_k &
& , ista_kg1_k, np_kg1_k, mp_kg1_k &
+! & , m_Parallel_mpi_nval,np_nval, mp_nval,ista_kngp_exx,iend_kngp_exx &
+ & , ista_kngp_exx,iend_kngp_exx &
#ifdef TRANSPOSE
& , ierr,mp_e,nis_e,nie_e,nel_e
#else
@@ -92,7 +94,7 @@ module m_ES_ExactExchange
integer :: nval_old
integer :: nfftwf
integer :: ntrs ! ntrs = 1, if TRS is used. Otherwise, ntrs=0
- integer, allocatable :: ngpt_exx(:,:,:) ! d(kgp,nopr,0:ntrs)
+ integer, allocatable :: ngpt_exx(:,:,:) ! d(kg,nopr,0:ntrs)
#ifndef MEMORY_SAVE_EXX
real(kind=DP), allocatable :: qitg_exx(:,:,:) ! d(kgp,nqitg,nqmk)
real(kind=DP), allocatable :: ylm_exx(:,:,:) ! d(kgp,maxylm,nqmk)
@@ -187,6 +189,7 @@ module m_ES_ExactExchange
real(kind=DP), allocatable, dimension(:,:) :: qrsps_mm
real(kind=DP), allocatable, dimension(:) :: h, radr_kept, wos_kept
#endif
+ integer, save :: id_sname_cdfft = -1
include 'mpif.h' ! MPI
contains
@@ -463,6 +466,7 @@ contains
end subroutine m_ES_EXX_move_k_into_fbz
subroutine m_ES_EXX_init0
+ integer :: ii,ie
if(potential_update>0) then
if(.not.allocated(exx_potential)) allocate(exx_potential(kg1,np_e,ista_k:iend_k,kimg));exx_potential = 0.d0
endif
@@ -470,7 +474,7 @@ contains
subroutine m_ES_EXX_init
implicit none
- integer :: ik, ikbz, ii,ierr
+ integer :: ik, ikbz, ii,ierr,ie
real(kind=DP) :: dk(3)
integer,save :: id_sname = -1
call tstatc0_begin('m_ES_EXX_init ',id_sname,level=1)
@@ -655,11 +659,15 @@ contains
real(kind=DP), allocatable :: efsr_l(:,:) ! d(np_e,nlmta)
real(kind=DP), allocatable :: efsi_l(:,:) ! d(np_e,nlmta)
+
logical :: trans
+ integer, allocatable, dimension(:) :: ista
integer,save :: id_sname = -1
if(sw_update_wfv==OFF) return
+ allocate(ista(MPI_STATUS_SIZE))
+
trans = .true.
if(present(transform)) trans = transform
call tstatc0_begin('m_ES_EXX_gather_valence_states ',id_sname,level=1)
@@ -691,6 +699,7 @@ contains
nval = ibm
end if
+
if(allocated(wfv)) deallocate(wfv)
if(allocated(occup_val)) deallocate(occup_val)
allocate(wfv(kg1,nval,kv3,kimg))
@@ -727,25 +736,23 @@ contains
deallocate(efsi_l)
end if
- if(npes>1) then
- allocate(wfv_mpi(kg1,nval,kv3,kimg))
- allocate(occup_val_mpi(nval,kv3))
- call mpi_allreduce(wfv,wfv_mpi,kg1*nval*kv3*kimg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
- call mpi_allreduce(occup_val,occup_val_mpi,nval*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
- wfv = wfv_mpi
- occup_val = occup_val_mpi
- deallocate(wfv_mpi)
- deallocate(occup_val_mpi)
- if(modnrm == EXECUT) then
- allocate(fsr_mpi(nval,nlmta,kv3))
- allocate(fsi_mpi(nval,nlmta,kv3))
- call mpi_allreduce(fsr_exx,fsr_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
- call mpi_allreduce(fsi_exx,fsi_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
- fsr_exx = fsr_mpi
- fsi_exx = fsi_mpi
- deallocate(fsr_mpi)
- deallocate(fsi_mpi)
- end if
+ allocate(wfv_mpi(kg1,nval,kv3,kimg))
+ allocate(occup_val_mpi(nval,kv3))
+ call mpi_allreduce(wfv,wfv_mpi,kg1*nval*kv3*kimg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
+ call mpi_allreduce(occup_val,occup_val_mpi,nval*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
+ wfv = wfv_mpi
+ occup_val = occup_val_mpi
+ deallocate(wfv_mpi)
+ deallocate(occup_val_mpi)
+ if(modnrm == EXECUT) then
+ allocate(fsr_mpi(nval,nlmta,kv3))
+ allocate(fsi_mpi(nval,nlmta,kv3))
+ call mpi_allreduce(fsr_exx,fsr_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
+ call mpi_allreduce(fsi_exx,fsi_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
+ fsr_exx = fsr_mpi
+ fsi_exx = fsi_mpi
+ deallocate(fsr_mpi)
+ deallocate(fsi_mpi)
end if
if(sw_rspace_hyb==ON .and. modnrm==EXECUT.and.sw_precalculate==ON)then
@@ -763,6 +770,7 @@ contains
enddo
endif
+ deallocate(ista)
call tstatc0_end(id_sname)
end subroutine m_ES_EXX_gather_valence_states
@@ -824,13 +832,14 @@ contains
integer :: ik,ikbz,ig,kgs
real(kind=DP) :: fac, wi, kg(3), vzero, g2
real(kind=DP), dimension(6) :: ttr
-
+ integer :: igs,ige
integer,save :: id_sname = -1
call tstatc0_begin('m_ES_EXX_kernel ',id_sname,level=1)
-!!$ allocate(vc(kgp,nqmk))
if(.not.allocated(vc)) allocate(vc(nmax_G_hyb,nqmk))
+ vc = 0.d0
+
call getttr(rltv,ttr)
fac = PAI4/univol
@@ -849,7 +858,8 @@ contains
kgs=2
vc(1,ik) = vzero
end if
- do ig=kgs,nmax_G_hyb
+ igs = kgs;ige=nmax_G_hyb
+ do ig=igs,ige
kg(1:3) = qmk(ik,1:3) + ngabc(ig,1:3)
g2 = ttr(1)*kg(1)*kg(1) &
& + ttr(2)*kg(2)*kg(2) &
@@ -868,7 +878,8 @@ contains
kgs=2
vc(1,ik) = vzero
end if
- do ig=kgs,nmax_G_hyb
+ igs = kgs;ige=nmax_G_hyb
+ do ig=igs,ige
kg(1:3) = qmk(ik,1:3) + ngabc(ig,1:3)
g2 = ttr(1)*kg(1)*kg(1) &
& + ttr(2)*kg(2)*kg(2) &
@@ -926,7 +937,7 @@ contains
real(kind=DP) :: chig
real(kind=DP), intent(in) :: gam
- integer :: ig, ikbz, kgs
+ integer :: ig, ikbz, kgs, igs, ige
real(kind=DP) :: sumg, sumgk
sumg = 0.d0
@@ -1017,6 +1028,8 @@ contains
real(kind=DP) :: ene
integer :: ig,iadd
logical :: store_p
+ real(kind=DP), allocatable, dimension(:) :: zajbuf_r,zajbuf_i
+ integer :: kgw,kgv
integer :: id_sname=-1
call tstatc0_begin('m_ES_EXX_potential ',id_sname,level=1)
store_p = .true.
@@ -1029,7 +1042,7 @@ contains
iup = 2
if(present(iupdate)) iup = iupdate
if(iup.lt.potential_update)then
- vxw(:,1:kimg) = exx_potential(:,ib,ik,:)
+ vxw(1:iba(ik),1:kimg) = exx_potential(1:iba(ik),ib,ik,1:kimg)
if(present(exx))then
exx=0.d0
if(kimg==1)then
@@ -1056,21 +1069,20 @@ contains
allocate(efsr_l(nlmta));efsr_l=0.d0
allocate(efsi_l(nlmta));efsi_l=0.d0
if(modnrm == EXECUT) call get_expkt_fs_b(ik,ib,fsr,fsi,efsr_l,efsi_l)
+ allocate(zajbuf_r(kg1));zajbuf_r(:) = zaj_l(:,ib,ik,1)
+ allocate(zajbuf_i(kg1));zajbuf_i(:) = zaj_l(:,ib,ik,kimg)
+ kgw = kg1;kgv=kg1
+
if(present(exx))then
- if(kimg==1)then
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,1), efsr_l, efsr_l, vxw, ene, eo )
- else
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,2), efsr_l, efsi_l, vxw, ene, eo )
- endif
+ call apply_Vx_to_WF( ispin, ib, ik, kgw, kgv, zajbuf_r, zajbuf_i, efsr_l, efsi_l, vxw, ene, eo )
else
- if(kimg==1)then
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,1), efsr_l, efsr_l, vxw)
- else
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,2), efsr_l, efsi_l, vxw)
- endif
+ call apply_Vx_to_WF( ispin, ib, ik, kgw, kgv, zajbuf_r, zajbuf_i, efsr_l, efsi_l, vxw )
endif
+
deallocate(efsr_l)
deallocate(efsi_l)
+ deallocate(zajbuf_r)
+ deallocate(zajbuf_i)
if(present(exx)) exx = ene
if(.not.eo.and.potential_update>0.and.store_p) &
& exx_potential(1:iba(ik),ib,ik,1:kimg) = vxw(1:iba(ik),1:kimg)
@@ -1153,6 +1165,8 @@ contains
real(kind=DP), allocatable, dimension(:,:,:,:) :: vxdi_t
integer,save :: id_sname = -1
+
+
call tstatc0_begin('m_ES_EXX_Diagonal_part ',id_sname,level=1)
@@ -1222,6 +1236,7 @@ contains
call tstatc0_end(id_sname)
end subroutine m_ES_EXX_Diagonal_part
+
subroutine m_ES_EXX_add_Diagonal_part(ik,ibo,vxdi,vnldi)
implicit none
integer, intent(in) :: ik, ibo
@@ -1298,12 +1313,12 @@ contains
end if
end subroutine m_ES_Vexx_add_vexx
- subroutine apply_Vx_to_WF(ispin,ib,ik,wfr,wfi,bdwr,bdwi,vxw,eexx,eonly,force_l,dbdwr,dbdwi)
+ subroutine apply_Vx_to_WF(ispin,ib,ik,kgw,kgv,wfr,wfi,bdwr,bdwi,vxw,eexx,eonly,force_l,dbdwr,dbdwi)
implicit none
- integer, intent(in) :: ispin, ib,ik
- real(kind=DP), intent(in), dimension(kg1) :: wfr, wfi
+ integer, intent(in) :: ispin, ib,ik,kgw,kgv
+ real(kind=DP), intent(in), dimension(kgw) :: wfr, wfi
real(kind=DP), intent(in), dimension(nlmta) :: bdwr, bdwi
- real(kind=DP), intent(out), optional, dimension(kg1,kimg) :: vxw
+ real(kind=DP), intent(out), optional, dimension(kgv,kimg) :: vxw
real(kind=DP), intent(out), optional :: eexx
logical, intent(in), optional :: eonly
@@ -1480,9 +1495,11 @@ contains
call add_RHOG_hard_part_rs2(iqmk(jkbz,ik),rhor,rhoi,&
& fsrqm(:,:,m,jkbz,ispin),fsiqm(:,:,m,jkbz,ispin),bdwr,bdwi)
endif
+ call tstatc0_begin('FFT_CD_exx ',id_sname_cdfft,1)
call map_RHOG_on_FFT_box_hard(rhor,rhoi,afft)
call m_FFT_CD0_exx(nfout,afft,DIRECT)
call map_FFT_box_on_RHOG_hard(rhor,rhoi,afft)
+ call tstatc0_end(id_sname_cdfft)
do ii=1,nmax_G_hyb
rhogr(ii) = rhogr(ii) + rhor(ii)
rhogi(ii) = rhogi(ii) + rhoi(ii)
@@ -1506,9 +1523,11 @@ contains
!
if (modnrm == EXECUT) then
if(sw_rspace_hyb==ON)then
+ call tstatc0_begin('FFT_CD_exx ',id_sname_cdfft,1)
call map_RHOG_on_FFT_box_hard_inv(rhogr,rhogi,afft)
call m_FFT_CD0_exx(nfout,afft,INVERSE)
call map_FFT_box_on_RHOG_hard_inv(rhor,rhoi,afft)
+ call tstatc0_end(id_sname_cdfft)
if(force_mode)then
call integrate_QijVnm_rs(iqmk(jkbz,ik),rhor,rhoi,fsr,fsi,qvr,qvi,dfsr,dfsi,dqvr,dqvi,gqvr,gqvi)
else
@@ -1611,6 +1630,7 @@ contains
call tstatc0_end(id_sname)
end subroutine apply_Vx_to_WF
+
subroutine m_ES_EXX_energy2(eexx)
implicit none
real(kind=DP), intent(out) :: eexx
@@ -1678,6 +1698,7 @@ contains
end if
end subroutine product_on_FFT_box
+
subroutine sum_rho_vc_rho(rhor,rhoi,vc,exx)
implicit none
real(kind=DP), intent(in), dimension(nmax_G_hyb) :: rhor,rhoi
@@ -1960,7 +1981,7 @@ contains
integer :: i,i1,i2
- afft(:) = 0.d0
+! afft(:) = 0.d0
do i = 1, nfftp_exx_nonpara/2
! i1 = (igfp_l(i)-1)*kimg+1
i1 = (i-1)*kimg+1
@@ -2009,8 +2030,8 @@ contains
integer :: i,i1,i2
rinplw = 1.d0/product(fft_box_size_CD_exx(1:3,1))
- rhor(:)=0.d0
- rhoi(:)=0.d0
+! rhor(:)=0.d0
+! rhoi(:)=0.d0
do i = 1, nfftp_exx_nonpara/2
i1 = (i-1)*kimg+1
rhor(i) = afft(i1)*rinplw
@@ -2024,66 +2045,119 @@ contains
integer :: i,j,iopr,ii
integer :: ia,ib,ic
integer :: namin,namax,nbmin,nbmax,ncmin,ncmax
- integer, allocatable, dimension(:,:) :: ngpt_t
integer, allocatable, dimension(:,:,:) :: g_list
+ integer, allocatable, dimension(:) :: ngpt_exx_tmp, ngpt_exx0_tmp
integer,save :: id_sname = -1
call tstatc0_begin('m_ES_EXX_ngpt ',id_sname,level=1)
- allocate(ngpt_exx(kgp,nopr,0:ntrs)); ngpt_exx = 0
+!!$ allocate(ngpt_exx(kgp,nopr,0:ntrs)); ngpt_exx = 0
+ allocate(ngpt_exx(kg,nopr,0:ntrs)); ngpt_exx = 0
+
+ !! Time reversal symmetry
+
+ if(ntrs>0) then
+
+ namax = n_rGpv(1); nbmax = n_rGpv(2); ncmax = n_rGpv(3)
+ namin = -namax ; nbmin = -nbmax ; ncmin = -ncmax
+ allocate(g_list(namin:namax,nbmin:nbmax,ncmin:ncmax)); g_list = 0
+
+ do i = 1, kgp
+ ia = ngabc(i,1)
+ ib = ngabc(i,2)
+ ic = ngabc(i,3)
+ g_list(ia,ib,ic) = i
+ end do
+ end if
if(npes > 1) then
- allocate(ngpt_t(kgp,nopr)); ngpt_t = 0
+ allocate(ngpt_exx0_tmp(kgp))
do iopr=1,nopr
+ ngpt_exx0_tmp = 0
do i = ista_kngp, iend_kngp
- ngpt_t(i,iopr) = ngpt_l(i,iopr)
+ ngpt_exx0_tmp(i) = ngpt_l(i,iopr)
end do
+ call mpi_allreduce(MPI_IN_PLACE,ngpt_exx0_tmp,kgp,mpi_integer,mpi_sum,mpi_comm_group,ierr)
+ ngpt_exx(1:kg,iopr,0) = ngpt_exx0_tmp(1:kg)
+
+ if(ntrs>0) then
+ allocate(ngpt_exx_tmp(kg))
+ ngpt_exx_tmp = 0
+ do i=1,kg
+ ii = ngpt_exx0_tmp(i)
+ ia = -ngabc(ii,1)
+ ib = -ngabc(ii,2)
+ ic = -ngabc(ii,3)
+ ngpt_exx_tmp(i) = g_list(ia,ib,ic)
+ end do
+ ngpt_exx(1:kg,iopr,1) = ngpt_exx_tmp(1:kg)
+ end if
end do
- call mpi_allreduce(ngpt_t,ngpt_exx,kgp*nopr,mpi_integer,mpi_sum,mpi_comm_group,ierr)
- deallocate(ngpt_t)
+ deallocate(ngpt_exx0_tmp)
else
do iopr=1,nopr
- do i = ista_kngp, iend_kngp
- ngpt_exx(i,iopr,0) = ngpt_l(i,iopr)
- end do
+ if(ntrs==0) then
+ do i = 1, kg
+ ngpt_exx(i,iopr,0) = ngpt_l(i,iopr)
+ end do
+ else
+ do i = 1, kg
+ ngpt_exx(i,iopr,0) = ngpt_l(i,iopr)
+ ii = ngpt_l(i,iopr)
+ ia = -ngabc(ii,1)
+ ib = -ngabc(ii,2)
+ ic = -ngabc(ii,3)
+ ngpt_exx(i,iopr,1) = g_list(ia,ib,ic)
+ end do
+ end if
end do
end if
- !! Time reversal symmetry
-
- if(ntrs>0) then
-
- namin = 0; namax = 0
- nbmin = 0; nbmax = 0
- ncmin = 0; ncmax = 0
- do i=1,kgp
- ia = ngabc(i,1)
- ib = ngabc(i,2)
- ic = ngabc(i,3)
- namin = min(ia,namin)
- namax = max(ia,namax)
- nbmin = min(ib,nbmin)
- nbmax = max(ib,nbmax)
- ncmin = min(ic,ncmin)
- ncmax = max(ic,ncmax)
- end do
- allocate(g_list(namin:namax,nbmin:nbmax,ncmin:ncmax))
- do i=1,kgp
- ia = ngabc(i,1)
- ib = ngabc(i,2)
- ic = ngabc(i,3)
- g_list(ia,ib,ic) = i
- end do
- do iopr=1,nopr
- do i=1,kgp
- ii = ngpt_exx(i,iopr,0)
- ia = -ngabc(ii,1)
- ib = -ngabc(ii,2)
- ic = -ngabc(ii,3)
- ngpt_exx(i,iopr,1) = g_list(ia,ib,ic)
+!!$ allocate(ngpt_exx_tmp(kgp))
+!!$ do iopr=1,nopr
+!!$ ngpt_exx_tmp = 0
+!!$ do i=1,kgp
+!!$ ii = ngpt_exx(i,iopr,0)
+!!$ if(ista_kngp<=ii .and. ii<=iend_kngp) then
+!!$ ia = -ngabc_kngp_l(ii,1)
+!!$ ib = -ngabc_kngp_l(ii,2)
+!!$ ic = -ngabc_kngp_l(ii,3)
+!!$ ngpt_exx_tmp(i) = g_list(ia,ib,ic)
+!!$ end if
+!!$ end do
+!!$ call mpi_allreduce(MPI_IN_PLACE, ngpt_exx_tmp, kgp, mpi_integer, mpi_sum,mpi_ke_world,ierr)
+!!$ ngpt_exx(:,iopr,1) = ngpt_exx_tmp(:)
+!!$ end do
+!!$ deallocate(ngpt_exx_tmp)
+!!$
+!!$ ia = -ngabc(ii,1)
+!!$ ib = -ngabc(ii,2)
+!!$ ic = -ngabc(ii,3)
+!!$ ngpt_exx(i,iopr,1) = g_list(ia,ib,ic)
+!!$ end do
+!!$ end do
+ if(ntrs>0) deallocate(g_list)
+
+ j = 0
+ do ii = 0, ntrs
+ do iopr = 1, nopr
+ do i = 1, kg
+ if(ngpt_exx(i,iopr,ii) <= 0) j = j + 1
+ end do
end do
end do
- deallocate(g_list)
- end if
+ if(j >= 1) then
+ write(nfout,'(" !! check of ngpt_exx")')
+ do ii = 0, ntrs
+ do iopr = 1, nopr
+ do i = 1, kg
+ if(ngpt_exx(i,iopr,ii) <= 0) write(nfout,'(" ngpt_exx(",i8,",",i8,",",i8,") = ",i20)') &
+ & i,iopr,ii, ngpt_exx(i,iopr,ii)
+ end do
+ end do
+ end do
+ write(nfout,'(" !! total number of negative values for ngpt_exx = ",i8)') j
+ write(nfout,'(" !! out of check of ngpt_exx")')
+ end if
call tstatc0_end(id_sname)
!!!stop 'Check: G_list'
@@ -2279,9 +2353,10 @@ contains
deallocate(ylm_t)
else
do i=1,n
- call m_pwBS_sphrp_exx(i,rltv,ista_kngp,iend_kngp,gqmk,gqmkr,ylm_exx(1,i,ik))
+ call m_pwBS_sphrp_exx(i,rltv,1,nmax_G_hyb,gqmk,gqmkr,ylm_exx(1,i,ik))
end do
end if
+
end do
!!stop 'm_ES_EXX_ylm'
deallocate(gqmk)
@@ -2322,7 +2397,7 @@ contains
gqmkr(ig) = sqrt(g2)
end do
do i = 1, n
- call m_pwBS_sphrp_exx(i,rltv,1,kgp,gqmk,gqmkr,ylm_exx(1,i))
+ call m_pwBS_sphrp_exx(i,rltv,1,nmax_G_hyb,gqmk,gqmkr,ylm_exx(1,i))
end do
deallocate(gqmk)
deallocate(gqmkr)
@@ -2334,16 +2409,17 @@ contains
#ifndef MEMORY_SAVE_MORE_EXX
subroutine check_qitg()
implicit none
- integer :: iq
+ integer :: iq, ips , ipe
+
+ ips = 1
+ ipe = nmax_G_hyb
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"qitg_l=",f20.5,1x,"qitg_exx=",f20.5,1x)') &
- & iq, qitg_l(1,iq), qitg_exx(1,iq,1)/univol
+ write(nfout,'("iq=",i5,1x,"qitg_l=",f20.5,1x,"qitg_exx=",f20.5,1x)') iq, qitg_l(ips,iq), qitg_exx(ips,iq,1)/univol
end do
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"diff=",f20.5)') &
- & iq, sum(qitg_l(1:nmax_G_hyb,iq)-qitg_exx(1:nmax_G_hyb,iq,1)/univol)
+ write(nfout,'("iq=",i5,1x,"diff=",f20.5)') iq, sum(qitg_l(ips:ipe,iq)-qitg_exx(ips:ipe,iq,1)/univol)
end do
stop 'check_qitg'
@@ -2351,19 +2427,20 @@ contains
subroutine check_qitg_qmk()
implicit none
- integer :: iq, ik
+ integer :: iq, ik, ips, ipe
+
+ ips = 1
+ ipe = nmax_G_hyb
do ik=1,nqmk
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"qitg_exx=",f20.5,1x)') &
- & iq, qitg_exx(1,iq,ik)/univol
+ write(nfout,'("iq=",i5,1x,"qitg_exx=",f20.5,1x)') iq, qitg_exx(ips,iq,ik)/univol
end do
end do
do ik=1,nqmk
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"sum=",f20.5)') &
- & iq, sum(qitg_exx(1:nmax_G_hyb,iq,ik)/univol)
+ write(nfout,'("iq=",i5,1x,"sum=",f20.5)') iq, sum(qitg_exx(ips:ipe,iq,ik)/univol)
end do
end do
@@ -2374,23 +2451,24 @@ contains
#ifndef MEMORY_SAVE_EXX
subroutine check_ylm_exx()
implicit none
- integer :: i, n, ik
+ integer :: i, n, ik, ips, ipe
call m_PP_find_maximum_l(n) ! n-1: maximum l
n = (n-1) + (n-1) + 1
n = n*n
+ ips = 1
+ ipe = nmax_G_hyb
+
do ik=1,nqmk
do i=1,n
- write(nfout,'("i=",i5,1x,"ylm_exx=",f20.5,1x)') &
- & i, ylm_exx(1,i,ik)
+ write(nfout,'("i=",i5,1x,"ylm_exx=",f20.5,1x)') i, ylm_exx(ips,i,ik)
end do
end do
do ik=1,nqmk
do i=1,n
- write(nfout,'("i=",i5,1x,"sum=",f20.5)') &
- & i, sum(qitg_exx(1:nmax_G_hyb,i,ik))
+ write(nfout,'("i=",i5,1x,"sum=",f20.5)') i, sum(qitg_exx(ips:ipe,i,ik))
end do
end do
@@ -2438,6 +2516,7 @@ contains
preproc_done = .true.
end subroutine hard_part_preproc
+
subroutine add_RHOG_hard_part(iqmk,rhogr,rhogi,fnr,fni,fmr,fmi)
implicit none
integer, intent(in) :: iqmk
@@ -2458,7 +2537,7 @@ contains
real(kind=DP), allocatable :: qitg_red(:,:),ylm_red(:,:)
real(kind=DP), allocatable :: rhogr_red(:),rhogi_red(:)
real(kind=DP) :: yr,yi
- integer :: ibl1,ibl2,iq,inn,ip,m
+ integer :: ibl1,ibl2,iq,inn,ip,m, ips, ipe
integer,save :: id_sname = -1
@@ -2476,13 +2555,13 @@ contains
allocate(rhogr_red(ibsize))
allocate(rhogi_red(ibsize))
! --
- do ibl1=1, nmax_G_hyb, ibsize
- rhogr_red=0.d0; rhogi_red=0.d0
-
- ibl2=ibl1+ibsize-1
+ ips = 1
+ ipe = nmax_G_hyb
- if (ibl2.gt.nmax_G_hyb) ibl2 = nmax_G_hyb
+ do ibl1=ips, ipe, ibsize
+ rhogr_red=0.d0; rhogi_red=0.d0
+ ibl2=min(ipe,ibl1+ibsize-1)
do iq=1,nqitg
do i=1,ibl2-ibl1+1
#if defined(MEMORY_SAVE_EXX) && defined(MEMORY_SAVE_MORE_EXX)
@@ -2714,6 +2793,7 @@ contains
enddo
end subroutine qmk_dot_r
+
! ================================== KT_Test ========================= 12.5Exp
subroutine integrate_QijVnm(iqmk,potr,poti,fmr,fmi,qvr,qvi,dfmr,dfmi,dqvr,dqvi,gqvr,gqvi)
implicit none
@@ -2739,7 +2819,7 @@ contains
real(kind=DP), allocatable :: zsr(:), zsi(:)
real(kind=DP), allocatable :: qitg_red(:,:),ylm_red(:,:)
- integer :: ibl1,ibl2,iq,inn,ip,m
+ integer :: ibl1,ibl2,iq,inn,ip,m, ips, ipe
logical :: force_mode = .false.
real(kind=DP), allocatable :: gvec(:,:)
real(kind=DP) :: er(3), ei(3)
@@ -2760,9 +2840,12 @@ contains
allocate(qitg_red(ibsize,nqitg))
allocate(ylm_red(ibsize,n*n))
if(force_mode) allocate(gvec(ibsize,3))
- do ibl1=1, nmax_G_hyb, ibsize
- ibl2=ibl1+ibsize-1
- if(ibl2.gt.nmax_G_hyb) ibl2=nmax_G_hyb
+
+ ips = 1
+ ipe = nmax_G_hyb
+
+ do ibl1=ips, ipe, ibsize
+ ibl2=min(ipe,ibl1+ibsize-1)
do iq=1,nqitg
do i=1,ibl2-ibl1+1
#if defined(MEMORY_SAVE_EXX) && defined(MEMORY_SAVE_MORE_EXX)
@@ -3263,13 +3346,15 @@ contains
implicit none
real(kind=DP), intent(out) :: force(natm,3)
- integer :: ik,ib,ig,ispin,ia
+ integer :: ik,ib,ig,ispin,ia,iadd
real(kind=DP), allocatable :: force_l(:,:) ! d(natm,3)
real(kind=DP), allocatable :: force_mpi(:,:) ! d(natm,3)
real(kind=DP), allocatable :: efsr_l(:,:) ! d(np_e,nlmta)
real(kind=DP), allocatable :: efsi_l(:,:) ! d(np_e,nlmta)
real(kind=DP), allocatable :: defsr_l(:,:,:) ! d(np_e,nlmta,3)
real(kind=DP), allocatable :: defsi_l(:,:,:) ! d(np_e,nlmta,3)
+ real(kind=DP), allocatable, dimension(:) :: zajbuf_r,zajbuf_i
+ integer :: kgw,kgv
integer,save :: id_sname = -1
if(modnrm /= EXECUT) then
@@ -3303,16 +3388,22 @@ contains
do ib=1,np_e ! MPI
if(occup_l(ib,ik) < DELTA) cycle
force_l = 0.d0
+ allocate(zajbuf_r(kg1));zajbuf_r(:) = zaj_l(:,ib,ik,1)
+ allocate(zajbuf_i(kg1));zajbuf_i(:) = zaj_l(:,ib,ik,kimg)
+ kgw = kg1;kgv=kg1
+
if(kimg==1) then
- call apply_Vx_to_WF(ispin,ib,ik,zaj_l(1,ib,ik,1),zaj_l(1,ib,ik,1) &
+ call apply_Vx_to_WF(ispin,ib,ik,kgw,kgv,zajbuf_r,zajbuf_r &
& ,efsr_l(ib,1:nlmta),efsr_l(ib,1:nlmta) &
& ,dbdwr=dfsr_l(ib,1:nlmta,ik,1:3),dbdwi=dfsr_l(ib,1:nlmta,ik,1:3),force_l=force_l)
else
- call apply_Vx_to_WF(ispin,ib,ik,zaj_l(1,ib,ik,1),zaj_l(1,ib,ik,2) &
+ call apply_Vx_to_WF(ispin,ib,ik,kgw,kgv,zajbuf_r,zajbuf_i &
& ,efsr_l(ib,1:nlmta),efsi_l(ib,1:nlmta) &
& ,dbdwr=dfsr_l(ib,1:nlmta,ik,1:3),dbdwi=dfsi_l(ib,1:nlmta,ik,1:3),force_l=force_l)
end if
force = force + occup_l(ib,ik) * force_l
+ deallocate(zajbuf_r)
+ deallocate(zajbuf_i)
end do
end do
end do
diff -uprN phase0_2015.01/src_phase/m_ES_IO.F90 phase0_2015.01.01/src_phase/m_ES_IO.F90
--- phase0_2015.01/src_phase/m_ES_IO.F90 2015-09-14 15:18:05.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_IO.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 459 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 487 $)
!
! MODULE: m_ES_IO
!
@@ -58,7 +58,7 @@
!
module m_ES_IO
-! $Id: m_ES_IO.F90 459 2015-09-10 08:50:04Z yamasaki $
+! $Id: m_ES_IO.F90 487 2016-05-17 05:20:42Z ktagami $
use m_Electronic_Structure, only : zaj_l,neordr,nrvf_ordr,eko_l,occup_l,efermi,efermi_spin,totch&
& ,vnlph_l,vlhxc_l,eko_ek
use m_Electronic_Structure, only : m_ES_WF_in_Rspace
@@ -95,21 +95,37 @@ module m_ES_IO
use m_Control_Parameters, only : ndim_magmom, ik_wf_squared, &
& ib1_wf_squared, ib2_wf_squared, &
- & wf_squared_filetype
+ & wf_squared_filetype, max_projs, proj_attribute, &
+ & ndim_chgpot, SpinOrbit_Mode, &
+ & wf_orb_proj_print_format, proj_group, num_proj_elems
+ use m_Const_parameters, only : Neglected
use m_Files, only : nfwfk_sq, m_Files_open_nfwfksq_noncl, &
& nfwfk_integ_mom, &
& m_Files_open_nfwfk_integ_mom, &
- & m_Files_close_nfwfk_integ_mom
- use m_PseudoPotential, only : nlmt, ilmt, lmta, q
+ & m_Files_close_nfwfk_integ_mom, &
+ & m_Files_open_nfwfk_orb_proj, &
+ & m_Files_close_nfwfk_orb_proj, &
+ & nfwfk_orb_proj
+ use m_PseudoPotential, only : nlmt, ilmt, lmta, q, &
+ & nlmta_phi, nlmtt_phi, qorb, m_PP_tell_iorb_lmt, &
+ & m_PP_tell_iorb_ia_l_m_tau, ilmt_phi, &
+ & mtp_phi, lmta_phi, ltp_phi, taup_phi
+ use m_Nonlocal_Potential, only : norm_phig
use m_Charge_Density, only : chgq_l, hsr, hsi, &
& m_CD_softpart_ktsub_noncl, &
& m_CD_hardpart_ktsub_noncl, &
& m_CD_alloc_rspace_charge, &
& m_CD_dealloc_rspace_charge, &
& m_CD_rspace_charge_noncl
- use m_Ionic_System, only : ityp
- use m_Electronic_Structure, only : fsr_l, fsi_l
+ use m_Ionic_System, only : ityp, iproj_group
+ use m_Electronic_Structure, only : fsr_l, fsi_l, compr_l, compi_l
use m_ES_Noncollinear, only : m_ES_set_Pauli_Matrix
+ use m_SpinOrbit_Potential, only : MatU_ylm_RC_L0, MatU_ylm_RC_L1, MatU_ylm_RC_L2, &
+ & MatU_ylm_RC_L3
+
+! ==== EXP_CELLOPT ==== 2015/09/24
+ use m_PlaneWaveBasisSet, only : kg1_prev
+! ===================== 2015/09/24
implicit none
include 'mpif.h'
@@ -732,13 +748,15 @@ contains
if(mode == EIGEN_VALUES) then
write(nf,'(" ik = ",i4," ",8f12.6)') ik, (e_mpi(nb,ik),nb=ie1,ie2)
else if(mode == OCCUPATIONS) then
- write(nf,'(" ik = ",i4," ",8f12.6)') ik, (o_mpi(nb,ik)/(qwgt(ik)*kv3),nb=ie1,ie2)
+ write(nf,'(" ik = ",i4," ",8f12.6)') ik, &
+ & (o_mpi(nb,ik)/(qwgt(ik)*kv3/ndim_spinor),nb=ie1,ie2)
end if
else
if(mode == EIGEN_VALUES) then
write(nf,'(12x,8f12.6)') (e_mpi(nb,ik),nb=ie1,ie2)
else if(mode == OCCUPATIONS) then
- write(nf,'(12x,8f12.6)') (o_mpi(nb,ik)/(qwgt(ik)*kv3),nb=ie1,ie2)
+ write(nf,'(12x,8f12.6)') &
+ & (o_mpi(nb,ik)/(qwgt(ik)*kv3/ndim_spinor),nb=ie1,ie2)
end if
end if
end do
@@ -1066,6 +1084,117 @@ contains
__TIMER_SUB_STOP(1372)
end subroutine m_ESIO_rd_WFs
+! ==== EXP_CELLOPT ==== 2015/09/24
+ subroutine m_ESIO_import_WFs_prev_cell(nfout,nfzaj, F_ZAJ_partitioned)
+ integer, intent(in) :: nfout, nfzaj
+ logical, intent(in) :: F_ZAJ_partitioned
+ integer :: ik,ib,ri, i
+ integer :: id_sname = -1
+ integer :: ierror
+
+ call tstatc0_begin('m_ESIO_import_WFs_prev_cell ',id_sname)
+
+ if(precision_WFfile==SP) then
+ if(ipri >= 1) write(nfout,*) ' !D Reading zaj (single_precision)'
+ else
+ if(ipri >= 1) write(nfout,*) ' !D Reading zaj (double_precision)'
+ end if
+ if(precision_WFfile==SP) then
+ allocate(wf_l(kg1_prev,kimg)); wf_l = 0.d0
+ else
+ allocate(wfdp_l(kg1_prev,kimg)); wfdp_l = 0.d0
+ end if
+ rewind nfzaj
+
+ zaj_l = 0.0d0
+
+ if(F_ZAJ_partitioned) then
+ do ik = ista_k, iend_k, af+1 ! MPI
+
+ do ib = ista_e, iend_e, istep_e ! MPI
+ if(ib > neg_previous) cycle
+
+ if(precision_WFfile==SP) then
+ read(nfzaj) wf_l
+
+ if(kimg == 1) then
+ do i = 1, min( kg1, kg1_prev )
+ zaj_l(i,map_z(ib),ik,1) = wf_l(i,1)
+ end do
+ else if(kimg==2) then
+ do i = 1, min( kg1, kg1_prev )
+ zaj_l(i,map_z(ib),ik,1) = wf_l(i,1)
+ zaj_l(i,map_z(ib),ik,2) = wf_l(i,2)
+ end do
+ end if
+ else if(precision_WFfile==DP) then
+ read(nfzaj) wfdp_l
+
+ if(kimg == 1) then
+ do i = 1, min( kg1, kg1_prev )
+ zaj_l(i,map_z(ib),ik,1) = wfdp_l(i,1)
+ end do
+ else if(kimg==2) then
+ do i = 1, min( kg1, kg1_prev )
+ zaj_l(i,map_z(ib),ik,1) = wfdp_l(i,1)
+ zaj_l(i,map_z(ib),ik,2) = wfdp_l(i,2)
+ end do
+ end if
+
+ end if
+ end do
+ end do
+ else
+
+ do ik = 1, kv3, af+1
+ do ib = 1, neg_previous
+ ! -----------------
+ if(precision_WFfile==SP) then
+ if(mype == 0) read(nfzaj, end = 9999, err = 9999) wf_l
+ if(mype == 0 .and. map_ek(ib,ik) /= 0) then
+ call mpi_send(wf_l,kg1_prev*kimg,mpi_real,map_ek(ib,ik),1,mpi_comm_group,ierr) ! MPI
+ else if(map_ek(ib,ik) == mype .and. map_ek(ib,ik) /= 0) then
+ call mpi_recv(wf_l,kg1_prev*kimg,mpi_real,0,1,mpi_comm_group,istatus,ierr) ! MPI
+ end if
+ if(map_ek(ib,ik) == mype) then ! MPI
+ do ri = 1, kimg
+ do i = 1, min( kg1, kg1_prev )
+ zaj_l(i,map_z(ib),ik,ri) = wf_l(i,ri) ! MPI
+ end do
+ end do
+ end if
+
+ ! -----------------
+ else if(precision_WFfile==DP) then
+ if(mype == 0) read(nfzaj, end = 9999, err = 9999) wfdp_l
+ if(mype == 0 .and. map_ek(ib,ik) /= 0) then
+ call mpi_send(wfdp_l,kg1_prev*kimg,mpi_double_precision,map_ek(ib,ik),1,mpi_comm_group,ierr) ! MPI
+ else if(map_ek(ib,ik) == mype .and. map_ek(ib,ik) /= 0) then
+ call mpi_recv(wfdp_l,kg1_prev*kimg,mpi_double_precision,0,1,mpi_comm_group,istatus,ierr) ! MPI
+ end if
+ if(map_ek(ib,ik) == mype) then ! MPI
+ do i = 1, min( kg1, kg1_prev )
+ zaj_l(i,map_z(ib),ik,ri) = wfdp_l(i,ri) ! MPI
+ end do
+ end if
+ endif
+ ! -----------------
+ end do
+ end do
+ end if
+!
+ if(precision_WFfile==SP) then
+ deallocate(wf_l)
+ else if(precision_WFfile==DP) then
+ deallocate(wfdp_l)
+ end if
+ call tstatc0_end(id_sname)
+ return
+9999 continue
+ ierror = EOF_REACHED
+ call phase_error_wo_filename(ierror, nfout, nfzaj, __LINE__, __FILE__)
+ end subroutine m_ESIO_import_WFs_prev_cell
+! ===================== 2015/09/24
! ==================================== added by K. Tagami =============== 11.0
subroutine m_ESIO_rd_WFs_import_frm_collin(nfout,nfzaj, F_ZAJ_partitioned)
@@ -2686,5 +2815,269 @@ contains
end subroutine m_ESIO_wd_Wfn_integ_magmom
+ subroutine m_ESIO_wd_Wfn_orb_proj
+ integer :: neg_t
+ real(kind=DP), allocatable :: compr(:,:,:,:), compi(:,:,:,:), norm_phig_mpi(:,:)
+
+ if ( ekmode == OFF ) return
+
+ allocate(compr(neg,nlmta_phi,1,kv3)); compr = 0.d0
+ allocate(compi(neg,nlmta_phi,1,kv3)); compi = 0.d0
+
+ if(.not.allocated(norm_phig_mpi)) allocate(norm_phig_mpi(nlmtt_phi,kv3/nspin))
+ norm_phig_mpi=0.d0
+
+ call set_array_compri_etc
+
+ if ( mype == 0 ) then
+ if ( nk_in_the_process == 1 ) then
+ call m_Files_open_nfwfk_orb_proj(2)
+ else
+ call m_Files_open_nfwfk_orb_proj(3)
+ endif
+ endif
+
+ neg_t = neg -num_extra_bands
+
+ if ( SpinOrbit_Mode /= Neglected .and. wf_orb_proj_print_format == 1 ) then
+ call case_with_j
+ else
+ call case_ordinal ! EXPERIMENTAL
+ endif
+ if ( mype == 0 ) call m_Files_close_nfwfk_orb_proj
+
+ deallocate( compr ); deallocate( compi ); deallocate( norm_phig_mpi )
+
+ contains
+
+ subroutine set_array_compri_etc
+ integer :: ik, ie, ib, iksnl
+ integer :: iorb, lmt
+ integer :: ia, il, im, tau, is
+ real(kind=DP), allocatable :: compr_mpi(:,:,:,:), compi_mpi(:,:,:,:), &
+ & norm_phig_mpi2(:,:)
+ real(kind=DP), allocatable :: porb(:)
+
+ do ik = 1, kv3
+ if(map_k(ik) /= myrank_k) cycle
+ iksnl = (ik-1)/nspin + 1
+
+ do ie = ista_e, iend_e, istep_e
+ ib = map_z(ie)
+ compr(ie,1:nlmta_phi,1,ik) = compr_l(ib,1:nlmta_phi,1,ik)
+ compi(ie,1:nlmta_phi,1,ik) = compi_l(ib,1:nlmta_phi,1,ik)
+ end do
+ norm_phig_mpi(1:nlmtt_phi,iksnl) = norm_phig(1:nlmtt_phi,iksnl)
+ end do
+
+ if ( npes >1 ) then
+ allocate( compr_mpi( neg, nlmta_phi, 1, kv3 ) ); compr_mpi = 0.0d0
+ allocate( compi_mpi( neg, nlmta_phi, 1, kv3 ) ); compi_mpi = 0.0d0
+ allocate( norm_phig_mpi2( nlmtt_phi, kv3/nspin ) )
+ call mpi_allreduce( compr, compr_mpi, neg*nlmta_phi*1*kv3, &
+ & mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
+ call mpi_allreduce( compi, compi_mpi, neg*nlmta_phi*1*kv3, &
+ & mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
+ call mpi_allreduce( norm_phig_mpi, norm_phig_mpi2, nlmtt_phi*kv3/nspin, &
+ & mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
+ compr = compr_mpi; compi = compi_mpi
+
+ norm_phig_mpi = norm_phig_mpi2 /dble(nrank_e)
+
+ deallocate( compr_mpi ); deallocate( compi_mpi );
+ deallocate( norm_phig_mpi2 )
+ end if
+ end subroutine set_array_compri_etc
+
+ subroutine case_ordinal
+ integer :: ik, iksnl, iorb, ia, is, ib
+ integer :: il, im, tau, lmt
+ real(kind=DP), allocatable :: porb(:)
+
+ if ( mype /= 0 ) return
+
+ allocate( porb(neg) )
+
+ do ik = 1, kv3, ndim_spinor
+ iksnl = (ik-1)/nspin + 1
+
+ write(nfwfk_orb_proj,'(A,I5,3F20.15)') 'ik = ', &
+ & ik +nk_in_the_process -1, vkxyz(ik,1:3,BUCS)
+
+ do iorb = 1,nlmta_phi
+ call m_PP_tell_iorb_ia_l_m_tau(iorb,ia,il,im,tau)
+ if ( iproj_group(ia) == 0) cycle
+
+ write(nfwfk_orb_proj,'(I5,3I3,A)') ia, il-1, im, tau, ' : ia, l, m, tau'
+
+ call m_PP_tell_iorb_lmt(iorb,lmt)
+
+ porb = 0.0d0
+ Do is=1, ndim_spinor
+ do ib = 1, neg
+ porb(ib) = porb(ib) &
+ & + ( compr(ib,iorb,1,ik+is-1)**2 &
+ & +compi(ib,iorb,1,ik+is-1)**2 ) &
+ & *( 1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl) )
+ end do
+ End Do
+ write(nfwfk_orb_proj,'(4F18.10)') ( porb( neordr(ib,ik) ), ib=1, neg_t )
+ end do
+ end do
+ deallocate( porb )
+
+ end subroutine case_ordinal
+
+ subroutine case_with_j
+ integer :: ik, iksnl, ia, ig, ii, it, ilp, ll, tau, ip
+ integer :: iorb, lmt1, ib, m1
+ real(kind=DP) :: c1, c2
+ complex(kind=CMPLDP) :: z1, z2
+
+ real(kind=DP), allocatable :: porb(:)
+ complex(kind=CMPLDP), allocatable :: zcomp(:,:,:)
+
+! ----------------
+ if ( mype /= 0 ) return
+
+ allocate( porb(neg) )
+
+ Do ik=1, kv3, ndim_spinor
+ write(nfwfk_orb_proj,'(A,I5,3F20.15)') 'ik = ', &
+ & ik +nk_in_the_process -1, vkxyz(ik,1:3,BUCS)
+
+ iksnl = ( ik -1 )/nspin +1
+
+ Do ia=1, natm
+ ig = iproj_group(ia)
+ if ( ig == 0 ) cycle
+
+ do ii=1,num_proj_elems(ig)
+ ip = proj_group( ii, ig )
+ it = proj_attribute(ip)%ityp
+ ilp = proj_attribute(ip)%l +1
+ ll = proj_attribute(ip)%l
+ tau = proj_attribute(ip)%t
+!
+ allocate( zcomp( -ll:ll, neg, ndim_spinor ) ); zcomp = 0.0d0
+ call tranform_compri_r2c_sph( ia, it, ll, tau, ik, &
+ & compr, compi, zcomp )
+
+ if ( ll == 0 ) then
+ call find_iorb_from_lmt( ia, it, ll, 1, tau, iorb )
+ call m_PP_tell_iorb_lmt( iorb, lmt1 )
+
+ write(nfwfk_orb_proj,'(I5,F7.2,I3,F7.2,I3,A)') &
+ & ia, ll+0.5d0, ll, 0.5d0, tau, ' : ia, j, l, mj, tau'
+ Do ib=1, neg
+ z1 = cmplx( compr(ib,iorb,1,ik), compi(ib,iorb,1,ik) )
+ z2 = cmplx( compr(ib,iorb,1,ik+1), compi(ib,iorb,1,ik+1) )
+ porb(ib) = ( z1*conjg(z1) +z2*conjg(z2) ) &
+ & *( 1.d0+qorb(iorb)/norm_phig_mpi( lmt1, iksnl ) )
+ End Do
+ write(nfwfk_orb_proj,'(4F18.10)') &
+ & ( porb( neordr(ib,ik) ), ib=1, neg_t )
+ else
+! j_up
+ Do m1=-ll -1, ll
+ c1 = dble( ll +m1 + 1 ) / dble( 2 *ll +1 )
+ c2 = dble( ll -m1 ) / dble( 2 *ll +1 )
+ c1 = sqrt(c1); c2 = sqrt(c2)
+
+ call find_iorb_from_lmt( ia, it, ll, 1, tau, iorb )
+ call m_PP_tell_iorb_lmt( iorb, lmt1 )
+
+ write(nfwfk_orb_proj,'(I5,F7.2,I3,F7.2,I3,A)') &
+ & ia, ll+0.5d0, ll, m1+0.5d0, tau, &
+ & ' : ia, j, l, mj, tau'
+ Do ib=1, neg
+ z1 = 0.0d0
+ if ( m1 > -ll -1 ) z1 = z1 +c1 *zcomp( m1, ib, 1 )
+ if ( m1 < ll ) z1 = z1 +c2 *zcomp( m1 +1, ib, 2 )
+ porb(ib) = z1 *conjg(z1) &
+ & *( 1.d0+qorb(iorb)/norm_phig_mpi(lmt1,iksnl) )
+ End Do
+ write(nfwfk_orb_proj,'(4F18.10)') &
+ & ( porb( neordr(ib,ik) ), ib=1, neg_t )
+ End Do
+! j_down
+ Do m1=-ll+1, ll
+ c1 = dble( ll -m1 + 1 ) / dble( 2 *ll +1 )
+ c2 = dble( ll +m1 ) / dble( 2 *ll +1 )
+ c1 = sqrt(c1); c2 = -sqrt(c2)
+
+ call find_iorb_from_lmt( ia, it, ll, 1, tau, iorb )
+ call m_PP_tell_iorb_lmt( iorb, lmt1 )
+
+ write(nfwfk_orb_proj,'(I5,F7.2,I3,F7.2,I3,A)') &
+ & ia, ll-0.5d0, ll, m1-0.5d0, tau, &
+ & ' : ia, j, l, mj, tau'
+ Do ib=1, neg
+ z1 = c1 *zcomp( m1-1, ib, 1 ) +c2 *zcomp( m1, ib, 2 )
+ porb(ib) = z1 *conjg(z1) &
+ & *( 1.d0+qorb(iorb)/norm_phig_mpi(lmt1,iksnl) )
+ End Do
+ write(nfwfk_orb_proj,'(4F18.10)') &
+ & ( porb( neordr(ib,ik) ), ib=1, neg_t )
+ End Do
+ end if
+ deallocate( zcomp )
+
+ End Do
+ End Do
+
+ End Do
+ deallocate( porb )
+
+ end subroutine case_with_j
+
+ subroutine tranform_compri_r2c_sph( ia, it, ll, tau, ik, &
+ & compr, compi, zcomp )
+ integer, intent(in) :: ia, it, ll, tau, ik
+ real(kind=DP), intent(in) :: compr( neg, nlmta_phi, 1, kv3 )
+ real(kind=DP), intent(in) :: compi( neg, nlmta_phi, 1, kv3 )
+ complex(kind=CMPLDP), intent(out) :: zcomp( -ll:ll, neg, ndim_spinor )
+
+ integer :: m1, m2, ib, iorb
+ complex(kind=CMPLDP) :: z1
+ complex(kind=CMPLDP) :: ztmp( ndim_spinor )
+
+ Do m1=-ll, ll
+ Do m2=1, 2*ll +1
+ call find_iorb_from_lmt( ia, it, ll, m2, tau, iorb )
+ Do ib=1, neg
+ ztmp(1) = cmplx( compr(ib,iorb,1,ik), compi(ib,iorb,1,ik) )
+ ztmp(2) = cmplx( compr(ib,iorb,1,ik+1), compi(ib,iorb,1,ik+1) )
+
+ if ( ll == 0 ) z1 = MatU_ylm_RC_L0( m2, m1 )
+ if ( ll == 1 ) z1 = MatU_ylm_RC_L1( m2, m1 )
+ if ( ll == 2 ) z1 = MatU_ylm_RC_L2( m2, m1 )
+ if ( ll == 3 ) z1 = MatU_ylm_RC_L3( m2, m1 )
+
+ zcomp(m1,ib,:) = zcomp(m1,ib,:) +z1 *ztmp(:)
+ End Do
+ End Do
+ End Do
+ end subroutine tranform_compri_r2c_sph
+
+ subroutine find_iorb_from_lmt( ia, it, ll, mm, tau, iorb )
+ integer, intent(in) :: ia, it, ll, mm, tau
+ integer, intent(out) :: iorb
+
+ integer :: lmt1, l1, m1, t1
+
+ iorb = 0
+ Do lmt1=1, ilmt_phi(it)
+ l1 = ltp_phi(lmt1,it); m1 = mtp_phi(lmt1,it); t1 = taup_phi(lmt1,it)
+ if ( l1 == ll +1 .and. m1 == mm .and. t1 == tau ) then
+ exit
+ endif
+ ENd Do
+ iorb = lmta_phi( lmt1,ia )
+
+ end subroutine find_iorb_from_lmt
+
+ end subroutine m_ESIO_wd_Wfn_orb_proj
+
end module m_ES_IO
diff -uprN phase0_2015.01/src_phase/m_ES_LHXC.F90 phase0_2015.01.01/src_phase/m_ES_LHXC.F90
--- phase0_2015.01/src_phase/m_ES_LHXC.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_LHXC.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 494 $)
!
! MODULE: m_ES_LHXC
!
@@ -47,7 +47,7 @@
#endif
module m_ES_LHXC
-! $Id: m_ES_LHXC.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_ES_LHXC.F90 494 2016-06-02 00:54:16Z jkoga $
use m_Electronic_Structure, only : vlhxc_l, vloc_esm
use m_PlaneWaveBasisSet, only : kg,kgp,gr_l
use m_PseudoPotential, only : psc_l, ival
@@ -78,7 +78,13 @@ module m_ES_LHXC
use m_FFT, only : fft_box_size_CD
use m_PlaneWaveBasisSet, only : igfp_l
-implicit none
+! === POSITRON SCF === 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : positron_GGGC
+ use m_Positron_Wave_Functions, only : pchg_l
+! ==================== 2015/11/28
+
+ implicit none
include 'mpif.h'
! 61. m_ESlhxc_potential
contains
@@ -93,7 +99,7 @@ contains
integer :: ist,ip
integer :: ig
integer :: nfftcd,ierr
- integer :: id_sname = -1
+ integer :: id_sname = -1,id_sname2=-1
call tstatc0_begin('m_ESlhxc_potential ',id_sname,1)
vlhxc_l = 0.d0
@@ -103,17 +109,23 @@ contains
if(sw_esm==ON) then
nfftcd = fft_box_size_CD(1,0)*fft_box_size_CD(2,0)*fft_box_size_CD(3,0)
allocate(vhar(nfftcd));vhar=(0.d0,0.d0)
- allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+! allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+ allocate(chgc(kgp,nspin));chgc=(0.d0,0.d0)
if(kimg==1)then
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),0.d0)
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),0.d0)
+ chgc(ig,1:nspin) = dcmplx(chg(ig,1,1:nspin),0.d0)
enddo
else
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),chg(ig,2,1:nspin))
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),chg(ig,2,1:nspin))
+ chgc(ig,1:nspin) = dcmplx(chg(ig,1,1:nspin),chg(ig,2,1:nspin))
enddo
endif
+ call mpi_allreduce(mpi_in_place,chgc,kgp*nspin,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
+ call tstatc0_begin('esm_hartree ',id_sname2,1)
call esm_hartree(chgc,ehar,vhar)
+ call tstatc0_end(id_sname2)
vhar(:) = 0.5d0*vhar(:) !Ry -> Ha
deallocate(chgc)
endif
@@ -213,6 +225,25 @@ contains
end do
end do
end if
+
+! === POSITRON SCF === 2015/11/28
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_GGGC ) then
+ if ( nspin == 2 ) stop "UUU"
+ do is = 1, nspin
+ do ik = 1, kimg
+ if(nspin == 1) then
+ do i = ist, iend_kngp !for mpi
+ vlhxc_l(i,ik,is) = vlhxc_l(i,ik,is) &
+ & -PAI4*pchg_l(i,ik)/gr_l(i)**2
+ end do
+ end if
+ end do
+ end do
+ end if
+ endif
+! ============== 2015/11/28
+
if(iprivlhxcq >= 2) call m_ESlhxc_wd_vlhxc(nfout)
call tstatc0_end(id_sname)
end subroutine m_ESlhxc_potential
diff -uprN phase0_2015.01/src_phase/m_ES_Mag_Constraint.f90 phase0_2015.01.01/src_phase/m_ES_Mag_Constraint.f90
--- phase0_2015.01/src_phase/m_ES_Mag_Constraint.f90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_Mag_Constraint.f90 2016-07-12 12:51:19.000000000 +0900
@@ -1,5 +1,5 @@
module m_ES_Mag_Constraint
-! $Id: m_ES_Mag_Constraint.f90 409 2014-10-27 09:24:52Z jkoga $
+! $Id: m_ES_Mag_Constraint.f90 469 2015-09-30 03:06:13Z ktagami $
use m_Parallelization, only : ista_kngp, iend_kngp, ierr, npes, mype, &
& mpi_comm_group
@@ -242,8 +242,152 @@ contains
end subroutine case_constraint_moment_local
- subroutine case_constraint_direc_local ! only for noncol
- stop "Not supported"
+ subroutine case_constraint_direc_local
+ real(kind=DP) :: MagMom(3), cfactor(3), MagDirec(3)
+ real(kind=DP) :: rad1, fac1r, fac1i, fac2
+ real(kind=DP) :: VecG(3), normG, normG3, gr, d1
+ real(kind=DP) :: c1, c2, c3, cnorm, cnorm2, cnorm4
+
+ real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10
+! real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-4
+
+ real(kind=DP), allocatable :: zfcos(:), zfsin(:)
+ real(kind=DP), allocatable :: RhoMag_on_atom_mpi(:,:)
+
+ integer :: i, j, ia, it, is, ixyz, ixyz_max, ist
+
+ allocate(zfcos(ista_kngp:iend_kngp)); zfcos = 0.d0
+ allocate(zfsin(ista_kngp:iend_kngp)); zfsin = 0.d0
+
+ if ( noncol ) then
+ ixyz_max = 3
+ else
+ ixyz_max = 1
+ endif
+
+ if ( allocated( MagField_constrain_local ) ) then
+ deallocate( MagField_constrain_local )
+ endif
+
+ allocate( MagField_constrain_local(ista_kngp:iend_kngp, kimg, ixyz_max ))
+ MagField_constrain_local = 0.0d0
+!
+ Do ia=1, natm
+ it = ityp(ia)
+ rad1 = rad_cov(ia)
+
+ MagMom = 0.0d0
+ Do ixyz=1, ixyz_max
+ if ( noncol ) then
+ MagMom( ixyz ) = RhoMag_on_atom( ia, ixyz +1 )
+ else
+ MagMom( ixyz ) = RhoMag_on_atom( ia, 1 ) -RhoMag_on_atom( ia, 2 )
+ endif
+ End do
+
+ cnorm2 = 0.0d0
+ Do ixyz=1, ixyz_max
+ cnorm2 = cnorm2 + MagMom(ixyz)**2
+ End do
+ cnorm = sqrt( cnorm2 )
+
+ if ( cnorm < cnorm_lower_limit ) cycle
+
+ MagDirec = MagMom / cnorm
+!
+
+ cnorm4 = 0.0d0
+ Do ixyz=1, ixyz_max
+ cnorm4 = cnorm4 +mag_moment0_atomtyp(it,ixyz)**2
+ End do
+ cnorm4 = sqrt( cnorm4 )
+!
+ Do ixyz=1, ixyz_max
+ if ( noncol ) then
+ c1 = cnorm2 - MagMom(ixyz)**2; c2 = cnorm**3
+ if ( cnorm4 > 0.0 ) then
+ c3 = mag_constraint_lambda /univol *c1 /c2 &
+ & *( MagDirec(ixyz) -mag_direction0_atomtyp(it,ixyz) )
+ else
+ c3 = 0.0d0
+ endif
+ cfactor( ixyz ) = c3
+ else
+ if ( cnorm4 > 0.0 ) then
+ if ( mag_moment0_atomtyp(it,ixyz) > 0.0 ) then
+ c3 = 1.0d0
+ else
+ c3 = -1.0d0
+ endif
+ cfactor( ixyz ) = mag_constraint_lambda /univol &
+ & *( MagDirec(ixyz) -c3 )
+ else
+ cfactor( ixyz ) = 0.0d0
+ endif
+ endif
+
+! write(2000+mype,*) "ia cfac = ", ia, cfactor(ixyz), MagDirec(1), c3
+! write(2100+mype,*) "ia = ", ia, MagMom(ixyz), cnorm, cnorm2
+
+ call calc_phase2( natm, pos, ia, kgp, ngabc, ista_kngp, iend_kngp, &
+ & zfcos, zfsin )
+
+ if ( ista_kngp == 1 ) then
+ ist = 2
+ else
+ ist = ista_kngp
+ endif
+
+ Do i=ist, iend_kngp
+ VecG(1) = rltv(1,1)*ngabc(i,1) +rltv(1,2)*ngabc(i,2) +rltv(1,3)*ngabc(i,3)
+ VecG(2) = rltv(2,1)*ngabc(i,1) +rltv(2,2)*ngabc(i,2) +rltv(2,3)*ngabc(i,3)
+ VecG(3) = rltv(3,1)*ngabc(i,1) +rltv(3,2)*ngabc(i,2) +rltv(3,3)*ngabc(i,3)
+
+ normG = sqrt( VecG(1)**2 +VecG(2)**2 +VecG(3)**2 )
+ normG3 = normG**3
+
+ fac1r = zfcos(i); fac1i = zfsin(i)
+!
+ gr = normG *rad1
+ fac2 = -gr *cos(gr) + sin(gr)
+ fac2 = fac2 *PAI4 /normG3
+!
+ MagField_constrain_local( i, 1, ixyz ) &
+ & = MagField_constrain_local( i, 1, ixyz ) &
+ & +fac1r *fac2 *cfactor( ixyz )
+ if ( kimg == 2 ) then
+ MagField_constrain_local( i, 2, ixyz ) &
+ & = MagField_constrain_local( i, 2, ixyz ) &
+ & -fac1i *fac2 *cfactor( ixyz )
+ endif
+ End Do
+
+ if ( mype == 0 ) then
+ fac2 = PAI4 /3.0d0 *rad1**3
+
+ MagField_constrain_local( 1, 1, ixyz ) &
+ & = MagField_constrain_local( 1, 1, ixyz ) &
+ & +fac2 *cfactor( ixyz )
+ end if
+ End Do
+ End Do
+!
+ if ( noncol ) then
+ Do i=ista_kngp, iend_kngp
+ Do is=2, ndim_magmom
+ vlhxc_l(i,1,is) = vlhxc_l(i,1,is) +MagField_constrain_local(i,1,is-1)
+ vlhxc_l(i,2,is) = vlhxc_l(i,2,is) +MagField_constrain_local(i,2,is-1)
+ End do
+ End Do
+ else
+ Do i=ista_kngp, iend_kngp
+ Do j=1, kimg
+ vlhxc_l(i,j,1) = vlhxc_l(i,j,1) +MagField_constrain_local(i,j,1)
+ vlhxc_l(i,j,2) = vlhxc_l(i,j,2) -MagField_constrain_local(i,j,1)
+ End Do
+ End Do
+ endif
+
end subroutine case_constraint_direc_local
end subroutine m_ES_add_MagConstraintPot_chgql
@@ -518,11 +662,100 @@ contains
end subroutine case_constraint_direc_global
subroutine case_constraint_direc_local
- stop "kt: Not supported"
+ real(kind=DP) :: MagMom(3), MagDirec(3), c1, c2, c3
+ integer :: i, j, ia, it, is, ixyz
+
+ real(kind=DP) :: cnorm, cnorm2, cnorm4
+ real(kind=DP) :: csum1, csum2
+
+ real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10
+
+ csum1 = 0.0d0; csum2 = 0.0d0
+
+ if ( noncol ) then
+ Do i=ista_kngp, iend_kngp
+ Do j=1, kimg
+ Do ixyz=1, 3
+ csum1 = csum1 + MagField_constrain_local(i,j,ixyz)*chgq_l(i,j,ixyz+1)
+ End Do
+ End Do
+ End Do
+
+ Do ia=1, natm
+ it = ityp(ia)
+ Do ixyz=1, 3
+ MagMom(ixyz) = RhoMag_on_Atom( ia,ixyz+1 )
+ End do
+
+ cnorm2 = 0.0d0
+ Do ixyz=1, 3
+ cnorm2 = cnorm2 + MagMom(ixyz)**2
+ End do
+ cnorm = sqrt( cnorm2 )
+
+ cnorm4 = 0.0d0
+ Do ixyz=1, 3
+ cnorm4 = cnorm4 +mag_moment0_atomtyp(it,ixyz)**2
+ End do
+ cnorm4 = sqrt( cnorm4 )
+
+ if ( cnorm4 > 0.0 .and. cnorm > cnorm_lower_limit ) then
+ MagDirec = MagMom / cnorm
+ Do ixyz=1, 3
+ csum2 = csum2 + ( MagDirec(ixyz) -mag_direction0_atomtyp(it,ixyz) )**2
+ End Do
+ endif
+ End do
+
+ else
+ Do i=ista_kngp, iend_kngp
+ Do j=1, kimg
+ csum1 = csum1 + MagField_constrain_local(i,j,1) &
+ & *( chgq_l(i,j,1) -chgq_l(i,j,2) )
+ End Do
+ End Do
+
+ Do ia=1, natm
+ it = ityp(ia)
+ MagMom(1) = RhoMag_on_Atom( ia,1 ) -RhoMag_on_Atom( ia,2 )
+
+ cnorm2 = 0.0d0
+ Do ixyz=1, 1
+ cnorm2 = cnorm2 + MagMom(ixyz)**2
+ End do
+ cnorm = sqrt( cnorm2 )
+
+ cnorm4 = 0.0d0
+ Do ixyz=1, 1
+ cnorm4 = cnorm4 +mag_moment0_atomtyp(it,ixyz)**2
+ End do
+ cnorm4 = sqrt( cnorm4 )
+
+ if ( cnorm4 > 0.0 .and. cnorm > cnorm_lower_limit ) then
+ MagDirec = MagMom / cnorm
+ if ( mag_moment0_atomtyp(it,1) > 0.0 ) then
+ c3 = 1.0d0
+ else
+ c3 = -1.0d0
+ endif
+ csum2 = csum2 +( MagDirec(1) -c3 )**2
+ endif
+ End do
+ endif
+
+ if ( npes > 1 ) then
+ call mpi_allreduce( csum1, c1, 1, mpi_double_precision, &
+ & mpi_sum, mpi_comm_group, ierr )
+ csum1 = c1
+ endif
+
+ ene_double_counting = csum1 *univol
+ ene_mag_constraint = csum2 *mag_constraint_lambda/ 2.0d0
+
end subroutine case_constraint_direc_local
subroutine case_constraint_moment_local
- real(kind=DP) :: MagMom(3), MagDirec(3), c1, c2
+ real(kind=DP) :: MagMom(3), c1, c2
integer :: i, j, ia, it, is, ixyz
real(kind=DP) :: csum1, csum2
@@ -542,8 +775,8 @@ contains
it = ityp(ia)
Do ixyz=1, 3
MagMom(ixyz) = RhoMag_on_Atom( ia,ixyz+1 )
+ csum2 = csum2 + ( MagMom(ixyz) -mag_moment0_atomtyp(it,ixyz) )**2
End do
- csum2 = csum2 + ( MagMom(ixyz) -mag_moment0_atomtyp(it,ixyz) )**2
End do
else
@@ -557,7 +790,7 @@ contains
Do ia=1, natm
it = ityp(ia)
MagMom(1) = RhoMag_on_Atom( ia,1 ) -RhoMag_on_Atom( ia,2 )
- csum2 = ( MagMom(1) -mag_moment0_atomtyp(it,1) )**2
+ csum2 = csum2 +( MagMom(1) -mag_moment0_atomtyp(it,1) )**2
End do
endif
diff -uprN phase0_2015.01/src_phase/m_ES_NonCollinear.f90 phase0_2015.01.01/src_phase/m_ES_NonCollinear.f90
--- phase0_2015.01/src_phase/m_ES_NonCollinear.f90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_NonCollinear.f90 2016-07-12 12:51:19.000000000 +0900
@@ -1,5 +1,5 @@
module m_ES_NonCollinear
-! $Id: m_ES_NonCollinear.f90 409 2014-10-27 09:24:52Z jkoga $
+! $Id: m_ES_NonCollinear.f90 487 2016-05-17 05:20:42Z ktagami $
use m_Const_Parameters, only : DP, CMPLDP, zi, yes, PAI, &
& BuiltIn, ByProjector, ByPawPot, ZeffApprox, &
& BUCS, CARTS, CRDTYP, DELTA10, ReadFromPP
diff -uprN phase0_2015.01/src_phase/m_ES_WF_by_RMM.F90 phase0_2015.01.01/src_phase/m_ES_WF_by_RMM.F90
--- phase0_2015.01/src_phase/m_ES_WF_by_RMM.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_WF_by_RMM.F90 2016-07-12 12:51:19.000000000 +0900
@@ -3300,10 +3300,12 @@ contains
end if
end do
- do iap = 1, n_ialist0
- ia = n_ialist0*(lmt1-1) + iap
- bWr_lmt(ia,:) = bWr_tmp(iap,:)
- bWi_lmt(ia,:) = bWi_tmp(iap,:)
+ do ib = 1, np_e
+ do iap = 1, n_ialist0
+ ia = n_ialist0*(lmt1-1) + iap
+ bWr_lmt(ia,ib) = bWr_tmp(iap,ib)
+ bWi_lmt(ia,ib) = bWi_tmp(iap,ib)
+ end do
end do
do iap = 1, n_ialist0
@@ -4428,10 +4430,12 @@ contains
end if
end do
- do iap = 1, n_ialist0
- ia = n_ialist0*(lmt1-1) + iap
- bWr_lmt(ia,:) = bWr_tmp(iap,:)
- bWi_lmt(ia,:) = bWi_tmp(iap,:)
+ do ib = 1, np_e
+ do iap = 1, n_ialist0
+ ia = n_ialist0*(lmt1-1) + iap
+ bWr_lmt(ia,ib) = bWr_tmp(iap,ib)
+ bWi_lmt(ia,ib) = bWi_tmp(iap,ib)
+ end do
end do
do iap = 1, n_ialist0
diff -uprN phase0_2015.01/src_phase/m_ES_WF_by_submat.F90 phase0_2015.01.01/src_phase/m_ES_WF_by_submat.F90
--- phase0_2015.01/src_phase/m_ES_WF_by_submat.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_WF_by_submat.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 511 $)
!
! MODULE: m_ES_WF_by_submat
!
@@ -481,6 +481,7 @@ contains
real(kind=DP) :: sum_sq_diagonal, sum_sq_non_diagonal &
& , sum_abs_diagonal, sum_abs_non_diagonal
integer :: id_sname = -1, id_sname2 = -1, ipri0
+ integer :: max_block_size
#ifdef SUBMAT_DGEMM
real(kind=DP),allocatable,dimension(:,:) :: w1hw2r,w1hw2i
real(kind=DP) :: alpha, beta
@@ -572,11 +573,14 @@ contains
! (make matrix elements )
#ifdef _USE_SCALAPACK_
+ if(iprisubmat>=2) write(nfout,'(" sw_scalapack = ",i3," <<evolve_WFs_in_subspace>>")') sw_scalapack
if(sw_scalapack == ON) then
if(submat_uncalled) then
! === DEBUG by tkato 2012/01/23 ================================================
if(block_size == 0) then
+ max_block_size = int(real(meg)/real(nrank_e))
block_size = nb_mgs_default
+ if(block_size.ge.max_block_size) block_size = max_block_size
end if
! ==============================================================================
call set_nprow_npcol(nprow,npcol)
diff -uprN phase0_2015.01/src_phase/m_ES_dos.F90 phase0_2015.01.01/src_phase/m_ES_dos.F90
--- phase0_2015.01/src_phase/m_ES_dos.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ES_dos.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 492 $)
!
! MODULE: m_ES_dos
!
@@ -34,14 +34,14 @@
!
module m_ES_dos
! (m_ESdos)
-! $Id: m_ES_dos.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_ES_dos.F90 492 2016-05-31 03:06:04Z jkoga $
!
! This module was originally coded by T. Yamasaki (FUJITSU Laboratories) in 2001.
! And this is transferred as match to PHASE by T. Yamasaki, 18th May. 2003.
!
use m_Kpoints, only : kv3, kv3_ek, qwgt,vkxyz_ek &
& , np0,np2,ip20,iwt,ip2cub,nxyz_tetra,trmat &
- & , m_Kp_sample_mesh
+ & , m_Kp_sample_mesh, qwgt_ek
use m_Files, only : nfout
!!$ use m_Files, only : nfdos, nfout
use m_Timing, only : tstatc0_begin, tstatc0_end
@@ -54,7 +54,7 @@ module m_ES_dos
& ,ipriinputfile, printable
use m_Const_Parameters, only : DP,Hartree,BUCS,EK,SCF, ALDOS, LAYERDOS, ON, OFF, TOTAL, PAI2
use m_Parallelization, only : mpi_comm_group,map_ek,mype,map_e,map_k,myrank_e,myrank_k &
- & ,ierr,np_e,map_z,ista_e,npes
+ & ,ierr,np_e,map_z,ista_e,npes, nrank_e
use m_PseudoPotential, only : nlmta_phi,nlmtt_phi &
& ,m_PP_tell_iorb_ia_l_m_tau,qorb &
& ,m_PP_tell_iorb_lmt
@@ -397,6 +397,7 @@ contains
call mpi_allreduce(compr,compr_mpi,neg*nlmta_phi*nopr*kv,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
call mpi_allreduce(compi,compi_mpi,neg*nlmta_phi*nopr*kv,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
call mpi_allreduce(norm_phig_mpi,norm_phig_mpi2,nlmtt_phi*kv/nspin,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ norm_phig_mpi2 = norm_phig_mpi2 / dble(nrank_e)
end if
eko = eko_mpi
@@ -561,6 +562,7 @@ contains
& mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
call mpi_allreduce( norm_phig_mpi, norm_phig_mpi2, nlmtt_phi*kv/ndim_spinor, &
& mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
+ norm_phig_mpi2 = norm_phig_mpi2 / dble(nrank_e)
end if
eko = eko_mpi
@@ -742,14 +744,15 @@ contains
subroutine dealloc_dos()
deallocate(dos)
deallocate(sumdos)
-!!$ if(sw_pdos == ON) then
-!!$ if(allocated(pdos)) deallocate(pdos)
-!!$ if(allocated(sumpdos)) deallocate(sumpdos)
-!!$ end if
+ if(sw_pdos == ON) then
+ if(allocated(pdos)) deallocate(pdos)
+ if(allocated(sumpdos)) deallocate(sumpdos)
+ end if
end subroutine dealloc_dos
- subroutine make_dos_with_GaussianDistrib(kv,iwsc)
- integer, intent(in) :: kv,iwsc
+ subroutine make_dos_with_GaussianDistrib( kv, iwsc, kpt_weight )
+ integer, intent(in) :: kv, iwsc
+ real(kind=DP), intent(in) :: kpt_weight( kv )
integer :: i, ik, is, ie, id, ispin, iorb, iopr, lmt, iksnl
real(kind=DP) :: Es, e, El, Eu, tl, tu, w, DeltaE
@@ -793,41 +796,42 @@ contains
tu = (Eu - eko(i,ik))*sqrtdVI
! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
dos(id+1,ispin) = dos(id+1,ispin) &
- & + w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
+ & + w *2 *(derf(tu) - derf(tl)) *0.5d0 /DeltaE *kpt_weight(ik)
end do
if(iwsc == TOTAL .and. sw_pdos == ON) then
do iorb = 1,nlmta_phi
- call m_PP_tell_iorb_lmt(iorb,lmt)
- porb = 0.d0
+ call m_PP_tell_iorb_lmt(iorb,lmt)
+ porb = 0.d0
!!$ASASASASAS
!!$ do iopr=1,nopr
!!$ porb = porb + (compr(i,iorb,iopr,ik)**2 &
!!$ & + compi(i,iorb,iopr,ik)**2) &
!!$ & *(1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl))
!!$ end do
- if ( k_symmetry(ik) == GAMMA ) then
- do iopr=1,nopr
- porb = porb + compr(i,iorb,iopr,ik)**2 /2.0 &
- & *(1.d0+qorb(iorb)/(norm_phig_mpi(lmt,iksnl)*2.) )
- end do
- else
- do iopr=1,nopr
- porb = porb + (compr(i,iorb,iopr,ik)**2 &
- & + compi(i,iorb,iopr,ik)**2) &
- & *(1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl))
- end do
- endif
+ if ( k_symmetry(ik) == GAMMA ) then
+ do iopr=1,nopr
+ porb = porb + compr(i,iorb,iopr,ik)**2 /2.0 &
+ & *(1.d0+qorb(iorb)/(norm_phig_mpi(lmt,iksnl)*2.) )
+ end do
+ else
+ do iopr=1,nopr
+ porb = porb + (compr(i,iorb,iopr,ik)**2 &
+ & + compi(i,iorb,iopr,ik)**2) &
+ & *(1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl))
+ end do
+ endif
!!$ASASASASAS
- porb = porb/dble(nopr)
- do id = is, ie
- El = Es + id*DeltaE
- Eu = El + DeltaE
- tl = (El - eko(i,ik))*sqrtdVI
- tu = (Eu - eko(i,ik))*sqrtdVI
- ! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
- pdos(id+1,iorb,ispin) = pdos(id+1,iorb,ispin) &
- & + porb * w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
- end do
+ porb = porb/dble(nopr)
+ do id = is, ie
+ El = Es + id*DeltaE
+ Eu = El + DeltaE
+ tl = (El - eko(i,ik))*sqrtdVI
+ tu = (Eu - eko(i,ik))*sqrtdVI
+ ! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
+ pdos(id+1,iorb,ispin) = pdos(id+1,iorb,ispin) &
+ & + porb *w *2 *(derf(tu) - derf(tl)) *0.5d0 /DeltaE &
+ & *kpt_weight(ik)
+ end do
end do
end if
end do
@@ -848,8 +852,9 @@ contains
end subroutine make_dos_with_GaussianDistrib
! ==================================== added by K. Tagami ============== 11.0
- subroutine mkdos_with_GaussDistrib_noncl(kv,iwsc)
- integer, intent(in) :: kv,iwsc
+ subroutine mkdos_with_GaussDistrib_noncl( kv, iwsc, kpt_weight )
+ integer, intent(in) :: kv, iwsc
+ real(kind=DP), intent(in) :: kpt_weight( kv )
integer :: i, ik, is, ie, id, ispin, iorb, iopr, lmt, iksnl
integer :: is1, is2, istmp, ismax
@@ -907,7 +912,7 @@ contains
tu = (Eu - eko(i,iksnl))*sqrtdVI
! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
dos(id+1,istmp) = dos(id+1,istmp) &
- & + w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
+ & + w *(derf(tu) - derf(tl)) *0.5d0 /DeltaE *kpt_weight(ik)
end do
End do
@@ -953,7 +958,8 @@ contains
tu = (Eu - eko(i,iksnl))*sqrtdVI
! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
pdos(id+1,iorb,:) = pdos(id+1,iorb,:) &
- & + porb(iorb,:) * w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
+ & + porb(iorb,:) *w *(derf(tu) - derf(tl)) &
+ & *0.5d0 /DeltaE *kpt_weight(ik)
end do
End do
@@ -980,8 +986,9 @@ contains
! =================================================================== 11.0
! ====================== KT_add ======================= 13.0E
- subroutine make_dos_with_FDiracDistrib(kv,iwsc)
- integer, intent(in) :: kv,iwsc
+ subroutine make_dos_with_FDiracDistrib( kv, iwsc, kpt_weight )
+ integer, intent(in) :: kv, iwsc
+ real(kind=DP), intent(in) :: kpt_weight( kv )
integer :: i, ik, is, ie, id, ispin, iorb, iopr, lmt, iksnl
real(kind=DP) :: Es, e, Ene1, c1, c2, w, DeltaE
@@ -1022,7 +1029,8 @@ contains
do id = is, ie
ene1 = Es +id*DeltaE
call width_fermi_dirac( ene1, eko(i,ik), smearing_width_fdirac, c1, c2 )
- dos(id+1,ispin) = dos(id+1,ispin) + w *c1 *2.0d0 /dble(kv)
+!!! dos(id+1,ispin) = dos(id+1,ispin) + w *c1 *2.0d0 /dble(kv)
+ dos(id+1,ispin) = dos(id+1,ispin) + w *c1 *2.0d0 *kpt_weight(ik)
end do
if(iwsc == TOTAL .and. sw_pdos == ON) then
do iorb = 1,nlmta_phi
@@ -1053,7 +1061,8 @@ contains
call width_fermi_dirac( ene1, eko(i,ik), &
& smearing_width_fdirac, c1, c2 )
pdos(id+1,iorb,ispin) = pdos(id+1,iorb,ispin) &
- & + porb *w *c1 *2.0d0 /dble(kv)
+!!! & + porb *w *c1 *2.0d0 /dble(kv)
+ & + porb *w *c1 *2.0d0 *kpt_weight(ik)
end do
end do
end if
@@ -1395,7 +1404,7 @@ contains
if ( iproj_group(ia)== 0 ) return
! ---
- write(nf,'("PDOS: ia=",i0," l=",i3," m=",i3," t=",i3)') ia,il-1,im,tau
+ write(nf,'("PDOS: ia= ",i0," l=",i3," m=",i3," t=",i3)') ia,il-1,im,tau
write(nf,'(2x,A,5x,A,4x,A)') "No. E(eV)",&
& " dos_chg(eV) dos_mx(eV) dos_my(eV) dos_mz(eV)", &
@@ -1428,7 +1437,7 @@ contains
call alloc_eko_and_substitution(kv3) ! eko_l -> eko
call find_Erange(eko,neg,kv3)
call alloc_dos(1,icomponent)
- call make_dos_with_GaussianDistrib(kv3,icomponent)
+ call make_dos_with_GaussianDistrib( kv3, icomponent, qwgt )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) call write_dos(nfdos)
!!$ call write_dos(nfout)
@@ -1447,7 +1456,7 @@ contains
call find_Erange( eko, neg, kv3/ndim_spinor )
call alloc_dos(1,icomponent)
- call mkdos_with_GaussDistrib_noncl(kv3,icomponent)
+ call mkdos_with_GaussDistrib_noncl( kv3, icomponent, qwgt )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) then
@@ -1473,7 +1482,7 @@ contains
call alloc_eko_and_substitution_ek(kv3_ek) ! eko_ek -> eko
call find_Erange(eko,neg,kv3_ek)
call alloc_dos(1,icomponent)
- call make_dos_with_GaussianDistrib(kv3_ek,icomponent)
+ call make_dos_with_GaussianDistrib( kv3_ek, icomponent, qwgt_ek )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) call write_dos(nfdos)
call dealloc_eko()
@@ -1488,7 +1497,7 @@ contains
call find_Erange(eko,neg,kv3_ek/ndim_spinor)
call alloc_dos(1,icomponent)
- call mkdos_with_GaussDistrib_noncl(kv3_ek,icomponent)
+ call mkdos_with_GaussDistrib_noncl( kv3_ek, icomponent, qwgt_ek )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) then
@@ -1512,7 +1521,7 @@ contains
call find_Erange_fermidirac(eko,neg,kv3)
call alloc_dos(1,icomponent)
- call make_dos_with_FDiracDistrib(kv3,icomponent)
+ call make_dos_with_FDiracDistrib( kv3, icomponent, qwgt )
!!! if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(icomponent == TOTAL) then
@@ -1535,7 +1544,7 @@ contains
call find_Erange_fermidirac(eko,neg,kv3_ek)
call alloc_dos(1,icomponent)
- call make_dos_with_FDiracDistrib(kv3_ek,icomponent)
+ call make_dos_with_FDiracDistrib( kv3_ek, icomponent, qwgt_ek )
if(icomponent == TOTAL) then
ValenceBandMaximum = efermi
@@ -1698,6 +1707,9 @@ contains
& , mpi_comm_group,ierr)
call mpi_allreduce(MPI_IN_PLACE,norm_phig_mpi,nlmtt_phi*np2,mpi_double_precision,mpi_sum &
& , mpi_comm_group,ierr)
+
+ norm_phig_mpi = norm_phig_mpi / dble(nrank_e)
+
!compr = compr_mpi
!compi = compi_mpi
!norm_phig_mpi = norm_phig_mpi2
@@ -2169,7 +2181,7 @@ contains
& mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
compr = compr_mpi; compi = compi_mpi
- norm_phig_mpi = norm_phig_mpi2
+ norm_phig_mpi = norm_phig_mpi2 / dble(nrank_e)
deallocate(compr_mpi,compi_mpi,norm_phig_mpi2)
end if
diff -uprN phase0_2015.01/src_phase/m_Epsilon_ek.F90 phase0_2015.01.01/src_phase/m_Epsilon_ek.F90
--- phase0_2015.01/src_phase/m_Epsilon_ek.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Epsilon_ek.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,7 +1,7 @@
#define NEC_TUNE
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 447 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 470 $)
!
! MODULE: m_Epsilon
!
@@ -32,7 +32,7 @@
! ================================================================
module m_Epsilon_ek
-! $Id: m_Epsilon_ek.F90 447 2015-08-05 02:38:25Z jkoga $
+! $Id: m_Epsilon_ek.F90 470 2015-10-05 03:15:15Z ktagami $
!
! Universal Virtual Spectroscope for Optoelectronics Research (UVSOR) ver 3.00
! UVSOR module for electronic dielectric function calculation
@@ -7060,14 +7060,23 @@ ppc_data(ntyp)
! set omega
if(nbi==nbj) then
omega = deg_omega ! -> intra_band case
+
+ else if(abs(omega) < 1.d-14) then ! -> degenerate case
+ if(omega >= 0.d0) then
+ omega = 1.d-14
+ else
+ omega = -1.d-14
+ end if
+! ====
else
- if(abs(omega) < 1.d-14) then ! -> degenerate case
- if(omega >= 0.d0) then
- omega = 1.d-14
+ if ( sw_scissor_renormalization == ON ) then
+ if ( omega > 0.0 ) then
+ omega = omega + scissor
else
- omega = -1.d-14
- end if
+ omega = omega - scissor
+ endif
end if
+! ====
end if
! add correction term
@@ -13044,6 +13053,16 @@ ppc_data(ntyp)
else
e21 = -delta_omega
end if
+! ==
+ else
+ if ( sw_scissor_renormalization == ON ) then
+ if ( e21 > 0.0 ) then
+ e21 = e21 + scissor
+ else
+ e21 = e21 - scissor
+ endif
+ endif
+! ==
end if
! ========================== 13.0R
end if
diff -uprN phase0_2015.01/src_phase/m_Excitation.F90 phase0_2015.01.01/src_phase/m_Excitation.F90
--- phase0_2015.01/src_phase/m_Excitation.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Excitation.F90 2016-07-12 12:51:19.000000000 +0900
@@ -2439,7 +2439,7 @@ contains
deallocate( zrho_work ); deallocate( ztrm2 )
deallocate( eko_wk ); deallocate( occ_wk )
- SpectrFn_vv = SpectrFn_vv /dble(kv3_fbz) /univol
+ SpectrFn_vv = SpectrFn_vv /dble(kv3_fbz/nspin) /univol
if ( nspin == 1 ) SpectrFn_vv = SpectrFn_vv *2.0d0
#if 0
@@ -2653,7 +2653,7 @@ contains
endif
End Do
- SpectrTensor_vv = SpectrTensor_vv /dble(kv3_fbz) /univol
+ SpectrTensor_vv = SpectrTensor_vv /dble(kv3_fbz/nspin) /univol
if ( nspin == 1 ) SpectrTensor_vv = SpectrTensor_vv *2.0d0
#if 0
@@ -2821,7 +2821,7 @@ contains
deallocate( work )
endif
- SpectrFn_vc = SpectrFn_vc /dble(kv3_fbz) /univol
+ SpectrFn_vc = SpectrFn_vc /dble(kv3_fbz/nspin) /univol
if ( nspin == 1 ) SpectrFn_vc = SpectrFn_vc *2.0d0
#if 0
diff -uprN phase0_2015.01/src_phase/m_FFT.F90 phase0_2015.01.01/src_phase/m_FFT.F90
--- phase0_2015.01/src_phase/m_FFT.F90 2015-09-14 15:18:23.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_FFT.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 449 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 481 $)
!
! MODULE: m_FFT
!
@@ -36,7 +36,7 @@
!
module m_FFT
-! $Id: m_FFT.F90 449 2015-08-06 04:37:59Z jkoga $
+! $Id: m_FFT.F90 481 2016-03-25 02:51:57Z jkoga $
!
use m_Timing, only : tstatc0_begin, tstatc0_end
use m_Files, only : nfout
@@ -1085,6 +1085,226 @@ include "m_FFT_type9_ffte.F90"
if(mod(nfft_pstrn,2) == 1) bfft(nfft_pstrn) = afft(nfft_pstrn)*bfft(nfft_pstrn)
end subroutine m_FFT_Vlocal_pW
+! === EXP_CELLOPT ==== 2015/09/24
+ subroutine m_FFT_coef_CD_integration_kt(ista,iend,f2or1)
+ ! from m_XC_Potential.F90, for electron ?
+ integer, intent(in) :: ista, iend
+ real(kind=DP),intent(out) :: f2or1( ista:iend )
+
+ integer :: idp,nlp,nmp,nnp,nd2p,nd3p,ip, idph, nlph
+
+ nlp = fft_box_size_CD(1,1)
+ nmp = fft_box_size_CD(2,1)
+ nnp = fft_box_size_CD(3,1)
+#ifdef _MPIFFT_
+ idp = fft_box_size_CD_c(1,0)
+ nd2p = fft_box_size_CD_c(2,0)
+ nd3p = fft_box_size_CD_c(3,0)
+#else
+ idp = fft_box_size_CD(1,0)
+ nd2p = fft_box_size_CD(2,0)
+ nd3p = fft_box_size_CD(3,0)
+#endif
+
+ call set_f2or1( npes, ista, iend, f2or1 )
+
+ contains
+
+ subroutine set_f2or1(npes,ista,iend,f2or1)
+ integer, intent(in) :: npes,ista, iend
+ real(kind=DP), intent(out), dimension(ista:iend) :: f2or1
+ integer :: idph,nlph,ip,i,j,k
+
+ if(kimg == 1) then
+ idph = idp/2
+ nlph = nlp/2
+#ifdef _MPIFFT_
+
+ f2or1 = 0.d0
+!!$ do j = 1, min(nz_d,nnp-nz_d*myrank_cdfft)*nmp
+!!$ do j = 1, min(nz_d,nnp-nz_d*myrank_cdfft)*nd2p
+ do k = 1, min(nz_d, nnp-nz_d*myrank_cdfft)
+ do j = 1, nmp
+ do i = 1, nlph
+!!$ ip = i + idph*(j-1) + idph*ly*lz_d*myrank_cdfft
+ ip = i + idph*(j-1) + idph*ly*(k-1) + idph*ly*lz_d*myrank_cdfft
+ f2or1(ip) = 2.d0
+ end do
+ ip = 1 + idph*(j-1) + idph*ly*(k-1) + idph*ly*lz_d*myrank_cdfft
+ f2or1(ip) = 1.d0
+ ip = nlph+1 + idph*(j-1) + idph*ly*(k-1) + idph*ly*lz_d*myrank_cdfft
+ f2or1(ip) = 1.d0
+ end do
+ end do
+!!$ ip = idph*(j-1) + 1 + idph*ly*lz_d*myrank_cdfft
+!!$ f2or1(ip) = 1.d0
+!!$ ip = idph*(j-1)+ nlph + 1 + idph*ly*lz_d*myrank_cdfft
+!!$ f2or1(ip) = 1.d0
+!!$ end do
+#else
+ f2or1 = 2.d0
+ if(npes >= 2) then
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + 1
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 1.d0
+ end do
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + nlph + 1
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 1.d0
+ end do
+ do j = nlph+2, idph
+ do i = 1,nd2p*nnp
+ ip = idph*(i-1)+j
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ do j = nmp+1, nd2p
+ do k = 1, nnp
+ do i = 1, nlph
+ ip = i + idph*(j-1) + idph*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p
+ do i = 1, idph*nd2p
+ ip = i + idph*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ else
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + 1
+ f2or1(ip) = 1.d0
+ end do
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + nlph + 1
+ f2or1(ip) = 1.d0
+ end do
+ do j = nlph+2, idph
+ do i = 1,nd2p*nnp
+ ip = idph*(i-1)+j
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ do j = nmp+1, nd2p
+ do k = 1, nnp
+ do i = 1, nlph
+ ip = i + idph*(j-1) + idph*nd2p*(k-1)
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p
+ do i = 1, idph*nd2p
+ ip = i + idph*nd2p*(k-1)
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ end if
+!!$ do i = ista, iend
+!!$ if(mod(i*2,idp) == 2 .or. mod(i*2,idp) == 0) f2or1(i) = 1.d0
+!!$ end do
+#endif
+ else
+#ifdef _MPIFFT_
+!!$ f2or1 = 0.d0 ! f2or1 works to the fft data in Rspace.
+!!$ do k = 1, min(nz_d,nnp-nz_d*myrank_cdfft)
+!!$ do j = 1, nmp ! nmp = fft_box_size_CD(2,1)
+!!$ do i = 1, nlp ! nlp = fft_box_size_CD(1,1)
+!!$ ip = i+(j-1)*idp+(k-1)*idp*nd2p+idp*nd2p*lz_d*myrank_cdfft
+!!$ f2or1(ip) = 1.d0
+!!$ end do
+!!$ end do
+!!$ end do
+! if(iprixc >= 2 ) write(nfout,'(" ix kimg = 2 <<set_f2or1>>")')
+ f2or1 = 1.d0
+ do j = nlp+1, idp ! x
+ do i = 1, ly*nz_d
+ ip = idp*(i-1)+j+ista-1
+ f2or1(ip) = 0.d0
+ end do
+ end do
+! if(iprixc >= 2 ) write(nfout,'(" iy kimg = 2 <<set_f2or1>>")')
+ do j = nmp+1,ly ! y
+ do k = 1, nz_d
+ do i = 1, nlp
+ ip = i + idp*(j-1) + idp*ly*(k-1) + ista-1
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! if(iprixc >= 2 ) write(nfout,'(" iz kimg = 2 <<set_f2or1>>")')
+ do k = nz_d+1, lz_d ! z
+ do i = 1, idp*ly
+ ip = i + idp*ly*(k-1) + ista-1
+ f2or1(ip) = 0.d0
+ end do
+ end do
+#else
+ f2or1 = 1.d0
+ if(npes >= 2) then
+ do j = nlp+1, idp ! x
+ do i = 1, nd2p*nnp
+ ip = idp*(i-1)+j
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ do j = nmp+1, nd2p ! y
+ do k = 1, nnp
+ do i = 1, nlp
+ ip = i + idp*(j-1) + idp*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p ! z
+ do i = 1, idp*nd2p
+ ip = i + idp*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ else
+ do j = nlp+1, idp ! x
+ do i = 1, nd2p*nnp
+ ip = idp*(i-1)+j
+! ================================ modifed by K. Tagami ====( uncertain )== 11.0
+! f2or1(ip) = 0.d0
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+! ===================================================================== 11.0
+ end do
+ end do
+ do j = nmp+1, nd2p ! y
+ do k = 1, nnp
+ do i = 1, nlp
+ ip = i + idp*(j-1) + idp*nd2p*(k-1)
+! ================================ modifed by K. Tagami ====( uncertain )== 11.0
+! f2or1(ip) = 0.d0
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+! ===================================================================== 11.0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p ! z
+ do i = 1, idp*nd2p
+ ip = i + idp*nd2p*(k-1)
+! ================================ modifed by K. Tagami ====( uncertain )== 11.0
+! f2or1(ip) = 0.d0
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+! ===================================================================== 11.0
+ end do
+ end do
+ end if
+#endif
+ end if
+ end subroutine set_f2or1
+ end subroutine m_FFT_coef_CD_integration_kt
+! ==================== 2015/09/24
+
subroutine m_FFT_coef_CD_integration(f2or1)
real(kind=DP),intent(out), dimension(ista_sfftph:iend_sfftph) :: f2or1
integer :: idp, nlp, nmp, nnp, nd2p, idph, nlph, ip, i, j, k
diff -uprN phase0_2015.01/src_phase/m_Files.F90 phase0_2015.01.01/src_phase/m_Files.F90
--- phase0_2015.01/src_phase/m_Files.F90 2015-09-14 15:18:31.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Files.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! SOFTWARE NAME : PHASE ($Revision: 454 $)
+! SOFTWARE NAME : PHASE ($Revision: 483 $)
!
! MODULE: m_Files
!
@@ -36,7 +36,7 @@
!
!
module m_Files
-! $Id: m_Files.F90 454 2015-09-07 07:58:39Z yamasaki $
+! $Id: m_Files.F90 483 2016-04-27 04:02:48Z ktagami $
!
! Operations concerning to files as "open", and "close",
! should be done in this module.
@@ -103,7 +103,9 @@ module m_Files
! ===================================== 13.0S
&, nfdynm_cif & ! CIF output
&, nfwfk_sq & ! squared wf
- &, nfwfk_integ_mom ! moment of wf ( integerated over space )
+ &, nfwfk_integ_mom & ! moment of wf ( integerated over space )
+ &, nfwfk_orb_proj & ! orbital-projection of wf
+ &, nfband_spectr_wght ! spectral weight for band unfolding
data &
& nfinp,nfpot & ! 31,(37,38,39,40,45,46,11-19,36)
@@ -140,6 +142,8 @@ module m_Files
& ,nfdynm_cif &
& ,nfwfk_sq &
& ,nfwfk_integ_mom &
+ & ,nfwfk_orb_proj &
+ & ,nfband_spectr_wght &
& /31,37,38,39,40,45,46 &
& ,11,12,13,14,15,16,17,18,19,36 &
@@ -169,9 +173,11 @@ module m_Files
! ================================== 13.0S
&, 500 &
&, 350 &
- &, 351 /
+ &, 351 &
+ &, 352 &
+ &, 345 /
- integer,private,parameter :: number_of_all_files = 76 + MAXNSP
+ integer,private,parameter :: number_of_all_files = 78 + MAXNSP
integer,private, dimension(number_of_all_files) :: n_file
data n_file &
@@ -202,7 +208,7 @@ module m_Files
! ================= KT_add ======== 13.0S
& ,370, 371, 372 &
! ================================= 13.0S
- & ,500, 350, 351 /
+ & ,500, 350, 351, 352, 345 /
integer,private,parameter :: stringlength_of_filenames = 260
character(len=stringlength_of_filenames) :: &
@@ -238,7 +244,8 @@ module m_Files
! ================= KT_add ====== 13.0S
&, F_CORE_ENERGY_OUT, F_CORE_ENERGY_INITIAL, F_CORE_ENERGY_FINAL &
! =============================== 13.0S
- &, F_DYNM_CIF, F_WFk_Squared, F_WFk_IntegMoment
+ &, F_DYNM_CIF, F_WFk_Squared, F_WFk_IntegMoment &
+ &, F_WFK_ORB_PROJ, F_BAND_SPECTR_WGHT
namelist/fnames/ &
& F_INP, F_POT, F_PKB, F_PD, F_PPC, F_STOP, F_OPGR &
@@ -272,7 +279,8 @@ module m_Files
! ================= KT_add ====== 13.0S
&, F_CORE_ENERGY_OUT, F_CORE_ENERGY_INITIAL, F_CORE_ENERGY_FINAL &
! =============================== 13.0S
- &, F_DYNM_CIF, F_WFk_Squared, F_Wfk_IntegMoment
+ &, F_DYNM_CIF, F_WFk_Squared, F_Wfk_IntegMoment &
+ &, F_WFK_ORB_PROJ, F_BAND_SPECTR_WGHT
logical :: F_ZAJ_partitioned = .false.
@@ -594,6 +602,12 @@ contains
if(mype==0) close(nfcntn_berry)
end subroutine m_Files_close_nfcntn_berry
+ logical function m_Files_nfcntn_bin_paw_exists()
+ logical :: ex
+ inquire(file=F_CNTN_BIN_PAW,exist=ex)
+ m_Files_nfcntn_bin_paw_exists = ex
+ end function m_Files_nfcntn_bin_paw_exists
+
subroutine m_Files_open_nfcntn_bin_paw
logical open
inquire(unit = nfcntn_bin_paw, opened = open)
@@ -890,6 +904,9 @@ contains
F_WFk_Squared = "./wfnsq.cube"
F_WFk_IntegMoment = "./wfn_integ_moment.data"
+ F_WFK_ORB_PROJ = "./wfn_orb_proj.data"
+
+ F_BAND_SPECTR_WGHT = "./nfband_spectr_wght.data"
end subroutine m_Files_set_default_filenames
@@ -1582,6 +1599,76 @@ contains
end if
end subroutine m_Files_close_nfeng
+! ===
+ subroutine m_Files_open_nfwfk_orb_proj(icond)
+ integer, intent(in) :: icond
+ logical :: open
+
+ if (mype==0) then
+ inquire(unit = nfwfk_orb_proj, opened = open)
+
+ if (open) close(nfwfk_orb_proj)
+
+ if (icond == FIXED_CHARGE .or. &
+ & (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ALL_AT_ONCE)) then
+ call open0( nfwfk_orb_proj, F_WFK_ORB_PROJ, 'F_WFK_ORB_PROJ',&
+ & unknown, formatted, check_file_name_on )
+ else if (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ONE_BY_ONE) then
+ call open1( nfwfk_orb_proj, F_WFK_ORB_PROJ, 'F_WFK_ORB_PROJ', &
+ & unknown,formatted, check_file_name_on )
+ else
+ call open1( nfwfk_orb_proj, F_WFK_ORB_PROJ, 'F_WFK_ORB_PROJ', &
+ & unknown,formatted, check_file_name_on )
+ end if
+ end if
+ end subroutine m_Files_open_nfwfk_orb_proj
+
+ subroutine m_Files_close_nfwfk_orb_proj()
+ logical :: open
+
+ if (mype==0) then
+ inquire( unit=nfwfk_orb_proj, opened = open )
+ if(open) close( nfwfk_orb_proj )
+ end if
+ end subroutine m_Files_close_nfwfk_orb_proj
+
+ subroutine m_Files_open_nfband_spwt(icond)
+ integer, intent(in) :: icond
+ logical :: open
+
+ if (mype==0) then
+ inquire(unit = nfband_spectr_wght, opened = open)
+
+ if (open) close(nfband_spectr_wght)
+
+ if (icond == FIXED_CHARGE .or. &
+ & (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ALL_AT_ONCE)) then
+ call open0( nfband_spectr_wght, F_BAND_SPECTR_WGHT, 'F_BAND_SPECTR_WGHT',&
+ & unknown, formatted, check_file_name_on )
+ else if (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ONE_BY_ONE) then
+ call open1( nfband_spectr_wght, F_BAND_SPECTR_WGHT, 'F_BAND_SPECTR_WGHT ', &
+ & unknown,formatted, check_file_name_on )
+ else
+ call open1( nfband_spectr_wght, F_BAND_SPECTR_WGHT, 'F_BAND_SPECTR_WGHT', &
+ & unknown,formatted, check_file_name_on )
+ end if
+ end if
+ end subroutine m_Files_open_nfband_spwt
+
+ subroutine m_Files_close_nfband_spwt()
+ logical :: open
+
+ if (mype==0) then
+ inquire( unit=nfband_spectr_wght, opened = open )
+ if(open) close( nfband_spectr_wght )
+ end if
+ end subroutine m_Files_close_nfband_spwt
+! ====
+
subroutine m_Files_close_nfinp()
logical :: op
if(mype == 0) then
diff -uprN phase0_2015.01/src_phase/m_Force.F90 phase0_2015.01.01/src_phase/m_Force.F90
--- phase0_2015.01/src_phase/m_Force.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Force.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_Force
!
@@ -49,7 +49,7 @@
#endif
module m_Force
-! $Id: m_Force.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Force.F90 472 2015-11-28 09:01:17Z ktagami $
use m_IterationNumbers, only : iteration_ionic
use m_Charge_Density, only : chgq_l, hsr
use m_Electronic_Structure, only : zaj_l,vlhxcQ,occup_l,eko_l &
@@ -104,6 +104,12 @@ module m_Force
use m_FFT, only : fft_box_size_CD,nfftps
use m_ES_nonlocal, only : betar_dot_Psi_4_each_k_in_rs0
+! === Positron ==== 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : Positron_GGGC, OFF
+ use m_Positron_Wave_Functions, only : pchg_l
+! ================= 2015/11/28
+
implicit none
include 'mpif.h'
@@ -492,6 +498,29 @@ contains
end if
end do
+! == POSITRON SCF === 2015/11/28
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_GGGC ) then
+ if(kimg == 1) then
+ do i = ista_kngp, iend_kngp !for mpi
+ tmp = -zfsin(i) *pchg_l(i,1) *psc_l(i,it)
+ fx = fx + tmp*ngabc(i,1)
+ fy = fy + tmp*ngabc(i,2)
+ fz = fz + tmp*ngabc(i,3)
+ end do
+ else
+ do i = ista_kngp, iend_kngp !for mpi
+ tmp = -( zfsin(i) *pchg_l(i,1) +zfcos(i)*pchg_l(i,2) )&
+ & *psc_l(i,it)
+ fx = fx + tmp*ngabc(i,1)
+ fy = fy + tmp*ngabc(i,2)
+ fz = fz + tmp*ngabc(i,3)
+ end do
+ endif
+ endif
+ endif
+! ============= 2015/11/28
+
f1_mpi(1) = fx; f1_mpi(2) = fy; f1_mpi(3) = fz
call mpi_allreduce(f1_mpi,f2_mpi,3 &
& ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
diff -uprN phase0_2015.01/src_phase/m_Ionic_System.F90 phase0_2015.01.01/src_phase/m_Ionic_System.F90
--- phase0_2015.01/src_phase/m_Ionic_System.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Ionic_System.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 442 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 490 $)
!
! MODULE: m_Ionic_System
!
@@ -53,7 +53,7 @@
module m_Ionic_System
! (m_IS)
-! $Id: m_Ionic_System.F90 442 2015-08-03 08:52:00Z jkoga $
+! $Id: m_Ionic_System.F90 490 2016-05-27 04:49:30Z jkoga $
!
! This module is for structure factor, ewald energy,
! and motions of atoms.
@@ -295,6 +295,7 @@ module m_Ionic_System
integer :: nrsv = 1 ! number of heat bath
integer :: set_initial_velocity = ON ! (by J. Koga)
integer :: sw_read_velocities = OFF ! (by T. Yamamoto)
+ integer :: sw_shift_velocities = OFF
real(kind=DP),private :: tk_initial = 0.d0
!!$ real(kind=DP),private,allocatable,dimension(:) :: qmass,tkb,cprv,frsv ! d(nrsv)
real(kind=DP),allocatable,dimension(:) :: qmass,tkb,cprv,frsv ! d(nrsv)
@@ -358,6 +359,7 @@ module m_Ionic_System
character(len("set_initial_velocity")),private,parameter :: tag_set_initial_velocity = "set_initial_velocity" ! (by J. Koga)
character(len("sw_read_velocities")),private,parameter :: tag_sw_read_velocities = "sw_read_velocities"
character(len("initial_temperature")),private,parameter :: tag_initial_temperature = "initial_temperature"
+ character(len("sw_shift_velocities")),private,parameter :: tag_sw_shift_velocities = "sw_shift_velocities"
! constraint sigma sgmc
! 1. BONDLENGTH_FIX_1
@@ -836,7 +838,10 @@ contains
end subroutine m_IS_put_lattice_system
subroutine alloc_normal_hypervector()
- allocate(normal_hypervector(natm,3,PUCV:CARTS))
+ if ( .not. allocated(normal_hypervector) ) then
+ allocate(normal_hypervector(natm,3,PUCV:CARTS))
+ endif
+ normal_hypervector = 0.0d0
end subroutine alloc_normal_hypervector
subroutine set_normal_hypervector()
@@ -1073,7 +1078,11 @@ contains
deallocate(work)
+ constraints_exist = .false.
+
! --- constraint ---
+ call initialize_constraint_param ! use this for cell optimization
+
if( f_selectBlock( tag_constraint) == 0) then
if(ipriinputfile >= 1) write(nfout,'(" !** -- tag_constraint is found --")')
if(imdalg == CG_STROPT) then
@@ -1114,7 +1123,7 @@ contains
iret = f_selectParentBlock()
end if
! --- setting bondlength fix sets ---
- call alloc_bondlength_fix_set() ! allocate(bondlength_fix_set(2,num_fixed_bonds))
+ if (tf) call alloc_bondlength_fix_set() ! allocate(bondlength_fix_set(2,num_fixed_bonds))
tf = f_selectBlock( tag_fixed_bond) == 0
if(.not.tf) tf = f_selectBlock( tag_fix_bondlength) == 0
if(.not.tf) tf = f_selectBlock( tag_bondlength_fix) == 0
@@ -1757,7 +1766,9 @@ contains
if ( f_getIntValue(tag_sw_read_velocities,iret) == 0 ) then
sw_read_velocities = iret
endif
-
+ if ( f_getIntValue(tag_sw_shift_velocities,iret) == 0 ) then
+ sw_shift_velocities = iret
+ endif
if( f_getRealValue(tag_initial_temperature,dret,"") == 0 ) then
tk_initial = dret * CONST_kB
if(ipriinputfile >= 1 .and. printable) then
@@ -4377,7 +4388,8 @@ contains
pcom(i) = 0.d0
do ia=1,natm
ir = icnstrnt_typ(imdt(ia),imdalg_t)
- if ((imode == 1 .and. ir >= 1 .and. imdtyp(ia).ne.0).or.(imode==2 .and. ir == 1.and.imdtyp(ia).ne.0)) then
+ if ((imode == 1 .and. ir >= 1 .and. imdtyp(ia).ne.0).or. &
+ & (imode == 2 .and. ir == 1 .and. imdtyp(ia).ne.0)) then
cpd_l(ia,i) = random(ir,ia,i)
if(iprimd >= 2) write(nfout,'(" !!! ia, ir = ",2i8," cpd_l(ia,",i3,") = " &
& ,f12.6, " <<set_initial_velocities>>")') ia, ir, i, cpd_l(ia,i)
@@ -4507,6 +4519,79 @@ contains
end subroutine m_IS_rd_n
+ subroutine shift_velocities(imode)
+ integer, intent(in) :: imode
+ integer :: i,j,ia,ir
+ real(kind=DP) :: mcom
+ integer,dimension(natm) :: imdt
+ integer :: icnstrnt_typ
+ integer :: imdalg_t
+ real(kind=DP),dimension(3) :: pcom
+ real(kind=DP), parameter :: eps = 1.d-12
+ if(imode == 1) then
+ do i=1,natm
+ if ( imdtyp(i) .le. NOSE_HOOVER ) then
+ imdt(i) = NOSE_HOOVER + 1
+ else
+ imdt(i) = imdtyp(i)
+ endif
+ enddo
+ imdalg_t = T_CONTROL
+ else
+ do i=1, natm
+ imdt(i) = imdtyp(i)
+ end do
+ imdalg_t = VERLET
+ end if
+
+ do i=1,3
+ pcom(i) = 0.d0
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ((imode == 1 .and. ir >= 1 .and. imdtyp(ia).ne.0).or. &
+ & (imode == 2 .and. ir == 1 .and. imdtyp(ia).ne.0)) then
+ pcom(i) = pcom(i) + amion(ityp(ia))*cpd_l(ia,i)
+ endif
+ enddo
+ enddo
+
+ mcom = 0.d0
+ if(imode == 1) then
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir >= 1 .and. imdtyp(ia).ne.0 ) then
+ mcom = mcom + amion(ityp(ia))
+ end if
+ end do
+ else
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir == 1 .and. imdtyp(ia).ne.0 ) then
+ mcom = mcom + amion(ityp(ia))
+ end if
+ end do
+ end if
+
+ ! shift velocity
+ if(mcom.gt.eps) pcom(:) = pcom(:)/mcom
+
+ if(imode == 1) then
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir >= 1 .and. imdtyp(ia).ne.0 ) then
+ cpd_l(ia,:) = cpd_l(ia,:) - pcom(:)
+ endif
+ enddo
+ else
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir == 1 .and. imdtyp(ia).ne.0 ) then
+ cpd_l(ia,:) = cpd_l(ia,:) - pcom(:)
+ endif
+ enddo
+ end if
+ end subroutine shift_velocities
+
!!$ 2011.06.06
subroutine scale_velocity()
integer :: ia,ir,irp
@@ -5647,6 +5732,7 @@ contains
stop ' Invalid value of mdmode <<m_IS_md>>'
end if
+ if (sw_shift_velocities==ON.and.mdalg==VERLET) call shift_velocities(1)
deallocate(forc_l)
call md1_dealloc()
call tstatc0_end(id_sname)
@@ -6353,6 +6439,12 @@ contains
end function m_IS_force_check_md_nhp
! <--
+ subroutine initialize_constraint_param
+ forcmx_constraint_quench = 1.d+2
+ forc_norm_hyperplane_vert = 1.d+2
+ forcmx_hyperplane_vert = 1.d+2
+ end subroutine initialize_constraint_param
+
subroutine evolve_velocities(mdalg,forc_l)
integer, intent(in) :: mdalg
real(kind=DP), intent(inout), dimension(natm,3) :: forc_l
@@ -8005,7 +8097,7 @@ end if
if(t_ctrl_method == VELOCITY_SCALING)then
call scale_velocity()
endif
-
+ if (sw_shift_velocities==ON) call shift_velocities(1)
call md2_dealloc !-(m_Ionic_System)
call tstatc0_end(id_sname)
contains
@@ -8593,6 +8685,10 @@ end if
integer :: id_sname = -1
call tstatc0_begin('m_IS_gdiis ',id_sname)
+ if(absolute_convergence_of_forc(forc_l_in))then
+ write(nfout,'(a)') ' m_IS_gdiis: forces are absolutely converged!! nothing to do...'
+ return
+ endif
if(mdmode == ORDINA) then
allocate(forc_l(natm,3))
@@ -9783,6 +9879,10 @@ end if
integer :: id_sname = -1
call tstatc0_begin('m_IS_cg2',id_sname)
+ if(absolute_convergence_of_forc(forc_l_in))then
+ write(nfout,'(a)') ' CG2: forces are absolutely converged!! nothing to do...'
+ return
+ endif
if(.not.allocated(vec_g)) allocate(vec_g(natm,3))
if(.not.allocated(vec_h)) allocate(vec_h(natm,3))
@@ -9792,6 +9892,7 @@ end if
if(.not.allocated(cps2)) allocate(cps2(natm,3))
if(.not.allocated(f_total2)) allocate(f_total2(natm,3))
+
f_total0(:,:) = forc_l_in(:,:)
@@ -10643,6 +10744,80 @@ end if
#endif
end subroutine m_IS_symmetrize_atom_pos
+ subroutine m_IS_force_af_symmetry(nfout)
+#ifdef SX
+!CDIR BEGIN NOVECTOR
+#endif
+ integer, intent(in) :: nfout
+
+ real(kind=DP), dimension(natm2,3) :: cps_wk,cps_wk2
+ real(kind=DP), dimension(natm,3) :: cpso,poso
+ real(kind=DP), dimension(3,3) :: rltv_t
+ real(kind=DP), dimension(3) :: p,di,dimin
+ real(kind=DP) :: df,dfmin
+ integer, dimension(natm2) :: ityp_wk,ityp_af
+ integer :: i,n,ia,ja,iia
+ cps_wk(1:natm,1:3) = cps(1:natm,1:3)
+ do i=1,natm
+ ityp_af(i) = nint(iatomn(ityp(i)))
+ end do
+ n = natm
+ do i=1,natm
+ if(iwei(i)==1) cycle
+ n = n + 1
+ cps_wk(n,1:3) = -cps(i,1:3)
+ ityp_af(n) = nint(iatomn(ityp(i)))
+ end do
+ cps_wk2 = 0.d0
+ do ia=1,natm2
+ p = matmul(op(1:3,1:3,nopr+af),cps_wk(ia,1:3)) + tau(1:3,nopr+af,CARTS)
+ iia = 0
+ dfmin = 1.d10
+ do ja=1,natm2
+ if(ityp_af(ia) /= ityp_af(ja)) cycle
+ di = matmul(transpose(rltv),(p - cps_wk(ja,1:3)))
+ df = sum(abs(cos(di(1:3))-1.d0))
+ if(df < dfmin) then
+ iia = ja
+ dfmin = df
+ dimin = di/PAI2
+ end if
+ end do
+ if(iia == 0) stop 'm_IS_symmetrize_atom_pos: error iia=0'
+ p = p - matmul(altv,nint(dimin))
+ cps_wk2(iia,1:3) = cps_wk2(iia,1:3) + p(1:3)
+ cps_wk(iia,1:3) = cps_wk2(iia,1:3)
+ end do
+
+ cpso = cps
+ poso = pos
+ cps = cps_wk2(1:natm,1:3)
+ rltv_t = transpose(rltv)/PAI2
+ call change_of_coordinate_system(rltv_t,cps,natm,natm,pos) !-(b_I.S.) cps -> pos
+ if(printable.and.ipri>1) then
+ write(nfout,*) 'Atomic coordinates were symmetrized.'
+ !!$write(nfout,'(20x,"Inputted Cartesian coordinate -> symmetrized Cartesian coordinate")')
+ !!$do ia=1,natm
+ !!$ write(nfout,'(i4,3f15.8," -> ",3f15.8)') ia,cpso(ia,1:3),cps(ia,1:3)
+ !!$end do
+ !!$write(nfout,'(20x,"Inputted internal coordinate -> symmetrized internal coordinate")')
+ !!$do ia=1,natm
+ !!$ write(nfout,'(i4,3f15.8," -> ",3f15.8)') ia,poso(ia,1:3),pos(ia,1:3)
+ !!$end do
+ write(nfout,'(" === Symmetrized Cartesian coordinates and errors===")')
+ do ia=1,natm
+ write(nfout,'(i4,7f18.9)') ia,cpso(ia,1:3),cps(ia,1:3),sqrt(sum((cps(ia,1:3)-cpso(ia,1:3))**2))
+ end do
+ write(nfout,'(" === Symmetrized internal coordinates ===")')
+ do ia=1,natm
+ write(nfout,'(i4,6f18.9)') ia,poso(ia,1:3),pos(ia,1:3)
+ end do
+ end if
+#ifdef SX
+!CDIR END
+#endif
+ end subroutine m_IS_force_af_symmetry
+
subroutine m_IS_dealloc(neb_mode)
logical, intent(in), optional :: neb_mode
logical :: neb
@@ -11478,4 +11653,19 @@ end if
deallocate(pos_full)
end subroutine m_IS_dump_cif
+ logical function absolute_convergence_of_forc(forc_l_in)
+ real(kind=DP), intent(in), dimension(natm,3) :: forc_l_in
+ real(kind=DP),allocatable,dimension(:,:) :: forct
+ integer :: ia
+ allocate(forct(natm,3));forct=forc_l_in
+ absolute_convergence_of_forc = .false.
+ do ia=1,natm
+ if(imdtyp(ia)==0) forct(ia,:)=0.d0
+ enddo
+ if(sum(forct(1:natm,1:3)**2).lt.1e-15)then
+ absolute_convergence_of_forc = .true.
+ endif
+ deallocate(forct)
+ end function absolute_convergence_of_forc
+
end module m_Ionic_System
diff -uprN phase0_2015.01/src_phase/m_Kpoints.F90 phase0_2015.01.01/src_phase/m_Kpoints.F90
--- phase0_2015.01/src_phase/m_Kpoints.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Kpoints.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 486 $)
!
! MODULE: m_Kpoint
!
@@ -37,7 +37,7 @@
!
module m_Kpoints
! (m_Kp)
-! $Id: m_Kpoints.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Kpoints.F90 486 2016-05-15 13:59:14Z ktagami $
!
use m_Crystal_Structure, only : il,imag,inv,ngen,igen,jgen, a,b,c,ca,cb,cc &
& , altv, rltv, nbztyp , nbztyp_spg, n1_sc, n2_sc, n3_sc
@@ -237,7 +237,7 @@ contains
end if
end if
if(npes > 1) call mpi_bcast(kv3_previous,1,mpi_integer,0,mpi_comm_group,ierr)
- if(printable) write(nfout,'(i5, " : kv3_previous_job")') kv3_previous
+ if(printable) write(nfout,'(i8, " : kv3_previous_job")') kv3_previous
end subroutine m_Kp_rd_kv3
subroutine m_Kp_rd_n(nfout)
@@ -560,7 +560,7 @@ contains
allocate(vkxyz(kv3,3,CRDTYP)); vkxyz = 0.d0
if(ipri_kp >= 2) then
write(nfout,'(" !kp vkxyz is allocated now <<m_Kp_alloc_kpoints>>")')
- write(nfout,'(" !kp kv3 = ", i5," CRDTYP = ",i3)') kv3,CRDTYP
+ write(nfout,'(" !kp kv3 = ", i8," CRDTYP = ",i3)') kv3,CRDTYP
end if
else
if(ipri_kp >= 2) write(nfout,'(" !kp vkxyz is already allocated <<m_Kp_alloc_kpoints>>")')
@@ -692,9 +692,9 @@ contains
! ================================================================ 11.0
if(ipri_kp >=1 ) then
- write(nfout,'(" !kp ek_group = ",i5)') ek_group
- write(nfout,'(" !kp kv3_ek = ",i5)') kv3_ek
- write(nfout,'(" !kp kv3 = ",i5)') kv3
+ write(nfout,'(" !kp ek_group = ",i8)') ek_group
+ write(nfout,'(" !kp kv3_ek = ",i8)') kv3_ek
+ write(nfout,'(" !kp kv3 = ",i8)') kv3
end if
end subroutine m_Kp_set_ek_group
@@ -783,7 +783,7 @@ contains
read(nfinp,'(a132)') str
if(ipri_kp>=2) write(nfout,'(" ! str : ",a50)') str(1:50)
call read_nkpnt(str,len_str,ikpnt) !-(b_Kpoints)
- if(ipri_kp>=2) write(nfout,'(" ! ikpnt(#skipped lines) = ",i5)') ikpnt
+ if(ipri_kp>=2) write(nfout,'(" ! ikpnt(#skipped lines) = ",i8)') ikpnt
read(nfinp,'(a132)') str
call read_coordsystem(str,len_str,sw_k_coord_system) !-(b_Kpoints)
if(sw_k_coord_system == NODATA) ikpnt = ikpnt - 1
@@ -976,7 +976,7 @@ contains
! =============== 2014/09/30
else
- if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i5, " nspin = ", i5)') kv3,nspin
+ if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i8, " nspin = ", i5)') kv3,nspin
! ======================= added by K. Tagami ================== 11.0
if(ipri_kp>=1) write(nfout,*) 'ndim_spinor = ', ndim_spinor
@@ -1794,7 +1794,7 @@ contains
call first_bz(b1,b2,b3,nkmesh,kmesh,nmp_kmesh,mp_kmesh,nface,face)
if(printable .and. printlevel .ge. 0) &
- & write(output,'(1x,"number of k-points in MP mesh = ",i5)') nmp_kmesh
+ & write(output,'(1x,"number of k-points in MP mesh = ",i8)') nmp_kmesh
! debug
!do i=1,nmp_kmesh
@@ -1826,7 +1826,7 @@ contains
call first_bz(b1,b2,b3,nkmesh,kmesh,nfbz_kmesh,fbz_kmesh,nface,face)
if(printable .and. printlevel .ge. 0) &
- & write(output,'(1x,"number of k-points in full BZ = ",i5)') nfbz_kmesh
+ & write(output,'(1x,"number of k-points in full BZ = ",i8)') nfbz_kmesh
! debug
!do i=1,nfbz_kmesh
@@ -2272,7 +2272,8 @@ contains
integer :: i,j,n
integer :: nequiv(nkpmax)
real(kind=DP) :: g(3),q(3)
- real(kind=DP), parameter :: eps = 1.d-3
+! real(kind=DP), parameter :: eps = 1.d-3
+ real(kind=DP), parameter :: eps = 1.d-5
logical :: not_included(nfbz_kmesh)
not_included(1:nfbz_kmesh) = .true.
@@ -2334,7 +2335,8 @@ contains
integer :: i,j,n
integer :: nequiv(nkpmax)
real(kind=DP) :: g(3), q(3), vec_tmp(3)
- real(kind=DP), parameter :: eps = 1.d-3
+! real(kind=DP), parameter :: eps = 1.d-3
+ real(kind=DP), parameter :: eps = 1.d-5
logical :: not_included(nfbz_kmesh)
not_included(1:nfbz_kmesh) = .true.
@@ -2436,7 +2438,7 @@ contains
if(printable .and. printlevel .ge. 0) &
- & write(output,'(1x,"number of k-points in irreducible BZ = ",i5)') nkpoint
+ & write(output,'(1x,"number of k-points in irreducible BZ = ",i8)') nkpoint
call gen_rgrid(a1,a2,a3,rgrid)
@@ -2515,7 +2517,7 @@ contains
if( n == nshell ) stop 'accuracy: n == nshell, accuracy check failure'
if(printable .and. printlevel .ge. 0 ) then
- write(output,'(1x,"Index of the first none zero shell = ",i5)') none_zero
+ write(output,'(1x,"Index of the first none zero shell = ",i8)') none_zero
write(output,'(1x,"|R| of the first none zero shell = ",f10.5)') length_nz
write(output,'(1x,"phase sum = ",f10.5)') sm_nz
write(output,'(1x,"efficiency = ",f8.2)') dble(none_zero)/dble(nkpoint)
@@ -2524,7 +2526,7 @@ contains
if(printable .and. printlevel .ge. 1) then
write(output,'(5x,4(1x,a10))') 'k1','k2','k3','weight'
do i=1,nkpoint
- write(output,'(i5,4(1x,f10.5))') i,kpoint(1:3,i),weight(i)
+ write(output,'(i8,4(1x,f10.5))') i,kpoint(1:3,i),weight(i)
end do
end if
@@ -2869,7 +2871,7 @@ contains
subroutine m_Kp_set_kv3(nk)
integer, intent(in) ::nk
kv3 = nk
- if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i5," <<m_kp_set_kv3>>")') kv3
+ if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i8," <<m_kp_set_kv3>>")') kv3
end subroutine m_Kp_set_kv3
subroutine m_Kp_set_mesh_super
diff -uprN phase0_2015.01/src_phase/m_Ldos.F90 phase0_2015.01.01/src_phase/m_Ldos.F90
--- phase0_2015.01/src_phase/m_Ldos.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Ldos.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 471 $)
!
! MODULE: m_Ldos
!
@@ -31,7 +31,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
module m_Ldos
-! $Id: m_Ldos.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: m_Ldos.F90 471 2015-11-13 01:14:05Z jkoga $
use m_Const_Parameters, only : DP, CMPLDP, REGULAR_INTERVALS, BY_ATOMIC_POSITIONS &
& , DELTA10, EXECUT, ON, SOFTPART, HARDPART, DIRECT, PAI2 &
& , ALDOS, LAYERDOS, NO, OFF, ELECTRON
@@ -72,7 +72,8 @@ module m_Ldos
& , m_CD_restore_chgq &
& , m_CD_map_chgq_to_fft_box &
& , m_CD_set_ylm_enl_etc &
- & , m_CD_dealloc_ylm_enl_etc
+ & , m_CD_dealloc_ylm_enl_etc &
+ & , m_CD_keep_retrieve_hsr
! ============================== added by K. Tagami ============== 11.0
use m_Control_Parameters, only : noncol, ndim_magmom, ndim_spinor
@@ -648,6 +649,7 @@ contains
denom = 1.d0/product(fft_box_size_WF(1:3,1))
+ call m_CD_keep_retrieve_hsr(.true.)
if(ekmode == ON) then
is = 1
do ik = 1, kv3
@@ -856,6 +858,8 @@ contains
end if
+ call m_CD_keep_retrieve_hsr(.false.)
+
if(modnrm == EXECUT) call m_CD_dealloc_ylm_enl_etc()
if(hardpart_subroutine/=2.and.sw_rspace_ldos==OFF) call m_CD_restore_chgq()
if(allocated(meshwk)) deallocate(meshwk)
@@ -1557,6 +1561,7 @@ contains
allocate( chgq_enl_kt(kgp,kimg,ndim_magmom) )
chgq_enl_kt = 0.0d0
+ call m_CD_keep_retrieve_hsr(.true.)
if (ekmode == ON) then
do ik = 1, kv3, ndim_spinor
call m_FFT_alloc_WF_work()
@@ -1811,6 +1816,8 @@ contains
end if
+ call m_CD_keep_retrieve_hsr(.false.)
+
if (modnrm == EXECUT) call m_CD_dealloc_ylm_enl_etc()
if (hardpart_subroutine/=2.and.sw_rspace_ldos==OFF) call m_CD_restore_chgq()
diff -uprN phase0_2015.01/src_phase/m_OP_Moment.F90 phase0_2015.01.01/src_phase/m_OP_Moment.F90
--- phase0_2015.01/src_phase/m_OP_Moment.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_OP_Moment.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,5 +1,5 @@
module m_OP_Moment
-! $Id: m_OP_Moment.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_OP_Moment.F90 479 2016-03-12 12:30:51Z ktagami $
! =========== Contributions ===================================
!
@@ -159,6 +159,8 @@ contains
istmp = ( is1 -1 )*ndim_spinor + is2
Do m1=1, size1
Do m2=1, size1
+ if ( m1 /= m2 ) cycle
+
spinmom(1) = spinmom(1) +dmmat_ssrep(m1,m2,istmp) &
& *PauliMatrix(2,is2,is1)
spinmom(2) = spinmom(2) +dmmat_ssrep(m1,m2,istmp) &
@@ -191,8 +193,10 @@ contains
write(nfout,*) '! ia l type mx my mz '
!
- write(nfout,'(I7,I4,3X,A5,3F15.8)') ia, l, "orb ", orbmom(1), orbmom(2), orbmom(3)
- write(nfout,'(14X, A5,3F15.8)') "spin ", spinmom(1), spinmom(2), spinmom(3)
+ write(nfout,'(I7,I4,3X,A5,3F15.8)') ia, l, &
+ & "spin ", spinmom(1), spinmom(2), spinmom(3)
+ write(nfout,'(14X, A5,3F15.8)') &
+ & "orb ", orbmom(1), orbmom(2), orbmom(3)
!
write(nfout,*) '! ------ '
@@ -742,7 +746,7 @@ contains
Do it=1, ntyp
call new_radr_and_wos(ista_k,it)
- rad1 = rad_cov_default( iatomn(it) )
+ rad1 = rad_cov_default( nint(iatomn(it)) ) ! Revised according to a report from ASMS Co.ltd, 10 March 2016.
do lmt1=1,ilmt(it)
il1=ltp(lmt1,it); im1=mtp(lmt1,it); it1=taup(lmt1,it)
@@ -1210,29 +1214,13 @@ contains
integer :: ja
integer :: ixyz1, ixyz2, is_tmp
- real(kind=DP) :: ctmp1, weight, ctmp2
+ real(kind=DP) :: ctmp1, weight, ctmp2, weight2, determinant
allocate(hsr_tmp(natm,nlmt,nlmt,ndim_magmom)); hsr_tmp = 0.0d0
allocate(hsi_tmp(natm,nlmt,nlmt,ndim_magmom)); hsi_tmp = 0.0d0
!
hsr_tmp = rho_ylm1_ylm2_r; hsi_tmp = rho_ylm1_ylm2_i
-#if 0
- Do ia=1, natm
- it = ityp(ia)
- do lmt1 = 1, ilmt(it)
- do lmt2 = 1, ilmt(it)
- do is_tmp=1, ndim_magmom
- write(850+mype,*) ' ia lmt1 lmt2 istmp = ', ia, lmt1,lmt2,is_tmp
- write(850+mype,*) 'A ', hsr_tmp(ia,lmt1,lmt2,is_tmp), hsr_tmp(ia,lmt2,lmt1,is_tmp)
- write(850+mype,*) 'B ', hsi_tmp(ia,lmt1,lmt2,is_tmp), hsi_tmp(ia,lmt2,lmt1,is_tmp)
- end do
- end do
- end do
- end Do
- close( 850+mype )
-#endif
-
do ia=1,natm
it=ityp(ia)
do is =1, ndim_magmom
@@ -1254,6 +1242,13 @@ contains
weight = 1.0d0
endif
+ call calc_determinant( op(:,:,iopr), determinant )
+ if ( determinant > 0 ) then
+ weight2 = 1.0d0
+ else
+ weight2 = -1.0d0
+ endif
+
do ia = 1, natm
it = ityp(ia)
ja=abs(ia2ia_symmtry_op_inv(ia,iopr))
@@ -1298,7 +1293,7 @@ contains
crotylm_paw(m,jj,iopr,ia)
rho_ylm1_ylm2_i(ia,lmt1,lmt2,1) = &
rho_ylm1_ylm2_i(ia,lmt1,lmt2,1) + &
- weight * &
+ weight * weight2 * &
hsi_tmp(ja,lmt3,lmt4,1)* &
crotylm_paw(n,ii,iopr,ia)* &
crotylm_paw(m,jj,iopr,ia)
@@ -1306,7 +1301,8 @@ contains
Do ixyz1=1, 3
Do ixyz2=1, 3
ctmp1 = op(ixyz2, ixyz1, iopr) *weight
-
+ ctmp2 = op(ixyz2, ixyz1, iopr) *weight2
+
rho_ylm1_ylm2_r(ia,lmt1,lmt2,ixyz2+1) &
& = rho_ylm1_ylm2_r(ia,lmt1,lmt2,ixyz2+1) &
& + ctmp1 &
@@ -1315,7 +1311,7 @@ contains
& *crotylm_paw(m,jj,iopr,ia)
rho_ylm1_ylm2_i(ia,lmt1,lmt2,ixyz2+1) &
& = rho_ylm1_ylm2_i(ia,lmt1,lmt2,ixyz2+1) &
- & + op(ixyz2, ixyz1, iopr) &
+ & + ctmp2 &
& *hsi_tmp(ja,lmt3,lmt4,ixyz1+1) &
& *crotylm_paw(n,ii,iopr,ia) &
& *crotylm_paw(m,jj,iopr,ia)
@@ -1335,22 +1331,6 @@ contains
rho_ylm1_ylm2_r = rho_ylm1_ylm2_r/nopr; rho_ylm1_ylm2_i = rho_ylm1_ylm2_i/nopr;
-#if 0
- Do ia=1, natm
- it = ityp(ia)
- do lmt1 = 1, ilmt(it)
- do lmt2 = 1, ilmt(it)
- do is_tmp=1, ndim_magmom
- write(860+mype,*) ' ia lmt1 lmt2 istmp = ', ia, lmt1,lmt2,is_tmp
- write(860+mype,*) 'A ', rho_ylm1_ylm2_r(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_r(ia,lmt2,lmt1,is_tmp)
- write(860+mype,*) 'B ', rho_ylm1_ylm2_i(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_i(ia,lmt2,lmt1,is_tmp)
- end do
- end do
- end do
- end Do
- close( 860+mype )
-#endif
-
do ia=1,natm
it=ityp(ia)
do is =1, ndim_magmom
@@ -1363,24 +1343,19 @@ contains
end do
end do
-#if 0
- Do ia=1, natm
- it = ityp(ia)
- do lmt1 = 1, ilmt(it)
- do lmt2 = 1, ilmt(it)
- do is_tmp=1, ndim_magmom
- write(870+mype,*) ' ia lmt1 lmt2 istmp = ', ia, lmt1,lmt2,is_tmp
- write(870+mype,*) 'A ', rho_ylm1_ylm2_r(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_r(ia,lmt2,lmt1,is_tmp)
- write(870+mype,*) 'B ', rho_ylm1_ylm2_i(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_i(ia,lmt2,lmt1,is_tmp)
- end do
- end do
- end do
- end Do
- close( 870+mype )
-#endif
-
deallocate(hsr_tmp); deallocate(hsi_tmp)
+ contains
+ subroutine calc_determinant( a, determinant )
+ real(kind=DP), intent(in) :: a(3,3)
+ real(kind=DP), intent(out) :: determinant
+
+ determinant = a(1,1)*( a(2,2)*a(3,3) -a(2,3)*a(3,2) ) &
+ & -a(1,2)*( a(2,1)*a(3,3) -a(2,3)*a(3,1) ) &
+ & +a(1,3)*( a(2,1)*a(3,2) -a(2,2)*a(3,1) )
+
+ end subroutine calc_determinant
+
end subroutine symmetrz_rho_ylm1_ylm2
! ============= 2014/08/26
diff -uprN phase0_2015.01/src_phase/m_Orbital_Population.F90 phase0_2015.01.01/src_phase/m_Orbital_Population.F90
--- phase0_2015.01/src_phase/m_Orbital_Population.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Orbital_Population.F90 2016-07-12 12:51:19.000000000 +0900
@@ -29,7 +29,7 @@
!
!
module m_Orbital_Population
-! $Id: m_Orbital_Population.F90 416 2014-12-17 04:11:16Z jkoga $
+! $Id: m_Orbital_Population.F90 492 2016-05-31 03:06:04Z jkoga $
use m_Const_Parameters, only : DP,ON,ANEW,RENEW,SIMPLE,BROYD1,BROYD2,DFP,PULAY,OFF,UNIT_MATRIX
use m_Files, only : nfout, nfoccmat, m_Files_open_nfoccmat
use m_IterationNumbers, only : iteration_for_cmix
@@ -37,7 +37,9 @@ module m_Orbital_Population
& , proj_attribute &
& , proj_group, num_proj_elems, max_projs &
& , iprihubbard &
- & , hownew,nbxmix,istrbr,ipripulay, sw_force_simple_mixing_hub
+ & , hownew,nbxmix,istrbr,ipripulay, sw_force_simple_mixing_hub &
+ & , sw_metric_diff, alpha_pulay, sw_recomposing &
+ & , sw_mix_bothspins_sametime, sw_force_simple_mixing
use m_Ionic_System, only : natm,ntyp,ityp,iproj_group,zeta1
use m_PseudoPotential, only : prodphi,ilmt,ltp,mtp,taup,nlmt,ntau,nlmtt
use m_Crystal_Structure, only : op,nopr
@@ -141,6 +143,11 @@ module m_Orbital_Population
integer, private :: sw_mix_imaginary_component = ON
! ===================================================================== 11.0
+ real(DP),private,allocatable,target,dimension(:,:,:,:) :: urec_l
+ real(DP),private,allocatable,dimension(:,:) :: d0_l,u_l,v_l
+ real(kind=DP), allocatable, dimension(:,:) :: ynorm
+ real(DP),private,allocatable,dimension(:) :: f_p !d(ista_kgpm:iend_kgpm)
+
include 'mpif.h'
contains
@@ -187,6 +194,56 @@ contains
!!$write(nfout,*) 'nyymax=',nyymax
end subroutine m_OP_set_i2lp_max2lp
+ subroutine m_OP_store_om()
+ omold = om
+ end subroutine m_OP_store_om
+
+ subroutine m_OP_om_diff()
+ integer :: is,ia,ja,it,ilmt1,ilmt2
+ integer :: l1,l2,m1,m2,t1,t2,m1r,m2r
+ integer :: iyy,iopr,mm1,mm2
+ integer :: ig,ip,i
+
+ integer :: ilp
+ real(kind=DP) :: diff,sumdiff
+ integer :: icount
+ sumdiff = 0.d0
+ icount=0
+ do is=1,nspin,af+1
+
+ do ia=1,natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+
+ do i=1,num_proj_elems(ig)
+ ip=proj_group(i,ig)
+ it = proj_attribute(ip)%ityp
+ ilp = proj_attribute(ip)%l+1
+
+ do ilmt1 = 1, ilmt(it)
+ l1 = ltp(ilmt1,it); m1 = mtp(ilmt1,it)
+ t1 = taup(ilmt1,it)
+ if ( l1 /= ilp ) cycle
+
+ do ilmt2 = 1, ilmt(it)
+ l2 = ltp(ilmt2,it); m2 = mtp(ilmt2,it)
+ t2 = taup(ilmt2,it)
+ if( l2 /= ilp ) cycle
+
+ diff = abs(omold(m1,m2,i,ia,is)-om(m1,m2,i,ia,is))
+ sumdiff = sumdiff+diff
+ icount = icount+1
+ end do
+ end do
+! =============================================================
+ end do
+ !!if(printable) write(nfout,'(a,i5,a,f20.12)') 'omdiff for atom ',ia,' : ',sumdiff/dble(icount)
+ sumdiff = 0.d0
+ icount = 0
+ end do
+ end do
+ end subroutine m_OP_om_diff
+
subroutine m_OP_alloc
allocate(i2lp(num_projectors))
call m_OP_set_i2lp_max2lp
@@ -2348,36 +2405,430 @@ contains
else
nspin_m = nspin/(af+1)
endif
-! ====================================================================== 11.0
- allocate(din(nsize_rho,nspin_m))
- allocate(dout(nsize_rho,nspin_m))
- allocate(urec(nsize_rho,nspin_m,nbxmix,2))
+! ================================================================= 11.0
+
+! =========================================== Modified by K. Tagami =========
+! allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_CD)
+ allocate(f_p(1:nsize_rho)); f_p = 0
+! ============================================================================
+
+ allocate(din(1:nsize_rho,nspin_m))
+ allocate(dout(1:nsize_rho,nspin_m))
+ allocate(urec_l(1:nsize_rho,nspin_m,nbxmix,2))
allocate(uuf_p(nbxmix,nspin_m))
allocate(f(nbxmix,nbxmix,nspin_m))
allocate(g_p(nbxmix,nspin_m))
allocate(ncrspd(nbxmix))
+
+ allocate(ynorm(nbxmix,nspin_m));ynorm=1.d0
+! ======================================= Added by K. Tagami ===========
+ din = 0.0d0; dout = 0.0d0; urec_l = 0.0d0; uuf_p = 0.0d0; f = 0.0d0
+ g_p = 0.0d0; ncrspd = 0
+! ======================================================================
end subroutine mix_pulay_allocate
subroutine mix_pulay_deallocate
+ if(allocated(f_p)) deallocate(f_p)
if(allocated(din)) deallocate(din)
if(allocated(dout)) deallocate(dout)
- if(allocated(urec)) deallocate(urec)
+ if(allocated(urec_l)) deallocate(urec_l)
if(allocated(uuf_p)) deallocate(uuf_p)
if(allocated(f)) deallocate(f)
if(allocated(g_p)) deallocate(g_p)
if(allocated(ncrspd)) deallocate(ncrspd)
+ if (allocated(ynorm)) deallocate(ynorm)
end subroutine mix_pulay_deallocate
subroutine mix_pulay_alloc2
- allocate(d0(nsize_rho,nspin_m))
+ allocate(d0_l(nsize_rho,nspin_m))
+ d0_l = 0.0d0
end subroutine mix_pulay_alloc2
subroutine mix_pulay_dealloc2
- deallocate(d0)
+ deallocate(d0_l)
end subroutine mix_pulay_dealloc2
subroutine m_OP_mix_pulay(rmx)
- real(kind=DP), intent(in) :: rmx
+ integer, parameter :: iRho = 1, iResid = 2
+ real(DP),intent(in) :: rmx
+ integer :: iter, mxiter
+ real(DP),pointer,dimension(:) :: e_wk, f_wk, ww1, finv
+ integer, pointer,dimension(:) :: ip
+! --> T. Yamasaki 03 Aug. 2009
+ real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
+! real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
+! <--
+ real(kind=DP) :: rmxtt
+ integer :: id_sname = -1
+ call tstatc0_begin('m_OP_mix_pulay ',id_sname,1)
+
+ if(previous_waymix /= PULAY) then
+ if(first) then
+ call create_map_func(.true.)
+ call alloc_rho
+ call create_map_func(.false.)
+ first = .false.
+ end if
+ call mix_dealloc_previous()
+ call mix_pulay_allocate()
+ end if
+
+ if ( noncol ) then
+ call map_om_to_rho_noncl(om, om_aimag, rho)
+ call map_om_to_rho_noncl(omold,omold_aimag,rhoo)
+ else
+ call map_om_to_rho(om,rho)
+ call map_om_to_rho(omold,rhoo)
+ endif
+
+ iter = iter_from_reset() !-(m_OP)
+
+ nspin_m = ndim_magmom/(af+1)
+ allocate( rmxtrck(nspin_m) )
+ if ( noncol ) then
+ rmxtrck = rmx
+ else
+ if ( sw_recomposing_occmat == YES .and. af == 0 .and. nspin == 2 ) then
+ call alloc_rhostore_recomp( rmx, rmxtrck )
+ else
+ rmxtrck = rmx
+ endif
+ end if
+! ========================================================================= 11.0
+
+ if((iter-istrbr+1) <= 1) then
+! ===================================== modified by K. Tagami ======== 5.0
+!! call simple_mix(rmx) !-(m_OP)
+ call simple_mix_kt( rmxtrck ) !-(m_OP)
+! ==================================================================== 5.0
+ else
+ call mix_pulay_alloc2 !-(m_CD) d0_l,u_l, and w_l are allocated
+ call set_ncrspd_mxiter(nbxmix,iter-istrbr,mxiter) ! -> ncrspd, mxiter
+!!$ call mix_pulay_alloc3(nbxmix,iter-istrbr) !-(c.h.) e_wk,f_wk,ww1,finv,ip
+ call mix_pulay_alloc3(mxiter) !-(c.h.) e_wk,f_wk,ww1,finv,ip
+
+ call Resid_and_dd_into_urec(mxiter) !-(c.h.)
+ ! dF ->urec_l; dd ->urec_l; d0_l,din,dout
+ call Ri_dot_Rj(mxiter) !-(c.h.) <R(i)|R(j)>->f
+ call get_finv_lapack(nbxmix,mxiter,f) !-(c.h.) f -> f^{-1}= <R(i)|R(j)>^{-1}
+
+ call Rj_dot_d(mxiter) !-(c.h.) <R(j)|d>,(j=1,iter-istrb) -> uuf_p
+
+ call get_gmatrix(mxiter) !-(c.h.) (f,uuf_p)->g
+ call renew_d_using_g(mxiter,rmxtrck) !-(c.h.)
+
+ call mix_pulay_dealloc3 !-(c.h.)
+ call mix_pulay_dealloc2 !-(m_CD)
+ endif
+
+ deallocate(rmxtrck)
+
+ if ( noncol ) then
+ call map_rho_to_om_noncl( ommix,ommix_aimag,rho )
+ else
+ call map_rho_to_om( ommix,rho )
+ endif
+
+ previous_waymix = PULAY
+ call tstatc0_end(id_sname)
+ contains
+ subroutine mix_pulay_alloc3(m)
+ integer, intent(in) :: m
+ allocate(e_wk(m*m)); allocate(f_wk(m*m)); allocate(ww1(m)); allocate(finv(m*m))
+ allocate(ip(m))
+! ===================================== Added by K. Tagami ============
+ e_wk = 0; f_wk = 0; ww1 = 0; finv = 0; ip = 0
+! =====================================================================
+ end subroutine mix_pulay_alloc3
+
+ subroutine set_ncrspd_mxiter(n,iter,m)
+ integer, intent(in) :: n, iter
+ integer, intent(out) :: m
+ integer :: i, nx
+ if(hownew == ANEW) then
+ m = iter
+!!$ ncrspd(:) = (/(i,i=1,m)/)
+ do i=1,iter
+ ncrspd(i) = i
+ end do
+ else ! hownew == RENEW
+ if(iter <= n) then
+ m = iter
+!!$ ncrspd(:) = (/(i,i=1,m)/)
+ do i=1,iter
+ ncrspd(i) = i
+ end do
+ else
+ m = n
+ nx = ncrspd(1)
+ do i = 1, m-1
+ ncrspd(i) = ncrspd(i+1)
+ end do
+ ncrspd(m) = nx
+ end if
+ end if
+ end subroutine set_ncrspd_mxiter
+
+ subroutine mix_pulay_dealloc3
+ deallocate(e_wk); deallocate(f_wk); deallocate(ww1); deallocate(finv)
+ deallocate(ip)
+ end subroutine mix_pulay_dealloc3
+
+ subroutine Resid_and_dd_into_urec(iter)
+ integer, intent(in) :: iter
+ integer :: itc,itc0,itc1
+ integer :: i,j,k,imix
+ real(kind=DP) :: sum1,sum2
+ itc = ncrspd(iter)
+ urec_l(:,:,itc,iResid) = rho(:,:) - rhoo(:,:) - (dout(:,:) - din(:,:)) ! =dF(=delta F^i)
+ urec_l(:,:,itc,iRho ) = rhoo(:,:) - din(:,:) ! =dd
+ d0_l(:,:) = rho(:,:) - rhoo(:,:)
+ din(:,:) = rhoo(:,:)
+ dout(:,:) = rho(:,:)
+ ynorm(itc,:)=0.d0
+ do i=1,nspin_m
+ do k=1,nsize_rho
+ ynorm(itc,i) = ynorm(itc,i)+urec_l(k,i,itc,iResid)*urec_l(k,i,itc,iResid)
+ enddo
+ enddo
+ ynorm(itc,:) = 1.d0/sqrt(ynorm(itc,:))
+ end subroutine Resid_and_dd_into_urec
+
+ subroutine Ri_dot_Rj(n)
+ integer, intent(in) :: n
+ integer :: it,jt,itc,jtc
+ real(DP) :: ff1(nspin_m),ff1tmp
+
+ do it = 1, n
+ itc = ncrspd(it)
+ do jt = it, n
+ jtc = ncrspd(jt)
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp) ! <delta F^i|delta F^j>
+ ff1(1)=ff1tmp;ff1(2)=ff1tmp
+ else
+ call mult1s10(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1) ! <delta F^i|delta F^j>
+ endif
+
+ if ( noncol ) then
+ call mult1s10_reduce_spin( urec_l, nbxmix, 2, itc, iResid, &
+ & urec_l, jtc, iResid, f_p, ff1tmp )
+ ! <delta F^i|delta F^j>
+ ff1(:) = ff1tmp
+ endif
+ f(it,jt,1:nspin_m) = ff1(1:nspin_m)
+ if(jt /= it) f(jt,it,1:nspin_m) = f(it,jt,1:nspin_m)
+ end do
+ end do
+ end subroutine Ri_dot_Rj
+
+ subroutine Rj_dot_d(n)
+ integer, intent(in) :: n
+ integer :: jt, jtc
+ real(DP) :: ff1(nspin_m),ff1tmp
+
+ do jt = 1, n
+ jtc = ncrspd(jt)
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
+ ff1(1) = ff1tmp;ff1(2)=ff1tmp
+ else
+ call mult1s5(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1)
+ endif
+
+ if ( noncol ) then
+ call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
+ ff1(:) = ff1tmp
+ endif
+
+ uuf_p(jt,1:nspin_m) = ff1(1:nspin_m)
+ end do
+ end subroutine Rj_dot_d
+
+ subroutine get_finv_lapack(m,n,f)
+ integer,intent(in) :: m,n
+ real(DP),intent(inout),dimension(m,m,nspin_m) :: f
+ real(DP), allocatable,dimension(:,:) :: fwork
+ integer :: is,inf,it,jt,kt,nnspin
+ real(DP) :: div,tmp
+ allocate(fwork(n,n))
+ nnspin = nspin
+ if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1
+
+ if ( noncol ) then
+ nnspin = 1
+ end if
+
+ do is=1,nnspin
+ if(ipripulay >= 2) then
+ write(nfout,600) n,(('(',it,jt,')',f(it,jt,is),jt=1,n),it=1,n)
+600 format(//11x,"**input matrix**"/12x &
+ & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ fwork=0
+ do it=1,n
+ do jt=1,n
+ fwork(jt,it) = f(jt,it,is)*ynorm(jt,is)*ynorm(it,is)
+ if(it==jt) fwork(jt,it)=fwork(jt,it)+alpha_pulay
+ enddo
+ enddo
+ call dpotrf('U',n,fwork,n,inf)
+ call dpotri('U',n,fwork,n,inf)
+ do it=1,n-1
+ do jt=it+1,n
+ fwork(jt,it) = fwork(it,jt)
+ enddo
+ enddo
+ do it=1,n
+ do jt=1,n
+ f(jt,it,is) = fwork(jt,it)*ynorm(jt,is)*ynorm(it,is)
+ enddo
+ enddo
+ if(ipripulay >= 2) then
+ write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
+630 format(/11x, "**inverse matrix**" &
+ & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ enddo
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ do it=1,n
+ do jt=1,n
+ f(jt,it,2) = f(jt,it,1)
+ enddo
+ enddo
+ endif
+! ============================== added by K. Tagami ========== 11.0
+ if ( noncol ) then
+ do it=1,n
+ do jt=1,n
+ f(jt,it,:) = f(jt,it,1)
+ enddo
+ end do
+ endif
+! ============================================================ 11.0
+ deallocate(fwork)
+
+ end subroutine get_finv_lapack
+
+ subroutine get_finv(m,n,f)
+ integer,intent(in) :: m,n
+ real(DP),intent(inout),dimension(m,m,nspin_m) :: f
+
+ integer :: icount,is,jt,it,icon
+ real(DP) :: div
+
+ e_wk = 0.d0
+ do it = 1, n
+ e_wk(it*it) = 1.d0
+ end do
+
+! ======================================= modified by K. Tagami =========== 11.0
+! do is = 1, nspin, af+1
+ do is = 1, ndim_magmom, af+1
+! ========================================================================== 11.0
+ div = 1.d0/f(1,1,is)
+ icount = 1
+ do jt = 1, n
+ do it = 1, n
+ f_wk(icount) = f(it,jt,is)*div
+ icount = icount + 1
+ end do
+ end do
+ if(ipripulay >= 1) then
+ write(nfout,600) n,(('(',it,jt,')',f(it,jt,is)*div,jt=1,n),it=1,n)
+600 format(//11x,"**input matrix**"/12x &
+ & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ call rdecomp(n,f_wk,ww1,ip,icon)
+ if(icon /= 0) then
+ stop 'LU decomposition is impossible.'
+ else
+ call rsolve(n,n,f_wk,e_wk,finv,ip)
+ endif
+
+ icount = 1
+ do jt = 1, n
+ do it = 1, n
+ f(it,jt,is) = finv(icount)
+ icount = icount + 1
+ end do
+ end do
+ if(ipripulay >= 1) then
+ write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
+630 format(/11x, "**inverse matrix**" &
+ & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ end do
+ end subroutine get_finv
+
+ subroutine get_gmatrix(n)
+ integer,intent(in) :: n
+ integer :: is, it, jt, nnspin
+ nnspin = nspin
+ if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1
+
+! ============================ added by K. Tagami ============= 11.0
+ if ( noncol ) nnspin = 1
+! ============================================================== 11.0
+
+ g_p = 0.d0
+ do is = 1, nnspin
+ do it = 1, n
+ do jt = 1, n
+ g_p(it,is) = g_p(it,is) - f(jt,it,is)*uuf_p(jt,is)
+ end do
+ end do
+ if(ipripulay >= 2) then
+ write(nfout,'(" -- g_p(1:",i3,") --")') n
+ write(nfout,'(8f20.12)') (g_p(it,is),it=1,n)
+ end if
+ end do
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ do it = 1,n
+ g_p(it,2) = g_p(it,1)
+ enddo
+ endif
+! ============================== added by K. Tagami ============ 11.0
+ if ( noncol ) then
+ do it = 1,n
+ g_p(it,:) = g_p(it,1)
+ enddo
+ endif
+! ============================================================== 11.0
+
+ end subroutine get_gmatrix
+
+ subroutine renew_d_using_g(n,p)
+ integer, intent(in) :: n
+ real(DP),intent(in),dimension(nspin_m) :: p
+ integer :: is, k, i, it, itc, ns
+
+!!$ do is = 1, nspin, af+1
+ ns = nspin_for_qnewton()
+ do is = 1, ns,af+1
+ do i = 1,nsize_rho
+ rho(i,is) = rhoo(i,is) + p(is)*d0_l(i,is)
+ end do
+ do it = 1, n
+ itc = ncrspd(it)
+ do i = 1,nsize_rho
+ rho(i,is) = rho(i,is) + g_p(it,is)* &
+ & (urec_l(i,is,itc,iRho) + p(is)*urec_l(i,is,itc,iResid))
+ end do
+ end do
+ end do
+
+ end subroutine renew_d_using_g
+
+ integer function nspin_for_qnewton()
+ if ( noncol ) then
+ nspin_for_qnewton=ndim_magmom
+ else
+ nspin_for_qnewton=nspin
+ if (sw_force_simple_mixing==ON .and. sw_recomposing==ON) nspin_for_qnewton=1
+ endif
+ end function nspin_for_qnewton
+
end subroutine m_OP_mix_pulay
subroutine create_map_func(paramset)
@@ -2627,6 +3078,13 @@ contains
! =========================================================== 11.0
end subroutine m_OP_cp_ommix_to_omold
+ subroutine m_OP_cp_ommix_to_om
+ om = ommix
+! ========================= added by K. Tagami ============== 11.0
+ if ( noncol ) om_aimag = ommix_aimag
+! =========================================================== 11.0
+ end subroutine m_OP_cp_ommix_to_om
+
subroutine m_OP_simple_mixing(nfout,rmxt)
integer, intent(in) :: nfout
real(kind=DP), intent(in) :: rmxt
@@ -2721,6 +3179,119 @@ contains
end subroutine alloc_rhostore_recomp
+ subroutine mult1s5(u,mb,muv,j,iuv,v,f_q,fmult)
+ integer,intent(in) :: mb,muv,j,iuv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m) :: v
+ real(DP),intent(in), dimension(1:nsize_rho) :: f_q
+ real(DP),intent(out),dimension(nspin_m) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,i
+
+ fmult = 0.d0
+ do is = 1, ndim_magmom, af+1
+ p = 0.d0
+ fac=1.0d0
+ do i = 1,nsize_rho
+ if ( noncol ) then
+ fac=f_q(i)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(i)
+ endif
+ end if
+ p = p + fac*u(i,is,j,iuv)*v(i,is)
+ end do
+ fmult(is) = p
+ enddo
+ end subroutine mult1s5
+
+ subroutine mult1s5_reduce_spin(u,mb,muv,j,iuv,v,f_q,fmult)
+ integer,intent(in) :: mb,muv,j,iuv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m) :: v
+ real(DP),intent(in), dimension(1:nsize_rho):: f_q
+ real(DP),intent(out) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,i
+
+ fmult = 0.d0
+ p = 0.d0
+
+ do is = 1, ndim_magmom, af+1
+ fac = 1.0d0
+ do i = 1,nsize_rho
+ if ( noncol ) then
+ fac=f_q(i)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(i)
+ endif
+ end if
+ p = p + fac*u(i,is,j,iuv)*v(i,is)
+ end do
+ enddo
+ fmult = p
+ end subroutine mult1s5_reduce_spin
+
+ subroutine mult1s10(u,mb,muv,i,iu,v,j,iv,f_q,fmult)
+ integer,intent(in) :: mb,muv,i,iu,j,iv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u,v
+ real(DP),intent(in), dimension(1:nsize_rho):: f_q
+ real(DP),intent(out),dimension(nspin_m) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,ig
+ fmult = 0.d0
+
+ do is = 1, ndim_magmom, af+1
+ p = 0.d0
+ fac = 1.0d0
+ do ig = 1,nsize_rho
+ if ( noncol ) then
+ fac=f_q(ig)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(ig)
+ endif
+ end if
+ p = p + fac*u(ig,is,i,iu)*v(ig,is,j,iv)
+ end do
+ fmult(is) = p
+ enddo
+ end subroutine mult1s10
+
+ subroutine mult1s10_reduce_spin(u,mb,muv,i,iu,v,j,iv,f_q,fmult)
+ integer,intent(in) :: mb,muv,i,iu,j,iv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u,v
+ real(DP),intent(in), dimension(1:nsize_rho):: f_q
+ real(DP),intent(out) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,ig
+
+ fmult = 0.d0
+ p = 0.d0
+
+ do is = 1, ndim_magmom, af+1
+ fac = 1.0d0
+ do ig = 1,nsize_rho
+
+ if ( noncol ) then
+ fac=f_q(ig)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(ig)
+ endif
+ end if
+ p = p + fac*u(ig,is,i,iu)*v(ig,is,j,iv)
+ end do
+ enddo
+ fmult = p
+ end subroutine mult1s10_reduce_spin
+
! ================================================================= 5.0
end module m_Orbital_Population
diff -uprN phase0_2015.01/src_phase/m_PAW_ChargeDensity.F90 phase0_2015.01.01/src_phase/m_PAW_ChargeDensity.F90
--- phase0_2015.01/src_phase/m_PAW_ChargeDensity.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_PAW_ChargeDensity.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 488 $)
!
! MODULE: m_PAW_ChargeDensity
!
@@ -33,10 +33,10 @@
!
module m_PAW_ChargeDensity
use m_db, only : getIntDB,getStringDB_TB,getIntDB_TB
- use m_Const_Parameters, only : DP,PAI2,PAI4,BUCS,SphericalHarmonicsExpansion, GaussLegendre, LOWER
+ use m_Const_Parameters, only : DP,PAI2,PAI4,BUCS,SphericalHarmonicsExpansion, GaussLegendre, LOWER, Bohr
use m_Control_Parameters, only : kimg,nspin,af,ipripaw,ipriinputfile,printable
use m_Files, only : nfout
- use m_Ionic_System, only : ityp,natm,ntyp,pos,iwei, speciesname
+ use m_Ionic_System, only : ityp,natm,ntyp,pos,iwei, speciesname, amion
use m_Charge_Density, only : hsr,chgq_l,chgsoft
use m_PlaneWaveBasisSet, only : igfp_l
use m_PseudoPotential, only : psirpw,phirpw,qrspspw &
@@ -45,7 +45,7 @@ module m_PAW_ChargeDensity
& ,il2p,isph,dl2p,iqitg &
& ,m_PP_find_maximum_l &
& ,ipaw,wf_mnrc,flg_symmtry &
- & ,mmesh
+ & ,mmesh, nmesh
use m_FFT, only : fft_box_size_CD,fft_box_size_CD_c, nfftp &
, m_FFT_CD_inverse0 &
, m_FFT_check_of_negative_CD &
@@ -152,6 +152,8 @@ module m_PAW_ChargeDensity
public:: calcGaussLegendreIntegration
public:: calcSphericalHarmonicsExpansion
+ public :: m_PAWCD_calc_contact_density
+
contains
subroutine m_PAW_dealloc()
@@ -2298,7 +2300,7 @@ contains
subroutine set_ia2ia_symmtry_op
integer:: ia,it,no,ja,jt
integer:: i,j,k
- real(DP):: pos0(3),pos1(3),pos2(3)
+ real(DP):: pos0(3),pos1(3),pos2(3),pos3(3)
real(DP):: distance
allocate(op_pr(3,3,nopr+af))
@@ -2314,14 +2316,15 @@ contains
pos1(:)=matmul(op_pr(:,:,no),pos0(:))+tau(:,no,BUCS)
!print *,'pos1=',pos1
pos1(:) = pos1(:) - floor(pos1(:))
- KLoop: do k=-2,1
- do j=-2,1
- do i=-2,1
+ KLoop: do k=-1,1
+ do j=-1,1
+ do i=-1,1
do ja=1,natm
jt=ityp(ja)
if(it/=jt) cycle
-
- pos2(1:3)=pos(ja,1:3)+(/dble(i),dble(j),dble(k)/)
+ pos3(1:3) = pos(ja,1:3)
+ pos3(:) = pos3(:) - floor(pos3(:))
+ pos2(1:3)=pos3(1:3)+(/dble(i),dble(j),dble(k)/)
!print *,'pos2=',pos2
distance=abs(pos1(1)-pos2(1))+abs(pos1(2)-pos2(2)) &
+abs(pos1(3)-pos2(3))
@@ -2340,7 +2343,7 @@ contains
end if
if(kimg==1 .and. iwei(ja)==2) then
- pos2(1:3)=-pos(ja,1:3)+(/dble(i),dble(j),dble(k)/)
+ pos2(1:3)=-pos3(1:3)+(/dble(i),dble(j),dble(k)/)
distance=abs(pos1(1)-pos2(1))+abs(pos1(2)-pos2(2)) &
+abs(pos1(3)-pos2(3))
if(distance < 1.d-5) then
@@ -3374,4 +3377,133 @@ contains
return
end subroutine m_PAWCD_set_sq_der_cd_sdphex2
+ subroutine m_PAWCD_calc_contact_density
+ ! AE hard part density at nuclear radius
+ ! assuming only s-orbital contributes
+
+ integer :: ia, it, is, ir_nucl
+ integer :: il1, il2, im1, im2, it1, it2, lmt1, lmt2
+ integer :: n, isp
+ real(kind=DP) :: csum, ctmp, c1, c2, fac
+ real(kind=DP), allocatable :: contact_charge_density(:)
+
+ allocate( contact_charge_density(natm) ); contact_charge_density = 0.0d0
+
+#if 1
+ Do it=1, ntyp
+ call calc_nuclear_radius( it, ir_nucl )
+
+ Do ia=1, natm
+ if ( ityp(ia) /= it ) cycle
+
+ csum = 0.0d0
+
+ do lmt1=1,ilmt(it)
+ il1 = ltp(lmt1,it); im1 = mtp(lmt1,it); it1 = taup(lmt1,it)
+
+ do lmt2=lmt1,ilmt(it)
+ il2 = ltp(lmt2,it); im2 = mtp(lmt2,it); it2 = taup(lmt2,it)
+
+ c1 = psirpw( ir_nucl, il1, it1, it )
+ c2 = psirpw( ir_nucl, il2, it2, it )
+
+ fac=2.d0; if( lmt1.eq.lmt2 ) fac=1.d0
+
+ do n=1,il2p(lmt1,lmt2,it)
+ isp = isph(lmt1,lmt2,n,it)
+ if ( isp > 1 ) cycle
+
+ if ( noncol ) then
+ ctmp = hsr(ia,lmt1,lmt2,1)
+ else
+ ctmp = 0.0d0
+ Do is=1, nspin
+ ctmp = ctmp +hsr(ia,lmt1,lmt2,is)
+ End Do
+ endif
+
+ csum = csum + fac *ctmp *dl2p(lmt1,lmt2,n,it) *c1 *c2 /sqrt(PAI4)
+ end do
+ end do
+ end do
+ csum = csum + rhcorpw(ir_nucl,it)/PAI4
+
+ contact_charge_density(ia) = csum /radr_paw( ir_nucl,it )**2
+ end do
+ end do
+
+#else
+ Do it=1, ntyp
+ call calc_nuclear_radius( it, ir_nucl )
+
+ Do ia=1, natm
+ if ( ityp(ia) /= it ) cycle
+
+ csum = 0.0d0
+
+ Do lmt1=1, ilmt(it)
+ il1 = ltp(lmt1,it); im1 = mtp(lmt1,it); it1 = taup(lmt1,it)
+ if ( il1 > 1 ) cycle
+
+ Do lmt2=1, ilmt(it)
+ il2 = ltp(lmt2,it); im2 = mtp(lmt2,it); it2 = taup(lmt2,it)
+ if ( il2 > 1 ) cycle
+
+ if ( noncol ) then
+ ctmp = hsr(ia,lmt1,lmt2,1)
+ else
+ ctmp = 0.0d0
+ Do is=1, nspin
+ ctmp = ctmp +hsr(ia,lmt1,lmt2,is)
+ End Do
+ endif
+ c1 = psirpw( ir_nucl, il1, it1, it )
+ c2 = psirpw( ir_nucl, il2, it2, it )
+ !
+ ctmp = ctmp *c1 *c2 /sqrt(PAI4) + rhcorpw(ir_nucl,it)/PAI4
+ csum = csum +ctmp /radr_paw( ir_nucl,it )**2
+ End Do
+ End Do
+ contact_charge_density(ia) = csum
+ End Do
+ End Do
+#endif
+!
+ write(nfout,*)
+ write(nfout,*) '------------ MOSSB ---------------'
+ write(nfout,*) '!** contact charge density at nuclear radius '
+ write(nfout,*) '!** ia, density **'
+ Do ia=1, natm
+ write(nfout,'(I5,F25.12)') ia, contact_charge_density(ia)
+ End Do
+ write(nfout,*) '----------------------------------------'
+ write(nfout,*)
+
+ deallocate( contact_charge_density )
+
+ contains
+
+ subroutine calc_nuclear_radius( it, ir_nucl )
+ integer, intent(in) :: it
+ integer, intent(out):: ir_nucl
+
+ integer :: ir
+ real(kind=DP) :: r0, coeff, mass_no, r_nucl
+
+ r0 = 1.20d0 *1.0D-5/ Bohr ! in bohr
+
+ coeff = 1.66053d-27 /9.1093897d-31
+ mass_no = amion(it) /coeff
+
+ r_nucl = r0 *( mass_no )**(1.0d0/3.d0)
+
+ Do ir=1, nmesh(it)
+ if ( radr_paw(ir,it) > r_nucl ) exit
+ End Do
+ ir_nucl = ir
+ end subroutine calc_nuclear_radius
+
+ end subroutine m_PAWCD_calc_contact_density
+
+
end module m_PAW_ChargeDensity
diff -uprN phase0_2015.01/src_phase/m_PAW_XC_Potential.F90 phase0_2015.01.01/src_phase/m_PAW_XC_Potential.F90
--- phase0_2015.01/src_phase/m_PAW_XC_Potential.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_PAW_XC_Potential.F90 2016-07-12 12:51:19.000000000 +0900
@@ -7,7 +7,7 @@
#endif
!=======================================================================
!
-! SOFTWARE NAME : PHASE ($Revision: 416 $)
+! SOFTWARE NAME : PHASE ($Revision: 494 $)
!
! MODULE: m_PAW_XC_Potential
!
@@ -661,7 +661,7 @@ contains
dnps_dph = 0.d0
ddnps_ddr = 0.d0
- if(xctype == 'ldapw91' .or. xctype == 'ldapbe ') then
+ if(xctype == 'ldapw91' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf' ) then
grad_nae=0.d0;grad_tnae=0.d0
grad_nps=0.d0;grad_tnps=0.d0
else
@@ -692,7 +692,7 @@ contains
,grad_tnps(1:nrc),wos(1:nrc),texc &
,dF_dnps(1:nrc,1:nspin))
exc_ps=exc_ps+texc*omg_wght(ith)
- else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe ') then
+ else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf') then
call ex_ggapbe (nspin,nspin,1,nrc,nae(1:nrc,1:nspin) &
,grad_nae(1:nrc,1:nspin) &
,wos(1:nrc),texc &
@@ -2008,7 +2008,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
dFc_dab_ps(ir)*nanb_ps_sph(ir,1)
end if
- if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' .and. xctype /= 'ldapbe ') then
+ if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' .and. xctype /= 'ldapbe ' &
+ & .and. xctype /= 'vdwdf') then
if(dabs(grad_nae(ir,1)) < DELTA10) cycle
if(dabs(grad_tnae(ir)) < DELTA10) cycle
if(dabs(grad_nps(ir,1)) < DELTA10) cycle
@@ -2056,7 +2057,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
if(vflag == VXC_AND_EXC) then
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
do ir=1,nrc,dnr
if(dabs(grad_nae(ir,1)) > 1.d-9) then
iga_ae = 1.d0/grad_nae(ir,1)
@@ -2181,7 +2183,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
! dFxcdnb_ae_sph=0.d0
! dFxcdnb_ps_sph=0.d0
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
num_isph_2tm=num_isph_g_g
isph_2tm=isph_g_g
else
@@ -2214,7 +2217,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
end if
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
sum1 = sum1 + &
0.5d0*dFadgaga_ae(ir)*gaga_ae_sph(ir,nsph) + &
0.5d0*dFadgg_ae(ir)*gg_ae_sph(ir,nsph) + &
@@ -2317,7 +2321,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
end if
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
sum1 = sum1 + &
0.5d0*dGadgaga_ae(ir)*gaga_ae_sph(ir,nsph) + &
dGadnaga_ae(ir)*naga_ae_sph(ir,nsph)
@@ -3096,7 +3101,7 @@ contains
! dnps_dph = 0.d0
! ddnps_ddr = 0.d0
- if(xctype == 'ldapw91' .or. xctype == 'ldapbe ') then
+ if(xctype == 'ldapw91' .or. xctype == 'ldapbe ' .or. xctype == 'vdwdf') then
grad_nae2_sph=0.d0;grad_tnae2_sph=0.d0
grad_nps2_sph=0.d0;grad_tnps2_sph=0.d0
grad_nae=0.d0;grad_tnae=0.d0
@@ -3180,7 +3185,7 @@ contains
,dFc_dagg_ps(1:nrc) &
,dFc_dbgg_ps(1:nrc) &
,dFc_dabg_ps(1:nrc))
- else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe ') then
+ else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf') then
call ex_ggapbe_paw_drv2(nrc,dnr,nspin &
,nae_sph(1:nrc,1:nspin,1) &
,grad_nae(1:nrc,1:nspin) &
diff -uprN phase0_2015.01/src_phase/m_Parallelization.F90 phase0_2015.01.01/src_phase/m_Parallelization.F90
--- phase0_2015.01/src_phase/m_Parallelization.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Parallelization.F90 2016-07-12 12:51:19.000000000 +0900
@@ -3,7 +3,7 @@
#endif
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 482 $)
!
! MODULE: m_Parallelization
!
@@ -65,7 +65,7 @@
module m_Parallelization
! (m_Parallel)
-! $Id: m_Parallelization.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Parallelization.F90 482 2016-04-08 08:40:45Z jkoga $
use m_Const_Parameters, only : ON, OFF, tag_npes_etc
use m_ErrorMessages
@@ -106,6 +106,8 @@ module m_Parallelization
integer, allocatable, dimension(:) :: mpi_e_world ! kd(0:nrank_k-1)
integer :: ista_kngp, iend_kngp, np_kngp, mp_kngp
integer, allocatable, dimension(:) :: is_kngp, ie_kngp, nel_kngp
+ integer :: ista_kngp_exx, iend_kngp_exx, np_kngp_exx, mp_kngp_exx
+ integer, allocatable, dimension(:) :: is_kngp_exx, ie_kngp_exx, nel_kngp_exx
! natm for fxyzew_l
integer :: ista_atm, iend_atm, np_atm, mp_atm
integer, allocatable, dimension(:) :: is_atm, ie_atm, nel_atm
@@ -117,6 +119,12 @@ module m_Parallelization
integer :: ista_nn,iend_nn,np_nn,mp_nn
integer, allocatable, dimension(:) :: is_nn, ie_nn, nel_nn
+ integer :: ista_nq, iend_nq, np_nq, mp_nq
+ integer, allocatable, dimension(:) :: is_nq, ie_nq, nel_nq, map_nq, map_z_nq
+
+! integer :: ista_nval,iend_nval,np_nval,mp_nval
+! integer, allocatable, dimension(:) :: is_nval, ie_nval, nel_nval
+
! natm2 for s_ew in m_Ionic_System
integer :: ista_atm2, iend_atm2, np_atm2, mp_atm2
integer, allocatable, dimension(:) :: is_atm2, ie_atm2, nel_atm2
@@ -172,6 +180,7 @@ module m_Parallelization
integer,save :: mype_conf = 0
integer :: nrank_conf
+
! for nfft
integer :: ista_ffth, iend_ffth, np_ffth, mp_ffth
integer, allocatable, dimension(:) :: is_ffth, ie_ffth, nel_ffth
@@ -1803,6 +1812,31 @@ contains
enddo
end subroutine m_Parallel_init_mpi_rspace_aug
+ subroutine m_Parallel_init_mpi_nq(nfout,ipri,printable,nq)
+ integer, intent(in) :: nfout, ipri,nq
+ logical, intent(in) :: printable
+ integer :: i,j,ip
+
+ allocate(is_nq(0:npes-1));ista_nq=nq+1
+ allocate(ie_nq(0:npes-1));iend_nq=0
+ allocate(nel_nq(0:npes-1));nel_nq=0
+ allocate(map_nq(nq));map_nq=0
+ allocate(map_z_nq(nq));map_z_nq=0
+
+ call set_block_range(nq,npes,nel_nq,is_nq,ie_nq,.true.,map_nq)
+ ista_nq = is_nq(mype)
+ iend_nq = ie_nq(mype)
+ np_nq = nel_nq(mype)
+ mp_nq = maxval(nel_nq)
+ j = 0
+ do ip = 1, npes
+ do i = 1, nel_nq(ip-1)
+ j = j + 1
+ map_z_nq(j) = i
+ end do
+ end do
+ end subroutine m_Parallel_init_mpi_nq
+
subroutine m_Parallel_init_mpi_atm(nfout,ipri,printable,natm)
integer, intent(in) :: nfout,ipri,natm
logical, intent(in) :: printable
diff -uprN phase0_2015.01/src_phase/m_Phonon.F90 phase0_2015.01.01/src_phase/m_Phonon.F90
--- phase0_2015.01/src_phase/m_Phonon.F90 2015-09-15 12:16:16.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Phonon.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! SOFTWARE NAME : PHASE ($Revision: 409 $)
+! SOFTWARE NAME : PHASE ($Revision: 460 $)
!
! MODULE: m_Phonon
!
@@ -32,7 +32,7 @@
!
!
module m_Phonon
-! $Id: m_Phonon.F90 409 2014-10-27 09:24:52Z jkoga $
+! $Id: m_Phonon.F90 460 2015-09-15 02:53:17Z jkoga $
use m_Const_parameters, only : DP, ON, OFF, NOCONV, FMAXVALLEN, PAI, PAI2, PAI4 &
& , PHONON_GAMMA, PHONON_BAND, PHONON_DOS &
& , LOWER, CARTS, UNIT_PIEZO_CONST &
diff -uprN phase0_2015.01/src_phase/m_PlaneWaveBasisSet.F90 phase0_2015.01.01/src_phase/m_PlaneWaveBasisSet.F90
--- phase0_2015.01/src_phase/m_PlaneWaveBasisSet.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_PlaneWaveBasisSet.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 481 $)
!
! MODULE: m_PlaneWaveBasisSet
!
@@ -34,9 +34,41 @@
!
! Revised for the GAMMA point (k=(0,0,0)) by T. Yamasaki, April 2006.
!
+
+#ifdef __TIMER_SUB__
+# define __TIMER_SUB_START(a) call timer_sta(a)
+# define __TIMER_SUB_STOP(a) call timer_end(a)
+#else
+# define __TIMER_SUB_START(a)
+# define __TIMER_SUB_STOP(a)
+#endif
+#ifdef __TIMER_DO__
+# define __TIMER_DO_START(a) call timer_sta(a)
+# define __TIMER_DO_STOP(a) call timer_end(a)
+#else
+# define __TIMER_DO_START(a)
+# define __TIMER_DO_STOP(a)
+#endif
+#ifdef FJ_TIMER
+# define __TIMER_FJ_START_w_BARRIER(str,a) call mpi_barrier(str,ierr) ; call timer_sta(a)
+# define __TIMER_FJ_START(a) call timer_sta(a)
+# define __TIMER_FJ_STOP(a) call timer_end(a)
+#else
+# define __TIMER_FJ_START_w_BARRIER(str,a)
+# define __TIMER_FJ_START(a)
+# define __TIMER_FJ_STOP(a)
+#endif
+#ifdef __TIMER_INIDO__
+# define __TIMER_INIDO_START(a) call timer_sta(a)
+# define __TIMER_INIDO_STOP(a) call timer_end(a)
+#else
+# define __TIMER_INIDO_START(a)
+# define __TIMER_INIDO_STOP(a)
+#endif
+
module m_PlaneWaveBasisSet
! ( m_pwBS )
-! $Id: m_PlaneWaveBasisSet.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_PlaneWaveBasisSet.F90 481 2016-03-25 02:51:57Z jkoga $
use m_Crystal_Structure, only : nopr, altv,rltv, m_CS_op_in_PUCV
use m_Kpoints, only : kv3,kv3_ek,vkxyz,qwgt, k_symmetry
use m_FFT, only : fft_box_size_WF, fft_box_size_CD, fft_box_size_pWF &
@@ -101,6 +133,11 @@ module m_PlaneWaveBasisSet
integer :: kg_tfw = 0
! ========================== 13.0U2
+! ===== EXP_CELLOPT ==== 2015/09/24
+ integer :: kg1_prev = 0
+ integer :: kgp_prev = 0
+! ====================== 2015/09/24
+
integer, dimension(3) :: n_rGv
integer, dimension(3) :: n_rGpv
integer, dimension(3) :: n_rGpv_reduced
@@ -465,10 +502,7 @@ contains
integer, parameter :: CRITICAL_VECTOR_LENGTH = 10000
integer :: id_sname = -1
-#ifdef __TIMER_SUB__
- call timer_sta(1221)
-#endif
-
+ __TIMER_SUB_START(1221)
call tstatc0_begin('m_pwBS_for_each_WF ',id_sname)
if(ipri >= 2) then
@@ -778,9 +812,7 @@ contains
end if
call tstatc0_end(id_sname)
-#ifdef __TIMER_SUB__
- call timer_end(1221)
-#endif
+ __TIMER_SUB_STOP(1221)
contains
subroutine wd_ngshell_range
integer :: jg, j,n1,n2,n3
@@ -858,9 +890,7 @@ contains
kg1_exx = 0
do j = 1, kg_exx
- ga = ngabc(j,1)
- gb = ngabc(j,2)
- gc = ngabc(j,3)
+ ga = ngabc(j,1); gb = ngabc(j,2); gc = ngabc(j,3)
grvv = dsqrt(ttr(1)*ga*ga + ttr(2)*gb*gb + ttr(3)*gc*gc &
& + ttr(4)*ga*gb + ttr(5)*gb*gc + ttr(6)*gc*ga )
if(grvv <= gmax_exx) then
@@ -884,9 +914,7 @@ contains
kg1p_exx = 0
do j = 1, kgp_exx
- ga = ngabc(j,1)
- gb = ngabc(j,2)
- gc = ngabc(j,3)
+ ga = ngabc(j,1); gb = ngabc(j,2); gc = ngabc(j,3)
grvv = dsqrt(ttr(1)*ga*ga + ttr(2)*gb*gb + ttr(3)*gc*gc &
& + ttr(4)*ga*gb + ttr(5)*gb*gc + ttr(6)*gc*ga )
if(grvv <= gmaxp_exx) then
@@ -2751,6 +2779,8 @@ contains
if(allocated(nbase)) deallocate(nbase)
if(allocated(ylm_l)) deallocate(ylm_l)
+
+ if(allocated(nbase_gamma)) deallocate(nbase_gamma)
#ifdef _MPIFFT_
if(allocated(igfp_l_c)) deallocate(igfp_l_c)
@@ -3190,4 +3220,14 @@ contains
end subroutine m_pwBS_sphrp_exx
+! ==== EXP_CELLOPT === 2015/09/24
+ subroutine m_pwBS_store_prev_kg1_kgp
+ kg1_prev = kg1; kgp_prev = kgp
+ if ( mype == 0 ) then
+ write(nfout,*) '** kg1_prev is ', kg1_prev
+ write(nfout,*) '** kgp_prev is ', kgp_prev
+ endif
+ end subroutine m_pwBS_store_prev_kg1_kgp
+! =================== 2015/09/24
+
end module m_PlaneWaveBasisSet
diff -uprN phase0_2015.01/src_phase/m_Positron_Wave_Functions.F90 phase0_2015.01.01/src_phase/m_Positron_Wave_Functions.F90
--- phase0_2015.01/src_phase/m_Positron_Wave_Functions.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Positron_Wave_Functions.F90 2016-07-12 12:51:19.000000000 +0900
@@ -15,9 +15,9 @@
!
!=======================================================================
module m_Positron_Wave_Functions
-! $Id: m_Positron_Wave_Functions.F90 417 2014-12-22 11:44:44Z yamasaki $
+! $Id: m_Positron_Wave_Functions.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Const_Parameters, only : DP,POSITRON,OFF,ON,DIRECT,INVERSE, DELTAevdff, SD, MSD &
- & , DENSITY_ONLY, VTK, CUBE
+ & , DENSITY_ONLY, VTK, CUBE, SmallestPositiveNumber
use m_Control_Parameters, only : af, nspin, npeg,kimg,ipripositron &
& , delta_pev, evaluation_pev_diff &
& , num_extra_pev, sw_gga_p, sw_epsilon_ele, epsilon_ele &
@@ -37,7 +37,7 @@ module m_Positron_Wave_Functions
use m_Crystal_Structure, only : univol
use m_PlaneWaveBasisSet, only : kg_pwf, kg1_pwf, igf_pstrn, igfp_l, igfp_nonpara &
& , m_pwBS_pstrn_kinetic_energies
- use m_Electronic_Structure,only: vlhxc_l
+!! use m_Electronic_Structure,only: vlhxc_l
use m_Parallelization, only : mype, npes, ista_kngp, iend_kngp &
& , ista_sfftph, iend_sfftph, ierr, mpi_comm_group
use m_FFT, only : nfft, nfftp, nfftp_nonpara, nfft_pstrn, fft_box_size_pWF &
@@ -51,7 +51,7 @@ module m_Positron_Wave_Functions
use m_Crystal_Structure, only : altv
use m_Ionic_System, only : ntyp,ityp,zfm3_l,natm2, iatomn &
& , m_IS_pack_all_ions_in_uc
- use m_epc_potential, only : tchgr_l, grad_tchgr_l
+ use m_epc_potential, only : tchgr_l, grad_tchgr_l, vlhxc_p
use m_PseudoPotential, only : rhchg_l, ival
implicit none
@@ -60,6 +60,7 @@ module m_Positron_Wave_Functions
real(kind=DP),allocatable,dimension(:,:,:) :: pzaj ! positron wave functions d(kg1_pwf,npeg,kimg)
real(kind=DP),allocatable,dimension(:,:,:) :: pzaj_old ! d(kg1_pwf,npeg,kimg)
real(kind=DP),allocatable,dimension(:,:) :: pchg_l ! positron charge in g-space, d(ista_kngp:iend_kngp,kimg)
+ real(kind=DP),allocatable,dimension(:,:) :: pchgo_l ! positron charge in g-space, d(ista_kngp:iend_kngp,kimg)
real(kind=DP),allocatable,dimension(:) :: pchr_l ! positron charge in r-space, d(ista_sfftph:iend_sfftph)
integer, allocatable, dimension(:) :: npeordr, nprvf_ordr !d(npeg)
real(kind=DP),allocatable,dimension(:) :: pev, pev1 ! d(npeg)
@@ -107,6 +108,9 @@ contains
end do
end if
end do
+#ifdef SINGLE_POSITRON
+ if ( nspin == 1 ) pchg_l = pchg_l /2.0d0
+#endif
end subroutine substitute_pCD_for_pchg
end subroutine m_pWF_construct_pcharge
@@ -165,12 +169,14 @@ contains
allocate(pev1(1:npeg)); pev1 = 0.d0
allocate(pevdff(3))
allocate(pchg_l(ista_kngp:iend_kngp,kimg))
+ allocate(pchgo_l(ista_kngp:iend_kngp,kimg))
allocate(pchr_l(ista_sfftph:iend_sfftph))
end subroutine m_pWF_allocate_pzaj_etc
subroutine m_pWF_deallocate_pzaj_etc()
if(allocated(pchr_l)) deallocate(pchr_l)
if(allocated(pchg_l)) deallocate(pchg_l)
+ if(allocated(pchgo_l)) deallocate(pchgo_l)
if(allocated(pevdff)) deallocate(pevdff)
if(allocated(pev)) deallocate(pev)
if(allocated(pev1)) deallocate(pev1)
@@ -233,7 +239,7 @@ contains
call m_pwBS_pstrn_kinetic_energies(ekin)
!!$ do is = 1, nspin, af+1
is = 1
- if(isolver == MSD) call vlhxc_l_zero_term(vlhxc0,is)
+ if(isolver == MSD) call vlhxc_p_zero_term(vlhxc0,is)
call Vlocal_in_Rspace(is,afft)
if(isolver == SD) then
do ib = 1, npeg
@@ -262,13 +268,13 @@ contains
deallocate(p)
call m_pWF_dealloc_afft_etc()
contains
- subroutine vlhxc_l_zero_term(vlhxc0,ispin)
+ subroutine vlhxc_p_zero_term(vlhxc0,ispin)
real(kind=DP), intent(out) :: vlhxc0
integer, intent(in) :: ispin
- if(mype == 0) vlhxc0 = vlhxc_l(1,1,ispin)
+ if(mype == 0) vlhxc0 = vlhxc_p(1,1,ispin)
call mpi_bcast(vlhxc0,1,mpi_double_precision,0,mpi_comm_group,ierr)
- end subroutine vlhxc_l_zero_term
+ end subroutine vlhxc_p_zero_term
end subroutine m_pWF_renew_WF_by_SDorCG
subroutine m_pWF_evolve_WFs_again(nfout,mode,dtim_old,dtim_new)
@@ -353,8 +359,12 @@ contains
evr = pzaj(i,ib,1)
devr = (ekin(i) - pev(ib))*evr + VlocalpW(i1)*denom
wdi = ekin(i) + vlhxc0 - pev(ib)
- fdexp = dexp( -p(i) * wdi * dtim)
- pzaj(i,ib,1) = (fdexp - 1) * devr/wdi + evr
+ if (dabs(wdi) < SmallestPositiveNumber) then
+ pzaj(i,ib,1) = -p(i)*devr*dtim + evr
+ else
+ fdexp = dexp( -p(i) * wdi * dtim)
+ pzaj(i,ib,1) = (fdexp - 1) * devr/wdi + evr
+ endif
end do
else if(kimg==2) then
do i = 1, kg1_pwf
@@ -364,9 +374,14 @@ contains
devr = e1*evr+VlocalpW(2*i1-1)*denom
devi = e1*evi+VlocalpW(2*i1 )*denom
wdi = ekin(i) + vlhxc0 - pev(ib)
- fdexp = dexp( -p(i) * wdi * dtim)
- pzaj(i,ib,1) = (fdexp -1)*devr/wdi + evr
- pzaj(i,ib,kimg) = (fdexp -1)*devi/wdi + evi
+ if (dabs(wdi) < SmallestPositiveNumber) then
+ pzaj(i,ib,1) = -p(i)*devr*dtim + evr
+ pzaj(i,ib,2) = -p(i)*devi*dtim + evi
+ else
+ fdexp = dexp( -p(i) * wdi * dtim)
+ pzaj(i,ib,1) = (fdexp -1)*devr/wdi + evr
+ pzaj(i,ib,kimg) = (fdexp -1)*devi/wdi + evi
+ endif
end do
end if
end subroutine modified_sd_p
@@ -382,7 +397,7 @@ contains
!!$ do is = 1, nspin, af+1
is = 1
- call Vlocal_in_Rspace(is,afft) ! vlhxc_l -> afft
+ call Vlocal_in_Rspace(is,afft) ! vlhxc_p -> afft
call evolve_pWFs_in_subspace ! (is,npeg,damp,ekin,afft,bfft)
!!$ end do
call m_pWF_dealloc_afft_etc()
@@ -846,7 +861,7 @@ contains
call m_pwBS_pstrn_kinetic_energies(ekin)
!!$ do is = 1, nspin, af+1
is = 1
- call Vlocal_in_Rspace(is,afft) ! vlhxc_l -> afft
+ call Vlocal_in_Rspace(is,afft) ! vlhxc_p -> afft
if(ipripositron >= 3) then
write(nfout,'(" afft <<m_pWF_energy_eigen_values>>")')
write(nfout,'( 8f8.4)') (afft(ib),ib=1,100)
@@ -899,7 +914,7 @@ contains
integer, intent(in) :: is
real(kind=DP), intent(out), dimension(nfft_pstrn) :: afft
integer :: i
- call map_vlhxc_l_to_afft()
+ call map_vlhxc_p_to_afft()
if(ipripositron >= 3) then
write(nfout,'(" afft <<Vlocal_in_Rspace>>")')
write(nfout,'( 8f8.4)') (afft(i),i=1,100)
@@ -907,7 +922,7 @@ contains
!!$ call m_FFT_pWF(nfout,afft,INVERSE,OFF) ! afft -> afft
call m_FFT_WF(POSITRON,nfout,afft,INVERSE,OFF) ! afft -> afft
contains
- subroutine map_vlhxc_l_to_afft()
+ subroutine map_vlhxc_p_to_afft()
integer :: i,i1,ri, iend
if(npes >= 2) allocate(afft_mpi(nfft_pstrn))
afft = 0.d0
@@ -916,14 +931,14 @@ contains
do ri = 1, kimg
do i = ista_kngp, iend
i1 = kimg*igf_pstrn(i) + (ri-kimg)
- afft(i1) = vlhxc_l(i,ri,is)
+ afft(i1) = vlhxc_p(i,ri,is)
end do
end do
if(ipripositron >= 3) then
- write(nfout,'(" -- vlhxc_l <<map_vlhxc_l_to_afft>>")')
+ write(nfout,'(" -- vlhxc_p <<map_vlhxc_p_to_afft>>")')
do ri = 1, kimg
write(nfout,'(" kimg = ", i8)') kimg
- write(nfout,'(10f8.4)') (vlhxc_l(i,ri,is),i=ista_kngp,iend)
+ write(nfout,'(10f8.4)') (vlhxc_p(i,ri,is),i=ista_kngp,iend)
end do
end if
if(npes >= 2) then
@@ -932,7 +947,7 @@ contains
afft = afft_mpi
end if
if(npes >= 2) deallocate(afft_mpi)
- end subroutine map_vlhxc_l_to_afft
+ end subroutine map_vlhxc_p_to_afft
end subroutine Vlocal_in_Rspace
@@ -1041,6 +1056,10 @@ contains
! core_annihilation_rate=sss/dsqrt(4.d0*3.1415926d0)
core_annihilation_rate=sss/2.d0*univol
+#ifdef SINGLE_POSITRON
+ core_annihilation_rate = sss *univol
+#endif
+
end subroutine m_pWF_core_annihilation
subroutine m_pWF_valence_annihilation()
@@ -1386,6 +1405,11 @@ contains
if(nspin==1) then
valence_annihilation_rate=sss/2.d0
+
+#ifdef SINGLE_POSITRON
+ valence_annihilation_rate = sss
+#endif
+
ssk=((0.5292d0)**3)*1.d4/(2.8d0**2)/3.d0/3.1415926d0
ssk=ssk
sss=core_annihilation_rate+valence_annihilation_rate
@@ -1552,6 +1576,11 @@ subroutine m_pWF_wlifetime()
end if
end subroutine m_pWF_wlifetime
+ subroutine m_pWF_update_lifetime
+ if(ipripositron >= 1) write(nfout,*)'lifetime: ',p_old_lifetime,p_new_lifetime
+ p_old_lifetime=p_new_lifetime
+ end subroutine m_pWF_update_lifetime
+
subroutine m_pWF_wd_pzaj(nfout,comment,nc)
integer, intent(in) :: nfout, nc
character(len=nc), intent(in) :: comment
diff -uprN phase0_2015.01/src_phase/m_PseudoPotential.F90 phase0_2015.01.01/src_phase/m_PseudoPotential.F90
--- phase0_2015.01/src_phase/m_PseudoPotential.F90 2015-09-14 15:18:42.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_PseudoPotential.F90 2016-07-12 12:51:19.000000000 +0900
@@ -3,7 +3,7 @@
#define _PAW_CONTINUE_DATA_PREVIOUS_BEFORE_201403_STYLE_
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 454 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 461 $)
!
! MODULE: m_PseudoPotential
!
@@ -72,7 +72,7 @@
module m_PseudoPotential
! (m_PP)
-! $Id: m_PseudoPotential.F90 454 2015-09-07 07:58:39Z yamasaki $
+! $Id: m_PseudoPotential.F90 461 2015-09-15 04:27:48Z ktagami $
!
! The original subroutine name was "pspot", which had been coded by
! Y. Morikawa (JRCAT-NAIR) in 1993 or ealier.
@@ -2575,8 +2575,10 @@ contains
comment_statement = .false.
endif
enddo
+
select case (fn_number_of_words(str))
- case (9)
+! case (9)
+ case (4,9)
is_gncpp = pp_GNCPP1 ! = 1
pptype_char = "GNCPP1"
!!$ if(ipripp>=1 .and. .not.ppprinted) write(nfout,'(" !PP PP type --> GNCPP1")')
diff -uprN phase0_2015.01/src_phase/m_Raman.F90 phase0_2015.01.01/src_phase/m_Raman.F90
--- phase0_2015.01/src_phase/m_Raman.F90 2015-09-14 15:18:51.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Raman.F90 2016-07-12 12:51:19.000000000 +0900
@@ -16,7 +16,8 @@ module m_Raman
use m_Control_Parameters, only : sw_lo_to_splitting, sw_phonon_oneshot, &
& printable, ipriphonon, &
& sw_phonon_with_epsilon, sw_calc_dielectric_tensor, &
- & num_phonon_calc_mode, sw_excitation
+ & num_phonon_calc_mode, sw_excitation, &
+ & sw_phonon, sw_calc_force, sw_use_add_proj, sw_raman
use m_Const_Parameters, only : DP, ON, OFF, FMAXVALLEN, LOWER, PAI4, CMPLDP
@@ -53,6 +54,8 @@ module m_Raman
character(len("classical") ), private, parameter :: &
& tag_classical = "classical"
!
+ character(len("sw_raman") ), private, parameter :: &
+ & tag_sw_raman = "sw_raman"
character(len("sw_phonon_with_epsilon") ), private, parameter :: &
& tag_sw_phonon_with_epsilon = "sw_phonon_with_epsilon"
character(len("sw_calc_dielectric_tensor") ), private, parameter :: &
@@ -208,12 +211,23 @@ contains
logical :: tf
if( f_selectBlock( tag_raman ) == 0) then
+! === 2015/10/19
+ if ( f_getIntValue( tag_sw_raman, iret) == 0 ) sw_raman = iret
+ if ( sw_raman == OFF ) return
+
+ if ( sw_phonon == ON ) sw_phonon_with_epsilon = on
+! === 2015/10/19
+
if ( f_getIntValue( tag_sw_phonon_with_epsilon, iret) == 0) &
& sw_phonon_with_epsilon = iret
if ( sw_phonon_with_epsilon == ON ) then
sw_excitation = ON
write(nfout,*) "!** sw_excitation is turned on"
+! === 2015/10/19
+ sw_use_add_proj = ON
+ write(nfout,*) "!** sw_use_add_proj is turned on"
+! === 2015/10/19
endif
if ( f_getStringValue( tag_raman_calc_scheme, rstr, LOWER) == 0 ) then
@@ -221,6 +235,12 @@ contains
if(tf) sw_phonon_with_epsilon = on
endif
+! === 2015/10/19
+ if ( sw_phonon_with_epsilon == ON ) then
+ if ( sw_calc_force == ON ) sw_calc_dielectric_tensor = ON
+ endif
+! === 2015/10/19
+
if ( f_getIntValue( tag_sw_calc_dielectric_tensor, iret) == 0) &
& sw_calc_dielectric_tensor = iret
@@ -323,8 +343,9 @@ contains
endif
if( f_selectBlock( tag_spectrum ) == 0) then
- if( f_getRealValue( tag_hwhm, dret,'') == 0 ) then
- raman_spectra_hwhm = dret ! in cm-1
+ if( f_getRealValue( tag_hwhm, dret,'') == 0 &
+ & .or. f_getRealValue( tag_linewidth, dret,'') == 0 ) then
+ raman_spectra_hwhm = dret ! in cm-1
if ( raman_spectra_hwhm < 0.0 ) raman_spectra_hwhm = 5.0d0
endif
@@ -375,6 +396,7 @@ contains
end subroutine m_Raman_initialize
subroutine m_Raman_print_param
+ if ( sw_raman == OFF ) return
if ( sw_phonon_with_epsilon == OFF ) return
write(nfout,'(A)') '!** ----- RAMAN setup ----- '
diff -uprN phase0_2015.01/src_phase/m_ThomasFermiW_Potential.F90 phase0_2015.01.01/src_phase/m_ThomasFermiW_Potential.F90
--- phase0_2015.01/src_phase/m_ThomasFermiW_Potential.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_ThomasFermiW_Potential.F90 2016-07-12 12:51:19.000000000 +0900
@@ -84,7 +84,7 @@ contains
ik = ista_k
call new_radr_and_wos(ik,it) ! --> radr, wos
- rcut = rad_cov_default( iatomn(it) )
+ rcut = rad_cov_default( nint(iatomn(it)) ) ! Revised according to a report from ASMS Co.ltd, 10 March 2016.
Do il1=1, lpsmax(it)
if ( il1 == iloc(it) ) cycle
diff -uprN phase0_2015.01/src_phase/m_Total_Energy.F90 phase0_2015.01.01/src_phase/m_Total_Energy.F90
--- phase0_2015.01/src_phase/m_Total_Energy.F90 2015-09-14 15:19:25.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Total_Energy.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 454 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_Total_Energy
!
@@ -33,7 +33,7 @@
!
module m_Total_Energy
! ( m_TE )
-! $Id: m_Total_Energy.F90 454 2015-09-07 07:58:39Z yamasaki $
+! $Id: m_Total_Energy.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Charge_Density, only : chgq_l, chgqo_l, hsr
!fj$$ use m_XC_Potential, only : vxc_l, exc, m_XC_cal_potential
use m_XC_Potential, only : vxc_l, exc,eex,ecor
@@ -145,6 +145,15 @@ module m_Total_Energy
use m_Control_Parameters, only : m_CtrlP_get_isolver_now
+! === Positron SCF ==== 2015/11/28
+ use m_Control_Parameters, only : sw_positron, npeg, positron_method
+ use m_Const_Parameters, only : positron_GGGC
+ use m_epc_potential, only : ecorr_pztr => epc, m_epc_cal_potential, vepc_l
+ use m_PlaneWaveBasisSet, only : kg1_pwf
+ use m_Positron_Wave_Functions, only : pzaj, nprvf_ordr, pchg_l, pchgo_l, pev
+ use m_PlaneWaveBasisSet, only : m_pwBS_pstrn_kinetic_energies
+! ==================== 2015/11/28
+
implicit none
include 'mpif.h'
@@ -215,6 +224,10 @@ module m_Total_Energy
real(kind=DP),private :: espinorb_old, espinorb_now
! ========================================================================== 11.0
+! === positron
+ real(kind=DP) :: ekin_pztr, elocal_pztr, ehartr_ep, eohxc_pztr
+! ===
+
integer,private, parameter :: len_str = 132
character(len=len_str),private :: str
@@ -316,6 +329,21 @@ contains
#endif
end if
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_GGGC ) then
+ call get_local_pot_energy_pztr
+ call get_xc_and_HE_of_old_CD_pztr( vepc_l )
+ call get_hartree_energy_inter_ep
+ call m_epc_cal_potential( nfout, chgq_l )
+
+ if (iteration_electronic==1) then
+ call get_kinetic_energy_pztr_direct(nfout)
+ else
+ call get_kinetic_energy_pztr(nfout)
+ endif
+ endif
+ endif
+
#ifdef ENABLE_ESM_PACK
! ============== KT_mod =============================== 13.0U2
! if(sw_esm==ON.or.sw_hybrid_functional==ON)then
@@ -549,6 +577,13 @@ contains
eohxc = eohxc &
& + chgqo_l(i,ik,1)*chgq_l(i,ik,1)*screening%phik(i)
end if
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == positron_GGGC ) then
+ eohxc = eohxc &
+ & - (PAI4 *pchgo_l(i,ik)/gr_l(i)**2) &
+ & * chgq_l(i,ik,1)
+ endif
+ endif
end do
else if(nspin == 2) then
do i = ist, iend_kngp !for mpi
@@ -567,6 +602,13 @@ contains
& + (chgqo_l(i,ik,UP)+chgqo_l(i,ik,DOWN))* &
& (chgq_l(i,ik,UP)+chgq_l(i,ik,DOWN))*screening%phik(i)
end if
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == positron_GGGC ) then
+ eohxc = eohxc &
+ & - (PAI4 *pchgo_l(i,ik)/gr_l(i)**2) &
+ & *(chgq_l(i,ik,UP)+chgq_l(i,ik,DOWN))
+ end if
+ endif
end do
end if
end do
@@ -1250,6 +1292,142 @@ contains
deallocate(ekin)
end subroutine get_kinetic_energy_directly
+! ==== positron ===
+ subroutine get_xc_and_HE_of_old_CD_pztr(vepc_l)
+ real(kind=DP), intent(in) :: vepc_l(ista_kngp:iend_kngp,kimg,nspin)
+ integer ik, i, ispin
+ integer ist !mpi
+ real(kind=DP) :: eohxc_pztr_mpi
+
+ eohxc_pztr = 0.d0
+ do ik = 1, kimg
+ do ispin = 1, nspin
+ if(mype==0) then
+ eohxc_pztr = eohxc_pztr + vepc_l(1,ik,ispin)*pchg_l(1,ik)
+ endif
+ end do
+ ist = ista_kngp
+ if(ist == 1) ist = 2
+
+ if(nspin == 1) then
+ do i = ist, iend_kngp !for mpi
+ eohxc_pztr = eohxc_pztr &
+ & + (vepc_l(i,ik,1) -PAI4*chgqo_l(i,ik,1)/gr_l(i)**2) &
+ & * pchg_l(i,ik)
+ end do
+ else if(nspin == 2) then
+ stop "YYY"
+ end if
+ end do
+ if(npes > 1) then
+ call mpi_allreduce(eohxc_pztr,eohxc_pztr_mpi,1 &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ eohxc_pztr = eohxc_pztr_mpi
+ end if
+!
+ eohxc_pztr = univol *eohxc_pztr
+ end subroutine get_xc_and_HE_of_old_CD_pztr
+
+ subroutine get_kinetic_energy_pztr(nfout)
+ integer,intent(in) :: nfout
+ integer :: ik,ib,ig
+ real(kind=DP) :: ekinet_tmp, ekinet_mpi
+
+ ekin_pztr = 0.0
+ Do ib=1, npeg
+ if ( nprvf_ordr(ib) /= 1 ) cycle
+ ekin_pztr = ekin_pztr + pev(ib)
+ End do
+ ekin_pztr = ekin_pztr -eohxc_pztr -elocal_pztr
+ end subroutine get_kinetic_energy_pztr
+
+ subroutine get_kinetic_energy_pztr_direct(nfout)
+ integer,intent(in) :: nfout
+ integer :: ik,ib,ig
+ real(kind=DP), allocatable, dimension(:) :: ekin
+ real(kind=DP) :: ekinet_tmp, ekinet_mpi, e1
+
+ allocate(ekin(kg1_pwf));ekin=0.d0
+
+ ekin_pztr = 0.d0
+
+ call m_pwBS_pstrn_kinetic_energies(ekin)
+
+ do ib=1, npeg
+ if ( nprvf_ordr(ib) /= 1 ) cycle
+ ekinet_tmp=0.d0
+ if (kimg==1) then
+ do ig=1, kg1_pwf
+ ekinet_tmp = ekinet_tmp + ekin(ig)*pzaj(ig,ib,1)**2
+ enddo
+ else if (kimg==2) then
+ do ig=1, kg1_pwf
+ ekinet_tmp = ekinet_tmp + ekin(ig)*( pzaj(ig,ib,1)**2 &
+ & +pzaj(ig,ib,2)**2)
+ enddo
+ endif
+ ekin_pztr = ekin_pztr +ekinet_tmp
+ enddo
+ deallocate(ekin)
+
+ end subroutine get_kinetic_energy_pztr_direct
+
+ subroutine get_hartree_energy_inter_ep
+ integer ik, i
+ integer :: ist !mpi
+ real(kind=DP) :: ehartr_mpi
+
+ ehartr_mpi = 0.d0
+ ehartr_ep = 0.d0
+
+ do ik = 1, kimg
+
+ ist = ista_kngp
+ if(ist == 1) ist = 2
+
+ if(nspin == 1) then
+ do i = ist, iend_kngp !for mpi
+ ehartr_mpi = ehartr_mpi + PAI4 *chgq_l(i,ik,1) *pchg_l(i,ik) &
+ & /gr_l(i)**2
+ end do
+ else if(nspin == 2) then
+ stop "PPP"
+ endif
+ end do
+ call mpi_allreduce(ehartr_mpi,ehartr_ep,1 &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+
+ ehartr_ep = -univol *ehartr_ep
+
+ end subroutine get_hartree_energy_inter_ep
+
+ subroutine get_local_pot_energy_pztr
+ integer :: ik, it, i, ig
+ real(kind=DP) :: elocal_mpi
+
+ elocal_pztr = 0.d0
+ do ik = 1, kimg
+ if(nspin == 1) then
+ do it = 1,ntyp
+ do i = ista_kngp, iend_kngp !for mpi
+ elocal_pztr = elocal_pztr &
+ & + psc_l(i,it)*zfm3_l(i,it,ik)*pchg_l(i,ik)
+ end do
+ end do
+ else
+ stop "PPP"
+ endif
+ end do
+ if(npes > 1) then
+ call mpi_allreduce(elocal_pztr,elocal_mpi,1 &
+ & ,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ elocal_pztr = elocal_mpi
+ end if
+
+ elocal_pztr = -univol*elocal_pztr
+ end subroutine get_local_pot_energy_pztr
+! =====
+
subroutine get_xc_and_HE_of_old_CD_paw(nfout)
integer, intent(in) :: nfout
integer :: ispin, it,lmt1, lmt2, il1, im1, il2, im2, ia
@@ -2067,6 +2245,14 @@ contains
endif
! ================= 13.0S
+! ==== POSITRON SCF == 2015/11/28
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_GGGC ) then
+ etotal0 = etotal0 +ekin_pztr +elocal_pztr +ecorr_pztr +ehartr_ep
+ endif
+ endif
+! =================== 2015/11/28
+
if(sw_dipole_correction == ON) etotal0 = etotal0 + edip
if(sw_hubbard == ON) etotal0 = etotal0 + ehub0
if(sw_hybrid_functional == ON) etotal0 = etotal0 + eexx
diff -uprN phase0_2015.01/src_phase/m_Wannier90.F90 phase0_2015.01.01/src_phase/m_Wannier90.F90
--- phase0_2015.01/src_phase/m_Wannier90.F90 2015-09-14 15:19:53.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_Wannier90.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,4 +1,6 @@
#define WAN90_SAVE_MEMORY
+#define WAN90_SKIP_FFT
+#define WAN90_SPN_FORMATTED
!=======================================================================
!
! PROGRAM PHASE/0 2014.01 ($Rev: 110 $)
@@ -48,16 +50,23 @@ module m_Wannier90
& , nrank_e,myrank_e,map_e,ista_e,iend_e,istep_e,idisp_e &
& , map_z,np_e,mpi_k_world,myrank_k,map_k,ista_k,iend_k &
& , ista_snl, iend_snl, ierr, map_ek, nrank_k
-! === KT_add === 2015/02/23, 08/31
+! === KT_add === 2015/02/23, 09/02
use m_Const_Parameters, only : Delta07, zi, ON, UP, DOWN
use m_Control_Parameters, only : ndim_spinor, sw_use_hardpart_wan90, noncol, &
& spin_component_wan90
use m_Ionic_System, only : natm, ityp, cps, pos
use m_PseudoPotential, only : dk_wan, nloc, nlmta, m_PP_include_vanderbilt_pot, &
& ltp, mtp, taup, ilmt, lmta, il2p, isph, iqitg, dl2p, &
- & qitg_wan, nqitg, phirpw, psirpw
+ & qitg_wan, nqitg, phirpw, psirpw, q
use m_Electronic_Structure,only: fsr_l, fsi_l
-! ============== 2015/02/23, 08/31
+! ============== 2015/02/23, 09/02
+
+! === KT_add === 2015/09/14
+ use m_Const_Parameters, only : ELECTRON, DIRECT, INVERSE
+ use m_Electronic_Structure, only : m_ES_map_wf_on_fftmesh
+ use m_FFT, only : m_FFT_WF
+ use m_PlaneWaveBasisSet, only : kg1, kg
+! ============== 2015/09/14
implicit none
@@ -77,10 +86,18 @@ module m_Wannier90
integer, allocatable :: ib_inc(:) ! d(num_bands)
real(kind=DP), allocatable :: projfunc(:,:,:,:) ! d(kg1,n_proj,ista_snl:iend_snl,kimg)
-! ==== KT_add === 2015/04/13
+
+! ==== KT_add === 2015/04/13 & 09/02
real(kind=DP), allocatable :: dk_unit(:,:)
logical, allocatable :: centre_on_atom(:)
-! =============== 2015/04/13
+
+ integer, allocatable :: spn_index(:)
+ real(kind=DP), allocatable :: spn_quant_dir(:,:)
+! =============== 2015/04/13 & 09/02
+
+! ==== KT_add === 2015/09/14
+ integer, allocatable :: igf_wan90(:,:,:,:)
+! =============== 2015/09/14
include 'mpif.h' ! MPI
integer istatus(mpi_status_size) ! MPI
@@ -146,10 +163,26 @@ contains
allocate(zaxis(3,n_proj))
allocate(xaxis(3,n_proj))
allocate(zona(n_proj))
- do i=1,n_proj
- read(nfwannier,*) centre(1:3,i), lang(i), mr(i), irf(i)
- read(nfwannier,*) zaxis(1:3,i), xaxis(1:3,i), zona(i)
- end do
+
+ if ( noncol ) then
+ allocate( spn_index(n_proj) )
+ allocate( spn_quant_dir(3,n_proj) )
+ endif
+
+ if ( noncol ) then
+ do i=1,n_proj
+ read(nfwannier,*) centre(1:3,i), lang(i), mr(i), irf(i)
+ read(nfwannier,*) zaxis(1:3,i), xaxis(1:3,i), zona(i)
+!
+ read(nfwannier,*) spn_index(i), spn_quant_dir(1:3,i)
+ end do
+ else
+ do i=1,n_proj
+ read(nfwannier,*) centre(1:3,i), lang(i), mr(i), irf(i)
+ read(nfwannier,*) zaxis(1:3,i), xaxis(1:3,i), zona(i)
+ end do
+ endif
+
read(nfwannier,*)
read(nfwannier,*)
@@ -183,7 +216,7 @@ contains
close(nfwannier)
-! == KT add == 2015/02/23
+! == KT add == 2015/02/23 & 09/02
100 continue
if ( npes > 1 ) then
call mpi_bcast( calc_only_A, 1, mpi_logical, 0, mpi_comm_group, ierr )
@@ -214,6 +247,17 @@ contains
call mpi_bcast( zona, n_proj, mpi_double_precision, 0, &
& mpi_comm_group, ierr )
+ if ( noncol ) then
+ if ( mype /= 0 ) then
+ allocate( spn_index(n_proj) )
+ allocate( spn_quant_dir(3,n_proj) )
+ endif
+ call mpi_bcast( spn_index, n_proj, mpi_integer, 0, &
+ & mpi_comm_group, ierr )
+ call mpi_bcast( spn_quant_dir, 3*n_proj, mpi_double_precision, 0, &
+ & mpi_comm_group, ierr )
+ endif
+
call mpi_bcast( lang, n_proj, mpi_integer, 0, mpi_comm_group, ierr )
call mpi_bcast( mr, n_proj, mpi_integer, 0, mpi_comm_group, ierr )
call mpi_bcast( irf, n_proj, mpi_integer, 0, mpi_comm_group, ierr )
@@ -231,7 +275,7 @@ contains
endif
call mpi_bcast( exclude_bands, n_exclude, mpi_integer, 0, mpi_comm_group, ierr )
endif
-! ============= 2015/02/23
+! ============= 2015/02/23 & 09/02
num_bands = nb_wan90 - n_exclude
allocate(ib_inc(num_bands))
@@ -469,7 +513,10 @@ contains
end subroutine gather_matrix
subroutine print_mat
- integer :: ik ,m, n, ik_start, iktmp
+ integer :: ik ,m, n, ik_start, iktmp, is
+ real(kind=DP) :: theta, phi
+ complex(kind=CMPLDP) :: ztmp, z1
+ complex(kind=CMPLDP), allocatable :: spn_weight(:,:)
if ( mype /= 0 ) return
@@ -487,15 +534,37 @@ contains
write(nfwannier,*) num_bands, kv3/nspin, n_proj
if ( noncol ) then
- do ik = 1, kv3, nspin
- iktmp = ( ik -1 )/nspin +1
+ allocate( spn_weight(2,n_proj) ); spn_weight = 0.0d0
+
+ Do n=1, n_proj
+ theta = acos( spn_quant_dir(3,n) )
+ phi = atan2( spn_quant_dir(2,n), spn_quant_dir(1,n) )
+!
+ if ( spn_index(n) == 1 ) then
+ spn_weight(1,n) = exp( zi *phi /2.0d0 ) *cos( theta /2.0d0 )
+ spn_weight(2,n) = -exp( zi *phi /2.0d0 ) *sin( theta /2.0d0 )
+ else
+ spn_weight(1,n) = exp( -zi *phi /2.0d0 ) *sin( theta /2.0d0 )
+ spn_weight(2,n) = exp( -zi *phi /2.0d0 ) *cos( theta /2.0d0 )
+ endif
+ End do
+
+ do ik = 1, kv3, ndim_spinor
+ iktmp = ( ik -1 )/ndim_spinor +1
do n=1,n_proj
do m=1,num_bands
+ ztmp = 0.0d0
+ Do is=1, ndim_spinor
+ z1 = dcmplx( a_mat(m,n,ik+is-1,1), a_mat(m,n,ik+is-1,2 ) )
+ ztmp = ztmp +spn_weight(is,n) *z1
+ End do
+
write(nfwannier,'(3(1x,i5),2(1x,f18.12))') m, n, iktmp, &
- & a_mat(m,n,ik,1:2) +a_mat(m,n,ik+1,1:2)
+ & real(ztmp), aimag(ztmp)
end do
end do
end do
+ deallocate( spn_weight )
else
ik_start = 1
@@ -1181,12 +1250,21 @@ contains
allocate(m_mat(num_bands,num_bands,ista_k:iend_k,nntot,2)); m_mat = 0.d0
#endif
- call contrib_softpart
+#ifndef WAN90_SKIP_FFT
+! call contrib_softpart
+ call contrib_softpart2
+#else
+ call m_Wan90_set_igf_wan90
+ call contrib_softpart3
+#endif
+
if ( sw_use_hardpart_wan90 == ON ) call contrib_hardpart
call gather_matrix
call print_mmat
+ if ( allocated( dk_unit ) ) deallocate( dk_unit )
+ if ( allocated( igf_wan90 ) ) deallocate( igf_wan90 )
deallocate(m_mat)
contains
@@ -1300,6 +1378,211 @@ contains
end subroutine contrib_softpart
+ subroutine contrib_softpart2 ! FFT and inverse-FFT on u_n(k+b)
+ logical :: shift_k
+ integer :: i,ik1,ik2,nn,n,m,ni,mi,ib1,ib2,nnc(3),ir,im
+ integer :: nffth,ip,r1,r2,r3,ngrid
+ integer :: id1,id2,id12
+ integer :: ik_start, ik_skip, iktmp, is1
+ real(kind=DP) :: rgrid(3),da(3),wr,wi,dvol,ph,sumr,sumi
+ real(kind=DP), allocatable :: wf1(:), wf2(:), zcos(:), zsin(:)
+ real(kind=DP), allocatable :: psi1(:,:,:,:)
+ real(kind=DP), allocatable :: psi2(:,:,:,:)
+
+ nffth = nfft/2
+ ngrid = product(fft_box_size_WF(1:3,1))
+ dvol = 1.d0/dble(ngrid)
+
+ allocate(wf1(nfft),wf2(nfft))
+ allocate(zcos(nffth),zsin(nffth))
+
+ call m_FFT_alloc_WF_work()
+
+ ik_start = 1; ik_skip = 1
+ if ( .not. noncol ) then
+ if ( nspin == 2 .and. spin_component_wan90 == DOWN ) then
+ ik_start = 2
+ endif
+ if ( nspin == 2 ) ik_skip = 2
+ endif
+
+ do nn=1,nntot
+ do ik1 = ik_start, kv3, ik_skip
+ iktmp = ( ik1 -1 )/nspin + 1
+ is1 = mod( ik1 -1, nspin ) +1
+
+ ik2 = nspin*( nnlist(iktmp,nn) -1 ) +is1
+
+ nnc(1:3) = nncell(1:3,iktmp,nn)
+
+ if(all(nnc(1:3) == 0)) then
+ shift_k = .false.
+ else
+ shift_k = .true.
+ ! Phase factors, exp(iG*r)
+ id1 = fft_box_size_WF(1,0)
+ id2 = fft_box_size_WF(2,0)
+ id12 = id1*id2
+ da(1:3) = 1.d0/fft_box_size_WF(1:3,1)
+ do i=1,nffth
+ ip = i-1
+ r3 = ip/id12
+ r2 = (ip-r3*id12)/id1
+ r1 = ip-r2*id1-r3*id12
+ rgrid(1) = dble(r1)*da(1)
+ rgrid(2) = dble(r2)*da(2)
+ rgrid(3) = dble(r3)*da(3)
+ ph = PAI2*dot_product(nnc,rgrid)
+ zcos(i) = cos(ph); zsin(i) = sin(ph)
+ end do
+ end if
+ do n=1,num_bands
+ ni = ib_inc(n)
+
+ if ( map_ek(ni,ik2) == mype ) then
+ ib2 = neordr(ni,ik2)
+
+ allocate( psi2(kg1,1,ik2:ik2,kimg) ); psi2 = 0.0d0
+ psi2(1:iba(ik2),1,ik2,:) = zaj_l(1:iba(ik2),map_z(ib2),ik2,:)
+
+ call m_ES_map_WF_on_fftmesh( ik2, ik2, ik2, psi2, wf2 )
+ deallocate(psi2)
+
+ if ( shift_k ) then
+ call m_FFT_WF( ELECTRON, nfout, wf2, INVERSE, ON )
+ ! u_n(k+b) = exp(-iG*r) * u_n(k')
+ ! k+b = k' + G
+ do i=1,nffth
+ ir = 2*i-1; im = ir+1
+ wr = wf2(ir); wi = wf2(im)
+ wf2(ir) = zcos(i)*wr + zsin(i)*wi
+ wf2(im) = zcos(i)*wi - zsin(i)*wr
+ end do
+ call m_FFT_WF( ELECTRON, nfout, wf2, DIRECT, ON )
+ wf2 = wf2 *dvol
+ end if
+
+ endif
+
+ call mpi_bcast( wf2, nfft, mpi_double_precision, map_ek(ni,ik2), &
+ & mpi_comm_group, ierr )
+
+ do m=1,num_bands
+ mi = ib_inc(m)
+
+ if ( map_ek(mi,ik1) /= mype ) cycle
+
+ ib1 = neordr(mi,ik1)
+
+ allocate( psi1(kg1,1,ik1:ik1,kimg) ); psi1 = 0.0d0
+ psi1(1:iba(ik1),1,ik1,:) = zaj_l(1:iba(ik1),map_z(ib1),ik1,:)
+
+ call m_ES_map_WF_on_fftmesh( ik1, ik1, ik1, psi1, wf1 )
+ deallocate( psi1 )
+
+ ! <u_m(k)|u_n(k+b)>
+ sumr = 0.d0; sumi = 0.d0
+ do i=1,nffth
+ ir = 2*i-1; im = ir+1
+ sumr = sumr + wf1(ir)*wf2(ir) + wf1(im)*wf2(im)
+ sumi = sumi + wf1(ir)*wf2(im) - wf1(im)*wf2(ir)
+ end do
+ m_mat(m,n,ik1,nn,1) = sumr
+ m_mat(m,n,ik1,nn,2) = sumi
+
+ end do
+ end do
+ end do
+ end do
+
+ call m_FFT_dealloc_WF_work()
+
+ deallocate(wf1,wf2); deallocate(zcos,zsin)
+
+ end subroutine contrib_softpart2
+
+ subroutine contrib_softpart3 ! does not use FFT, but displace G vector
+ logical :: shift_k
+ integer :: i,ik1,ik2,nn,n,m,ni,mi,ib1,ib2,nnc(3),ir,im
+ integer :: nffth,ip,r1,r2,r3,ngrid
+ integer :: id1,id2,id12
+ integer :: ik_start, ik_skip, iktmp, is1
+ real(kind=DP) :: rgrid(3),da(3),wr,wi,dvol,ph,sumr,sumi
+ real(kind=DP), allocatable :: wf1(:), wf2(:), zcos(:), zsin(:)
+ real(kind=DP), allocatable :: psi1(:,:,:,:)
+ real(kind=DP), allocatable :: psi2(:,:,:,:)
+
+ nffth = nfft/2
+ ngrid = product(fft_box_size_WF(1:3,1))
+ dvol = 1.d0/dble(ngrid)
+
+ allocate(wf1(nfft),wf2(nfft))
+
+ ik_start = 1; ik_skip = 1
+ if ( .not. noncol ) then
+ if ( nspin == 2 .and. spin_component_wan90 == DOWN ) then
+ ik_start = 2
+ endif
+ if ( nspin == 2 ) ik_skip = 2
+ endif
+
+ do nn=1,nntot
+ do ik1 = ik_start, kv3, ik_skip
+ iktmp = ( ik1 -1 )/nspin + 1
+ is1 = mod( ik1 -1, nspin ) +1
+
+ ik2 = nspin*( nnlist(iktmp,nn) -1 ) +is1
+
+ nnc(1:3) = nncell(1:3,iktmp,nn)
+
+ do n=1,num_bands
+ ni = ib_inc(n)
+
+ if ( map_ek(ni,ik2) == mype ) then
+ ib2 = neordr(ni,ik2)
+
+ allocate( psi2(kg1,1,ik2:ik2,kimg) ); psi2 = 0.0d0
+ psi2(1:iba(ik2),1,ik2,:) = zaj_l(1:iba(ik2),map_z(ib2),ik2,:)
+
+ call m_wan90_map_WF_on_fftmesh( ik2, ik2, ik2, psi2, wf2, &
+ & igf_wan90(:,nnc(1),nnc(2),nnc(3)) )
+ deallocate(psi2)
+ endif
+
+ call mpi_bcast( wf2, nfft, mpi_double_precision, map_ek(ni,ik2), &
+ & mpi_comm_group, ierr )
+
+ do m=1,num_bands
+ mi = ib_inc(m)
+
+ if ( map_ek(mi,ik1) /= mype ) cycle
+
+ ib1 = neordr(mi,ik1)
+
+ allocate( psi1(kg1,1,ik1:ik1,kimg) ); psi1 = 0.0d0
+ psi1(1:iba(ik1),1,ik1,:) = zaj_l(1:iba(ik1),map_z(ib1),ik1,:)
+
+ call m_ES_map_WF_on_fftmesh( ik1, ik1, ik1, psi1, wf1 )
+ deallocate( psi1 )
+
+ ! <u_m(k)|u_n(k+b)>
+ sumr = 0.d0; sumi = 0.d0
+ do i=1,nffth
+ ir = 2*i-1; im = ir+1
+ sumr = sumr + wf1(ir)*wf2(ir) + wf1(im)*wf2(im)
+ sumi = sumi + wf1(ir)*wf2(im) - wf1(im)*wf2(ir)
+ end do
+ m_mat(m,n,ik1,nn,1) = sumr
+ m_mat(m,n,ik1,nn,2) = sumi
+
+ end do
+ end do
+ end do
+ end do
+ deallocate(wf1,wf2)
+
+ end subroutine contrib_softpart3
+
subroutine contrib_hardpart
integer :: n, nn, ik1, ik2, nnc(3)
integer :: myindex, m, mm, ni, mi, kk
@@ -1862,4 +2145,345 @@ contains
end subroutine deompose_sphr_into_lm
! =========== 2015/02/23
+! ==== KT_add === 2015/09/04
+ subroutine m_Wan90_gen_mat_spn
+ integer :: npauli = 3
+
+ complex(kind=CMPLDP), allocatable :: spn_mat(:,:,:,:) ! d(neg,neg,kv3/nspin,3)
+
+ allocate( spn_mat( npauli, num_bands, num_bands, kv3/ndim_spinor) ); spn_mat = 0.d0
+
+ call contrib_softpart
+ if ( sw_use_hardpart_wan90 == ON ) call contrib_hardpart
+
+ call gather_matrix
+ call print_mat
+
+ deallocate( spn_mat )
+
+ contains
+
+ subroutine contrib_softpart
+ integer :: ik0, ik1, ik2, iktmp, is1, is2
+ integer :: ig
+ integer :: m, mi, n, ni, ib1, ib2
+ complex(kind=CMPLDP) :: zsum
+
+ real(kind=DP), allocatable :: wk_zaj(:,:)
+ real(kind=DP) :: c1, c2
+ complex(kind=CMPLDP) :: z1, z2
+
+ allocate( wk_zaj( kg1, kimg ) ); wk_zaj = 0.0d0
+
+ do ik0=1, kv3, ndim_spinor
+ if ( map_k(ik0) /= myrank_k ) cycle
+
+ iktmp = ( ik0 -1 )/ndim_spinor +1
+
+ Do is2=1, ndim_spinor
+ ik2 = ik0 +is2 -1
+
+ Do n=1, num_bands
+ ni = ib_inc(n)
+ ib2 = neordr(ni,ik2)
+
+ if ( map_e(ib2) == myrank_e ) then
+ wk_zaj(1:iba(ik2),1:kimg) = zaj_l(1:iba(ik2),map_z(ib2),ik2,1:kimg)
+ endif
+ call mpi_bcast( wk_zaj, kg1*kimg, mpi_double_precision, map_e(ib2), &
+ & mpi_k_world(myrank_k), ierr )
+
+ Do is1=1, ndim_spinor
+ ik1 = ik0 +is1 -1
+
+ do m=1,num_bands
+ mi = ib_inc(m)
+ ib1 = neordr(mi,ik1)
+
+ if ( map_e(ib1) /= myrank_e ) cycle
+
+ zsum = 0.0d0
+
+ if ( kimg == 1 ) then
+ Do ig=1, iba(ik0)
+ c1 = zaj_l(ig,map_z(ib1),ik1,1)
+ c2 = c1 *wk_zaj(ig,1)
+ zsum = zsum +c2
+ End do
+ else
+ Do ig=1, iba(ik0)
+ z1 = dcmplx( zaj_l(ig,map_z(ib1),ik1,1), &
+ & zaj_l(ig,map_z(ib1),ik1,2) )
+ z2 = conjg(z1) *dcmplx( wk_zaj(ig,1), wk_zaj(ig,2) )
+ zsum = zsum +z2
+ End Do
+ endif
+!
+ if ( is1 == 1 .and. is2 == 1 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) +zsum
+ else if ( is1 == 1 .and. is2 == 2 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) -zsum *zi
+ else if ( is1 == 2 .and. is2 == 1 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) +zsum *zi
+ else if ( is1 == 2 .and. is2 == 2 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) -zsum
+ endif
+
+ end do
+ end Do
+ end do
+ end do
+ end do
+
+ end subroutine contrib_softpart
+
+ subroutine contrib_hardpart
+ integer :: ik0, ik1, ik2, iktmp, is1, is2
+ integer :: mi, m, ni, n, ib1, ib2
+ integer :: ia, it, mdvdb, lmt1, lmt2, il1, il2, it1, it2
+ integer :: lmta1, lmta2
+ complex(kind=CMPLDP) :: zsum, wf1, wf2
+ complex(kind=CMPLDP), allocatable :: wk_fsri(:)
+
+ allocate( wk_fsri(nlmta) ); wk_fsri = 0.0d0
+
+! -- start
+ Do ik0=1, kv3, ndim_spinor
+ if ( map_k(ik0) /= myrank_k ) cycle
+
+ iktmp = ( ik0 -1 )/ndim_spinor +1
+
+ Do is2=1, ndim_spinor
+ ik2 = ik0 +is2 -1
+
+ do n=1,num_bands
+ ni = ib_inc(n)
+ ib2 = neordr(ni,ik2)
+
+ if ( map_e(ib2) == mype ) then
+ wk_fsri(:) = dcmplx( fsr_l( map_z(ib2),:,ik2 ), &
+ & fsi_l( map_z(ib2),:,ik2 ) )
+ endif
+ call mpi_bcast( wk_fsri, 2*nlmta, mpi_double_precision, &
+ & map_e(ib2), mpi_k_world(myrank_k), ierr )
+
+ Do is1=1, ndim_spinor
+ ik1 = ik0 +is1 -1
+
+ do m=1,num_bands
+ mi = ib_inc(m)
+ ib1 = neordr(mi,ik1)
+
+ if ( map_e(ib1) /= myrank_e ) cycle
+
+ zsum = 0.d0
+
+ Do ia=1, natm
+ it = ityp(ia)
+ mdvdb = m_PP_include_vanderbilt_pot(it)
+ if ( mdvdb == SKIP ) cycle
+
+ Do lmt1=1, ilmt(it)
+ il1 = ltp(lmt1,it); it1 = taup(lmt1,it)
+ lmta1 = lmta( lmt1,ia )
+ wf1 = dcmplx( fsr_l( map_z(ib1), lmta1, ik1 ), &
+ & fsi_l( map_z(ib1), lmta1, ik1 ) )
+
+ Do lmt2=1, ilmt(it)
+ il2 = ltp(lmt2,it); it2 = taup(lmt2,it)
+ lmta2 = lmta( lmt2,ia )
+ wf2 = wk_fsri(lmta2)
+
+ zsum = zsum +conjg(wf1) * wf2 *q(lmt1,lmt2,it)
+ End do
+ End Do
+ End Do
+
+ if ( is1 == 1 .and. is2 == 1 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) +zsum
+ else if ( is1 == 1 .and. is2 == 2 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) -zsum *zi
+ else if ( is1 == 2 .and. is2 == 1 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) +zsum *zi
+ else if ( is1 == 2 .and. is2 == 2 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) -zsum
+ endif
+
+ End do
+ End Do
+ End DO
+ End Do
+ End Do
+
+ deallocate( wk_fsri )
+
+ end subroutine contrib_hardpart
+
+ subroutine gather_matrix
+ complex(kind=CMPLDP), allocatable :: spn_mat_mpi(:,:,:,:) ! d(neg,neg,kv3/nspin,3)
+
+ if (npes>1) then
+ allocate(spn_mat_mpi(npauli,num_bands,num_bands,kv3/nspin) )
+ spn_mat_mpi = spn_mat
+ spn_mat = 0.d0
+ call mpi_allreduce( spn_mat_mpi, spn_mat, &
+ & num_bands*num_bands*kv3/nspin*npauli*2, &
+ & mpi_double_precision, mpi_sum, mpi_comm_group,ierr )
+ deallocate(spn_mat_mpi)
+ end if
+
+ call mpi_barrier( mpi_comm_world, ierr )
+
+ end subroutine gather_matrix
+
+ subroutine print_mat
+ integer :: ik, mi, ni, ispn, num, nsize
+ complex(kind=CMPLDP), allocatable :: work(:,:)
+
+ if ( mype /= 0 ) return
+
+ open(nfwannier,file=trim(wan90_seedname)//".spn",form="formatted")
+
+#ifdef WAN90_SPN_FORMATTED
+ write(nfwannier,*) 'Generated by PHASE noncol'
+ write(nfwannier,*) num_bands, kv3/nspin
+
+ do ik=1, kv3/nspin
+ Do mi=1, num_bands
+ Do ni=1, mi
+ Do ispn=1, 3
+ write(nfwannier,'(2f16.12)') spn_mat(ispn,mi,ni,ik)
+ End Do
+ End Do
+ End do
+ end do
+#else
+ write(nfwannier) 'Generated by PHASE noncol'
+ write(nfwannier) num_bands, kv3/nspin
+
+ nsize = num_bands *( num_bands +1 ) /2
+ allocate( work(3, nsize) ); work = 0.0d0
+
+ Do ik=1, kv3/nspin
+ num = 0
+ Do mi=1, num_bands
+ Do ni=1, mi
+ num = num +1
+ work(:,num) = spn_mat(:,mi,ni,ik)
+ End Do
+ End Do
+ write(nfwannier) ( (work(ispn,mi),ispn=1,3), mi=1, nsize )
+ End do
+ deallocate( work )
+#endif
+
+ close(nfwannier)
+
+ end subroutine print_mat
+
+ end subroutine m_Wan90_gen_mat_spn
+! ================== 2015/09/04
+
+! ==== KT_add ==== 2015/09/14
+ subroutine m_Wan90_set_igf_wan90
+ integer :: id, i
+ integer :: igf1, igf2, igf3
+ integer :: nx, ny, nz
+ integer :: nxmin, nymin, nzmin, nxmax, nymax, nzmax
+!
+ nxmin = minval( nncell(1,:,:) ); nxmax = maxval( nncell(1,:,:) );
+ nymin = minval( nncell(2,:,:) ); nymax = maxval( nncell(2,:,:) );
+ nzmin = minval( nncell(3,:,:) ); nzmax = maxval( nncell(3,:,:) );
+
+ allocate( igf_wan90( kg, nxmin:nxmax, nymin:nymax, nzmin:nzmax ) )
+ igf_wan90 = 0
+!
+ id = fft_box_size_WF(1,0)
+
+ Do nx=nxmin, nxmax
+ Do ny=nymin, nymax
+ Do nz=nzmin, nzmax
+
+ do i = 1, kg
+ igf1 = ngabc(i,1) + 1 -nx
+ igf2 = ngabc(i,2) + 1 -ny
+ igf3 = ngabc(i,3) + 1 -nz
+!
+ if ( igf1 <= 0 ) igf1 = igf1 + fft_box_size_WF(1,1)
+ if ( igf2 <= 0 ) igf2 = igf2 + fft_box_size_WF(2,1)
+ if ( igf3 <= 0 ) igf3 = igf3 + fft_box_size_WF(3,1)
+
+ igf_wan90(i,nx,ny,nz) = igf1 + (igf2-1)*id &
+ & + (igf3-1)*id*fft_box_size_WF(2,0)
+ enddo
+ End Do
+ End Do
+ End Do
+ end subroutine m_Wan90_set_igf_wan90
+
+ subroutine m_Wan90_map_WF_on_fftmesh(k1,k2,ik,psi_l,bfft,igf_in)
+ integer, intent(in) :: k1,k2,ik
+ integer, intent(in) :: igf_in(kg1)
+ real(kind=DP), intent(in),dimension(kg1,1,k1:k2,kimg) :: psi_l
+ real(kind=DP), intent(inout), dimension(nfft) :: bfft
+
+ integer :: i,i1,ri, j, i2, ii
+
+ bfft = 0.d0
+ if(k_symmetry(ik) == GAMMA) then
+ if(kimg == 1) then
+ i1 = igf_in(1)
+ bfft(i1) = psi_l(1,1,ik,1)
+#ifdef NEC_TUNE_SMP
+!CDIR NODEP
+#endif
+ do ii = 2, iba(ik)
+!!$ i = nbase(ii,1)
+ i = nbase(ii,ik)
+ i1 = igf_in(i)
+ bfft(i1) = psi_l(ii,1,ik,1)
+ j = nbase_gamma(ii,2)
+ i2 = igf_in(j)
+ bfft(i2) = psi_l(ii,1,ik,1)
+ end do
+ else if(kimg == 2) then
+ i1 = 2*igf_in(1) - 1
+ bfft(i1) = psi_l(1,1,ik,1)
+ bfft(i1+1) = psi_l(1,1,ik,2)
+#ifdef NEC_TUNE_SMP
+!CDIR NODEP
+#endif
+ do ii = 2, iba(ik)
+!!$ i = nbase(ii,1)
+ i = nbase(ii,ik)
+ i1 = 2*igf_in(i)-1
+ bfft(i1 ) = psi_l(ii,1,ik,1)
+ bfft(i1+1) = psi_l(ii,1,ik,2)
+ j = nbase_gamma(ii,2)
+ i2 = 2*igf_in(j)-1
+ bfft(i2 ) = psi_l(ii,1,ik,1)
+ bfft(i2+1) = -psi_l(ii,1,ik,2)
+ end do
+ end if
+ else
+#ifdef NEC_TUNE_SMP
+!CDIR NOLOOPCHG
+#endif
+ do ri = 1, kimg
+#ifdef NEC_TUNE_SMP
+!CDIR NODEP
+#endif
+ do i = 1, iba(ik)
+ i1 = kimg*igf_in(nbase(i,ik)) + (ri - kimg)
+ bfft(i1) = psi_l(i,1,ik,ri) ! MPI
+ end do
+ end do
+ end if
+ end subroutine m_Wan90_map_WF_on_fftmesh
+! ===== 2015/09/14
+
end module m_Wannier90
diff -uprN phase0_2015.01/src_phase/m_XC_Potential.F90 phase0_2015.01.01/src_phase/m_XC_Potential.F90
--- phase0_2015.01/src_phase/m_XC_Potential.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_XC_Potential.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 493 $)
!
! MODULE: m_XC_Potential
!
@@ -69,7 +69,7 @@
#define XC_PACK_FFT
module m_XC_Potential
-! $Id: m_XC_Potential.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: m_XC_Potential.F90 493 2016-06-01 04:57:01Z ktagami $
!
! Upgraded on 23rd Aug. 2006 by T. Yamasaki
! Differentials of the charge density function in GGA calculation are
@@ -92,7 +92,7 @@ module m_XC_Potential
use m_FFT, only : fft_box_size_CD, fft_box_size_CD_c, nfftp &
& , m_FFT_CD_inverse_c &
& , m_FFT_CD_direct_c &
- & , m_FFT_check_of_negative_CD
+ & , m_FFT_check_of_negative_CD, fft_box_size_CD_nonpara
#ifdef _MPIFFT_
use m_FFT, only : m_FFT_set_cdata &
& , lx,ly,lz,ly_d,lz_d, ny_d,nz_d
@@ -981,10 +981,12 @@ contains
Do iloop = 1, ndim_magmom
afft = 0.0d0
#ifdef _OLD_MAP_CHARGE_
- call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, Valence_Charge_Only )
+ call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, &
+ & Valence_Charge_Only )
!-(m_XC_Pot.) -> afft(*) (xcchg2)
#else
- call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, Valence_Charge_Only )
+ call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, &
+ & Valence_Charge_Only )
!-(m_XC_Pot.) -> afft(*) (xcchg2)
#endif
if(iprixc >= 2) write(nfout,*) " just after map_charge_onto_a_fft_box p1"
@@ -1013,7 +1015,8 @@ contains
allocate( quantz_axis_inversion_flg_mesh(ista_fftph:iend_fftph ) )
quantz_axis_inversion_flg_mesh = 0
- call m_ES_SpinDens_Along_QuantzAxis2( RhoMag_R, chgrhr_l,quantz_axis_inversion_flg_mesh, .false. )
+ call m_ES_SpinDens_Along_QuantzAxis2( RhoMag_R, chgrhr_l, &
+ & quantz_axis_inversion_flg_mesh, .false. )
end subroutine set_chgrhr_case_noncollinear3
@@ -1077,9 +1080,11 @@ contains
! ----
!
#ifdef _OLD_MAP_CHARGE_
- call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, Partial_Core_Charge )
+ call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, &
+ & Partial_Core_Charge )
#else
- call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, Partial_Core_Charge )
+ call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, &
+ & Partial_Core_Charge )
#endif
afft = bfft + afft / dble(nspin) ! nspin == 2
@@ -1180,10 +1185,13 @@ contains
! ----
!
#ifdef _OLD_MAP_CHARGE_
- call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, Partial_Core_Charge )
+ call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, &
+ & Partial_Core_Charge )
#else
- call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, Partial_Core_Charge )
+ call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, &
+ & Partial_Core_Charge )
#endif
+
afft = bfft + afft / dble(nspin) ! nspin == 2
end if
! --
@@ -1234,10 +1242,12 @@ contains
do iloop = 1, ndim_magmom
afft = 0.0d0
#ifdef _OLD_MAP_CHARGE_
- call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, Valence_Charge_Only )
+ call map_charge_onto_a_fft_box( chgq_l, ndim_magmom, iloop, &
+ & Valence_Charge_Only )
!-(m_XC_Pot.) -> afft(*) (xcchg2)
#else
- call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, Valence_Charge_Only )
+ call map_charge_onto_a_fft_box2( nfout, chgq_l, ndim_magmom, iloop, &
+ & Valence_Charge_Only )
!-(m_XC_Pot.) -> afft(*) (xcchg2)
#endif
if(iprixc >= 2) write(nfout,*) " just after map_charge_onto_a_fft_box p1"
@@ -1516,7 +1526,8 @@ contains
end if
end if
- if(xctype.eq.'vdwdf' .and. .not.oneshot) exc = exc + ecnl*univol*rinplw
+ if(xctype.eq.'vdwdf' .and. .not.oneshot) exc = exc + ecnl
+
if(iprixc >= 2) write(nfout,'(" !XC exc = ",f20.8)') exc
call tstatc0_end(id_sname)
@@ -1560,6 +1571,9 @@ contains
!!$ exc = exc_mpi
!!$ end if
+
+ if (xctype.eq.'vdwdf') exc = exc + ecnl
+
chgrhr_l = dF_drho
! stress tensor comes from gradient correction
@@ -1782,14 +1796,8 @@ contains
! ======================================================================= 11.0
subroutine ggaxcp0
- integer :: i, nfftcd,nfftx,nffty,nfftz,ix,iy,iz,ixyz
integer :: pot_type
- real(kind=DP),allocatable,dimension(:) :: chgrhr_red
- real(kind=DP),allocatable,dimension(:) :: grad_rho_red
- real(kind=DP),allocatable,dimension(:,:) :: dF_drho_red
- real(kind=DP),allocatable,dimension(:,:,:) :: dfdrho_vdw,dfddrho_vdw
-
! ==== KT_add ======== 13.0XX
real(kind=DP), allocatable :: dummy1(:,:), dummy2(:)
! ==================== 13.0XX
@@ -1924,44 +1932,8 @@ contains
grad_trho=0.d0
call cr_ggapbe (nspin,ispin,ista_fftph,iend_fftph,chgrhr_l,grad_trho,f2or1,exc,dF_drho,ecor)
endif
- if(.not.oneshot)then
- nfftx = fft_box_size_CD(1,1);nffty = fft_box_size_CD(2,1);nfftz = fft_box_size_CD(3,1)
- nfftcd = nfftx*nffty*nfftz
- allocate(dfdrho_vdw (nfftx,nffty,nfftz));dfdrho_vdw=0.d0
- allocate(dfddrho_vdw(nfftx,nffty,nfftz));dfddrho_vdw=0.d0
- allocate(chgrhr_red(nfftcd));chgrhr_red=0.0d0
- allocate(grad_rho_red(nfftcd));grad_rho_red=0.d0
- if(ispin==1)then
- do i=ista_fftph,iend_fftph
- chgrhr_red(i) = chgrhr_l(i,1)
- grad_rho_red(i) = grad_rho(i,1)
- enddo
- else
- do i=ista_fftph,iend_fftph
- chgrhr_red(i) = chgrhr_l(i,1)+chgrhr_l(i,2)
- grad_rho_red(i) = grad_rho(i,1)+grad_rho(i,2)
- enddo
- endif
- call mpi_allreduce(MPI_IN_PLACE,chgrhr_red,nfftcd,mpi_double_precision,mpi_sum,&
- & mpi_cdfft_world(myrank_ggacmp),ierr)
- call mpi_allreduce(MPI_IN_PLACE,grad_rho_red,nfftcd,mpi_double_precision,mpi_sum,&
- & mpi_cdfft_world(myrank_ggacmp),ierr)
- call vdW_scf(nspin,ispin,nfftx,nffty,nfftz,chgrhr_red,grad_rho_red,ecnl,dfdrho_vdw,dfddrho_vdw)
- do ix=1,nfftx
- do iy=1,nffty
- do iz=1,nfftz
- ixyz = (iz-1)*nffty*nfftx+(iy-1)*nfftx+ix
- if(ixyz<ista_fftph.or.ixyz>iend_fftph) cycle
- dF_drho(ixyz,1:ispin) = dF_drho(ixyz,1:ispin)+dfdrho_vdw(ix,iy,iz)
- dF_dgradrho(ixyz,1:ispin) = dF_dgradrho(ixyz,1:ispin)+dfddrho_vdw(ix,iy,iz)
- enddo
- enddo
- enddo
- deallocate(dfdrho_vdw)
- deallocate(dfddrho_vdw)
- deallocate(chgrhr_red)
- deallocate(grad_rho_red)
- endif
+ if (.not. oneshot ) call add_vdwdf_nonlocal_energy
+
#endif
else if(xctype == 'katopbe' .or. xctype == 'ggapbek') then
!!$ call ex_ggapbe (nspin,ispin,chgrhr_l,grad_rho,f2or1,exc,dF_drho,dF_dgradrho)
@@ -2033,6 +2005,97 @@ contains
end if
end subroutine ggaxcp0
+ subroutine add_vdwdf_nonlocal_energy
+ integer :: i, nfftcd,nfftx,nffty,nfftz,ix,iy,iz,ixyz
+ integer :: ix2, iy2, iz2, nlphf,idp, mmp
+
+ real(kind=DP),allocatable,dimension(:) :: chgrhr_red
+ real(kind=DP),allocatable,dimension(:) :: grad_rho_red
+ real(kind=DP),allocatable,dimension(:,:) :: dF_drho_red
+ real(kind=DP),allocatable,dimension(:,:,:) :: dfdrho_vdw,dfddrho_vdw
+
+ idp = fft_box_size_CD_nonpara(1,0)
+ mmp = fft_box_size_CD_nonpara(2,0)
+
+ nfftx = fft_box_size_CD(1,1)
+ nffty = fft_box_size_CD(2,1)
+ nfftz = fft_box_size_CD(3,1)
+ nfftcd = nfftx*nffty*nfftz
+
+ allocate(dfdrho_vdw (nfftx,nffty,nfftz));dfdrho_vdw=0.d0
+ allocate(dfddrho_vdw(nfftx,nffty,nfftz));dfddrho_vdw=0.d0
+ allocate(chgrhr_red(nfftcd));chgrhr_red=0.0d0
+ allocate(grad_rho_red(nfftcd));grad_rho_red=0.d0
+
+ if(ispin==1)then
+ do i=ista_fftph,iend_fftph
+ chgrhr_red(i) = chgrhr_l(i,1)
+ grad_rho_red(i) = grad_rho(i,1)
+ enddo
+ else
+ do i=ista_fftph,iend_fftph
+ chgrhr_red(i) = chgrhr_l(i,1) +chgrhr_l(i,2)
+ grad_rho_red(i) = grad_rho(i,1) +grad_rho(i,2)
+ enddo
+ endif
+ call mpi_allreduce( MPI_IN_PLACE, chgrhr_red, nfftcd, mpi_double_precision, &
+ & mpi_sum, mpi_cdfft_world(myrank_ggacmp), ierr )
+ call mpi_allreduce( MPI_IN_PLACE, grad_rho_red, nfftcd, mpi_double_precision,&
+ & mpi_sum, mpi_cdfft_world(myrank_ggacmp), ierr )
+ call vdW_scf( nspin, ispin, nfftx, nffty, nfftz, chgrhr_red, grad_rho_red, &
+ & ecnl, dfdrho_vdw, dfddrho_vdw )
+
+ if(kimg == 1) then
+ nlphf = idp/2
+ else
+ nlphf = idp
+ end if
+
+ if ( kimg == 1 ) then
+ do ix=1,nfftx
+ do iy=1,nffty
+ do iz=1,nfftz
+ if ( ix > nlphf ) then
+ ix2 = idp -ix
+ iy2 = nffty +2 -iy
+ iz2 = nfftz +2 -iz
+ if ( iy2 > nffty ) iy2 = iy2 -nffty
+ if ( iz2 > nfftz ) iz2 = iz2 -nfftz
+ cycle
+ else
+ ix2 = ix; iy2 = iy; iz2 = iz
+ endif
+ ixyz = (iz2-1)*mmp*nlphf +(iy2-1)*nlphf +ix2
+
+ if(ixyz<ista_fftph.or.ixyz>iend_fftph) cycle
+
+ dF_drho(ixyz,1:ispin) = dF_drho(ixyz,1:ispin) &
+ & +dfdrho_vdw(ix,iy,iz)
+ dF_dgradrho(ixyz,1:ispin) = dF_dgradrho(ixyz,1:ispin) &
+ & +dfddrho_vdw(ix,iy,iz)
+ enddo
+ enddo
+ enddo
+ else
+ do ix=1, nfftx
+ do iy=1,nffty
+ do iz=1,nfftz
+ ixyz = (iz-1)*nffty*nfftx +(iy-1)*nfftx +ix
+ if ( ixyz<ista_fftph .or. ixyz>iend_fftph ) cycle
+
+ dF_drho(ixyz,1:ispin) = dF_drho(ixyz,1:ispin) &
+ & +dfdrho_vdw(ix,iy,iz)
+ dF_dgradrho(ixyz,1:ispin) = dF_dgradrho(ixyz,1:ispin) &
+ & +dfddrho_vdw(ix,iy,iz)
+ enddo
+ enddo
+ enddo
+ endif
+
+ deallocate(dfdrho_vdw); deallocate(dfddrho_vdw)
+ deallocate(chgrhr_red); deallocate(grad_rho_red)
+ end subroutine add_vdwdf_nonlocal_energy
+
subroutine scale_exchange(alpha)
implicit none
real(kind=DP), intent(in) :: alpha
@@ -2179,10 +2242,12 @@ contains
do iloop = 1, ndim_magmom
afft = 0.0d0
#ifdef _OLD_MAP_CHARGE_
- call map_charge_onto_a_fft_box( chgsoft, ndim_magmom, iloop, Valence_Charge_Only )
+ call map_charge_onto_a_fft_box( chgsoft, ndim_magmom, iloop, &
+ & Valence_Charge_Only )
!-(m_XC_Pot.) -> afft(*) (xcchg2)
#else
- call map_charge_onto_a_fft_box2( nfout, chgsoft, ndim_magmom, iloop, Valence_Charge_Only )
+ call map_charge_onto_a_fft_box2( nfout, chgsoft, ndim_magmom, iloop, &
+ & Valence_Charge_Only )
!-(m_XC_Pot.) -> afft(*) (xcchg2)
#endif
! if(iprixc >= 2) write(nfout,*) " just after map_charge_onto_a_fft_box p1"
@@ -3274,7 +3339,8 @@ contains
end if
#else
do in = 1, 3
- call g_xyz_total_chden_l(in) ! G_xyz*(rho(G)up+rho(G)down) -> afft
+! call g_xyz_total_chden_l(in) ! G_xyz*(rho(G)up+rho(G)down) -> afft
+ call g_xyz_chden_l(in,1) ! G_xyz*(rho(G)up+rho(G)down) -> afft
call m_FFT_CD_inverse_c(nfout,afft)!(-i)*d(rho_total(r))/d(x|y|z)
call add_sq_afft_to_grad_trho
end do
@@ -3457,16 +3523,18 @@ contains
end do
end do
if(nrank_ggacmp > 1) then
- grad_rho_c2(:) = grad_rho(:,is)
+ Do is=1, 2
+ grad_rho_c2(:) = grad_rho(:,is)
#ifdef _DETAIL_GGA_TIMING_
- call tstatc0_begin('mpi_allreduce(ggaxcp) ',id_sname)
+ call tstatc0_begin('mpi_allreduce(ggaxcp) ',id_sname)
#endif
- call mpi_allreduce(grad_rho_c2,grad_rho_c4,iend_fftph-ista_fftph+1 &
- & ,mpi_double_precision, mpi_sum, mpi_ggacmp_cross_world(myrank_cdfft),ierr)
+ call mpi_allreduce(grad_rho_c2,grad_rho_c4,iend_fftph-ista_fftph+1 &
+ & ,mpi_double_precision, mpi_sum, mpi_ggacmp_cross_world(myrank_cdfft),ierr)
#ifdef _DETAIL_GGA_TIMING_
- call tstatc0_end(id_sname)
+ call tstatc0_end(id_sname)
#endif
- grad_rho(:,is) = grad_rho_c4(:)
+ grad_rho(:,is) = grad_rho_c4(:)
+ End Do
end if
end if
#endif
diff -uprN phase0_2015.01/src_phase/m_epc_potential.F90 phase0_2015.01.01/src_phase/m_epc_potential.F90
--- phase0_2015.01/src_phase/m_epc_potential.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_epc_potential.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_epc_potential
!
@@ -24,7 +24,7 @@
!
!
module m_epc_potential
-! $Id: m_epc_potential.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_epc_potential.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Electronic_Structure, only : vlhxc_l
!$$#ifndef PARA3D
use m_PlaneWaveBasisSet, only : ngabc,gr_l,igfp_l,igfp_nonpara,kg,kgp,kgp_reduced,ylm_l&
@@ -57,10 +57,19 @@ module m_epc_potential
& , nis_sfftp,nie_sfftp,nel_sfftp,idisp_sfftp,np_sfftp,mp_sfftp &
& , npes_cdfft
+! === Postitron SCF === 2015/11/28
+ use m_Control_Parameters, only : positron_method
+ use m_Const_Parameters, only : positron_CONV
+ use m_Charge_Density, only : chgq_l
+ use m_PseudoPotential, only : psc_l
+! ===================== 2015/11/28
+
implicit none
include 'mpif.h'
+ real(kind=DP), pointer :: vlhxc_p( :,:,: )
+
real(kind=DP), allocatable, dimension(:,:,:) :: tchgq_l ! d(ista_kngp:iend_kngp,kimg)
real(kind=DP), allocatable, dimension(:,:) :: tchgr_l ! d(ista_sfftph:iend_sfftph,nspin)
!!$ real(kind=DP), allocatable, dimension(:) :: p_potential_l ! d(ista_kngp:iend_kngp)
@@ -99,6 +108,16 @@ contains
integer :: np0, j0, i2, j2, k2, n0
#endif
+ if ( allocated(tchgq_l) ) deallocate( tchgq_l )
+ if ( allocated(tchgr_l) ) deallocate( tchgr_l )
+ if ( allocated( grad_tchgr_l ) ) deallocate( grad_tchgr_l )
+ if ( allocated( chden_l ) ) deallocate( chden_l )
+ if ( allocated( inx ) ) deallocate( inx )
+ if ( allocated( jnx ) ) deallocate( jnx )
+ if ( allocated( knx ) ) deallocate( knx )
+ if ( allocated( vepc_l ) ) deallocate( vepc_l )
+ if ( allocated( f2or1) ) deallocate( f2or1 )
+
allocate(tchgq_l(ista_kngp:iend_kngp,kimg,nspin)); tchgq_l = 0.d0
allocate(tchgr_l(ista_sfftph:iend_sfftph,nspin)); tchgr_l = 0.d0
if(sw_gga_p == ON) then
@@ -228,6 +247,7 @@ contains
!!$ tchgq_l(:,:,1) = tchgq_l(:,:,2)
!!$ end if
+ tchgq_l = 0.0d0
do ispin = 1, nspin
do j = 1, kimg
do i = ista_kngp, iend_kngp
@@ -674,7 +694,26 @@ contains
if(npes >= 2) call tstatc0_end(id_sname)
end subroutine afft_allgatherv
-subroutine m_epc_ESlhxc_potential(nfout)
+! ==== POSITRON SCF ===== 2015/11/28
+ subroutine m_epc_alloc_vlhxc_p
+ if ( positron_method == positron_CONV ) then
+ vlhxc_p => vlhxc_l
+ else
+ if ( .not. associated( vlhxc_p ) ) then
+ allocate( vlhxc_p(ista_kngp:iend_kngp,kimg,nspin) )
+ vlhxc_p = 0.0d0
+ endif
+ endif
+ end subroutine m_epc_alloc_vlhxc_p
+
+ subroutine m_epc_dealloc_vlhxc_p
+ if ( positron_method /= positron_CONV ) then
+ if ( associated( vlhxc_p ) ) deallocate( vlhxc_p )
+ endif
+ end subroutine m_epc_dealloc_vlhxc_p
+! ======================= 2015/11/28
+
+ subroutine m_epc_ESlhxc_potential(nfout)
integer, intent(in) :: nfout
! real(kind=DP), intent(in) :: chg(ista_kngp:iend_kngp,kimg,nspin)
! real(kind=DP), intent(in) :: vxc(ista_kngp:iend_kngp,kimg,nspin)
@@ -685,26 +724,26 @@ subroutine m_epc_ESlhxc_potential(nfout)
! call tstatc0_begin('m_ESlhxc_potential ',id_sname)
- vlhxc_l = 0.d0
+ vlhxc_p = 0.d0
ist = ista_kngp
if(ist == 1) ist = 2
do is = 1, nspin
do ik = 1, kimg
- if(mype==0) vlhxc_l(1,ik,is) = vepc_l(1,ik,is)
+ if(mype==0) vlhxc_p(1,ik,is) = vepc_l(1,ik,is)
if(nspin == 1) then
do i = ist, iend_kngp !for mpi
- vlhxc_l(i,ik,is) = vepc_l(i,ik,is) -PAI4*tchgq_l(i,ik,is)&
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) -PAI4*tchgq_l(i,ik,is)&
&/gr_l(i)**2
end do
else if(nspin == 2) then
do i = ist, iend_kngp !for mpi
- vlhxc_l(i,ik,is) = vepc_l(i,ik,is) -PAI4*(tchgq_l(i,ik,UP)&
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) -PAI4*(tchgq_l(i,ik,UP)&
&+tchgq_l(i,ik,DOWN))/gr_l(i)**2
end do
endif
! do it = 1,ntyp
! do i = ista_kngp, iend_kngp !for mpi
-! vlhxc_l(i,ik,is) ! & = vlhxc_l(i,ik,is)
+! vlhxc_p(i,ik,is) ! & = vlhxc_p(i,ik,is)
!+psc_l(i,it)*zfm3_l(i,it,ik)
! end do
! end do
@@ -712,17 +751,57 @@ subroutine m_epc_ESlhxc_potential(nfout)
end do
! call tstatc0_end(id_sname)
if(ipripositron >= 3) then
- write(nfout,'(" -- vepc_l tchgq_l vlhxc_l << m_epc_ESlhxc_potential>&
+ write(nfout,'(" -- vepc_l tchgq_l vlhxc_p << m_epc_ESlhxc_potential>&
&>")')
do is = 1, nspin
if(nspin == 2) write(nfout,'(" ispin = ",i5)') is
do ik = 1, kimg
do i = ist, min(ist+20,iend_kngp)
write(nfout,'(3f10.4)') vepc_l(i,ik,is),tchgq_l(i,ik,is)&
- &,vlhxc_l(i,ik,is)
+ &,vlhxc_p(i,ik,is)
end do
end do
end do
end if
end subroutine m_epc_ESlhxc_potential
+
+! ==== POSITRON SCF ===== 2015/11/28
+ subroutine m_epc_ESlhxc_potential_mod(nfout) ! for scf
+ integer, intent(in) :: nfout
+
+ integer :: is,ik,i,it
+ integer :: ist
+ integer :: id_sname = -1
+
+ vlhxc_p = 0.d0
+ ist = ista_kngp
+
+ if(ist == 1) ist = 2
+ do is = 1, nspin
+ do ik = 1, kimg
+ if(mype==0) vlhxc_p(1,ik,is) = vepc_l(1,ik,is)
+ if(nspin == 1) then
+ do i = ist, iend_kngp !for mpi
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) &
+ & -PAI4 *chgq_l(i,ik,is) /gr_l(i)**2
+ end do
+ else if(nspin == 2) then
+ do i = ist, iend_kngp !for mpi
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) &
+ & -PAI4*( chgq_l(i,ik,UP)&
+ & +chgq_l(i,ik,DOWN) )/gr_l(i)**2
+ end do
+ endif
+ do it = 1,ntyp
+ do i = ista_kngp, iend_kngp !for mpi
+ vlhxc_p(i,ik,is) = vlhxc_p(i,ik,is) &
+ & -psc_l(i,it) *zfm3_l(i,it,ik)
+ end do
+ end do
+ end do
+ end do
+
+ end subroutine m_epc_ESlhxc_potential_mod
+! ============== 2015/11/28
+
end module m_epc_potential
diff -uprN phase0_2015.01/src_phase/m_vdWDF.F90 phase0_2015.01.01/src_phase/m_vdWDF.F90
--- phase0_2015.01/src_phase/m_vdWDF.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/m_vdWDF.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 (rev.375)
+! PROGRAM PHASE/0 2014.01 (rev.375)
!
! "First-principles Electronic Structure Calculation Program"
!
@@ -29,7 +29,7 @@
! Consortium.
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
-
+!
!********************************** Note ******************************************
! This program calculates the non-local correlation energy (Ecnl) and
! the local correlation energy (EcLDA) as the post calculation by utilizing
@@ -47,7 +47,23 @@
! Periodic systems are assumed.
! The atomic units (Hartree) are used.
!
+! ======= modification =====
+!
+! 2016/06/06 : by asms
+! The FFT normalization parameters are changed in order to be consistent
+! with the other subroutines.
+!
+! rho(G) = 1/V *Int rho(r) exp(-iGr); rho(r) = sum_{G} rho(G) exp(iGr)
+!
+! In the dicretized grids, rho(G) = FFT[rho(r)] /(na*nb*nc);
+! rho(r) = FFT[rho(G)]
+!
+! By this, the nonlocal vdW energy is written as
+! Encl = V**2 /2 sum_{ij} sum_{G} conjg(theta(i,G))*phi(i,j,G)*theta(i,G)
+! and
+! phi(i,j,G) = 1/V Int phi(i,j,r) exp(-iGr)
!
+! =========================
!
! ++++++++ List of subroutines ++++++
! All subroutine files listed below are included in this file.
@@ -110,107 +126,106 @@
!**********************************************************************************
#ifndef DISABLE_VDWDF
module progress_bar
- implicit none
- logical,private :: printable = .false.
- integer,private :: iend=10
- integer,private :: uni=6
- integer,private :: j=0
- logical, dimension(0:9),private :: done
-
- contains
-
- subroutine set_printable(pri)
- logical, intent(in) :: pri
- printable = pri
- end subroutine set_printable
-
- subroutine reset_progress()
- j = 0
- done = .false.
- if(printable) write(unit=uni,fmt="(a10)") "0% 100%"
- end subroutine reset_progress
-
- subroutine set_unit(un)
- integer, intent(in) :: un
- uni = un
- end subroutine set_unit
-
- subroutine set_end(en)
- integer, intent(in) :: en
- iend = en
- end subroutine set_end
-
- subroutine progress()
- use m_Const_Parameters, only : DP
- implicit none
- integer(kind=4)::k
- character(len=17)::bar="???% | |"
- integer :: jj
- real(kind=DP) :: jjj
- j = j+1
- if(j.gt.iend) j=iend
- jj = int(10*(dble(j)/dble(iend))*0.999999d0)
- if(.not.done(jj).and.j<=iend) then
- if(printable) write(unit=uni,fmt="(a1,$)") '*'
- call flush(uni)
- done(jj) = .true.
- endif
- if(j==iend.and.printable) write(unit=uni,fmt=*)
-! jjj = (dble(j)/dble(iend))
-! write(unit=bar(1:3),fmt="(i3)") int(100*jjj)
-! do k=1, jj
-! bar(6+k:6+k)="*"
-! enddo
-! ! print the progress bar.
-! write(unit=uni,fmt="(a1,a17,$)") char(13), bar
-!! write(unit=uni,fmt="(a1,a17)") char(13), bar
-! if (j/=iend) then
-! flush(unit=6)
-! else
-! write(unit=6,fmt=*)
-! do k=1,jj
-! bar(6+k:6+k) = ""
-! enddo
-! endif
- return
- end subroutine progress
+ implicit none
+ logical,private :: printable = .false.
+ integer,private :: iend=10
+ integer,private :: uni=6
+ integer,private :: j=0
+ logical, dimension(0:9),private :: done
+
+contains
+
+ subroutine set_printable(pri)
+ logical, intent(in) :: pri
+ printable = pri
+ end subroutine set_printable
+
+ subroutine reset_progress()
+ j = 0
+ done = .false.
+ if(printable) write(unit=uni,fmt="(a10)") "0% 100%"
+ end subroutine reset_progress
+
+ subroutine set_unit(un)
+ integer, intent(in) :: un
+ uni = un
+ end subroutine set_unit
+
+ subroutine set_end(en)
+ integer, intent(in) :: en
+ iend = en
+ end subroutine set_end
+
+ subroutine progress()
+ use m_Const_Parameters, only : DP
+ implicit none
+ integer(kind=4)::k
+ character(len=17)::bar="???% | |"
+ integer :: jj
+ real(kind=DP) :: jjj
+ j = j+1
+ if(j.gt.iend) j=iend
+ jj = int(10*(dble(j)/dble(iend))*0.999999d0)
+ if(.not.done(jj).and.j<=iend) then
+ if(printable) write(unit=uni,fmt="(a1,$)") '*'
+ call flush(uni)
+ done(jj) = .true.
+ endif
+ if(j==iend.and.printable) write(unit=uni,fmt=*)
+ ! jjj = (dble(j)/dble(iend))
+ ! write(unit=bar(1:3),fmt="(i3)") int(100*jjj)
+ ! do k=1, jj
+ ! bar(6+k:6+k)="*"
+ ! enddo
+ ! ! print the progress bar.
+ ! write(unit=uni,fmt="(a1,a17,$)") char(13), bar
+ !! write(unit=uni,fmt="(a1,a17)") char(13), bar
+ ! if (j/=iend) then
+ ! flush(unit=6)
+ ! else
+ ! write(unit=6,fmt=*)
+ ! do k=1,jj
+ ! bar(6+k:6+k) = ""
+ ! enddo
+ ! endif
+ return
+ end subroutine progress
end module progress_bar
module m_vdWDF
-
- use m_Const_Parameters, only : DP, ON, PAI, FMAXVALLEN, LOWER
- use m_Control_Parameters, only : printable,nspin,eval_kernel_by_interpolation,na_gl &
- & , a1,a2,dq_vdw,lambda,q0cut,ds,ndel,nphiD,nr12,nk,maxk &
- & , r12max,oneshot
+ use m_Const_Parameters, only : DP, ON, PAI, FMAXVALLEN, LOWER, CMPLDP
+ use m_Control_Parameters, only : printable,nspin,eval_kernel_by_interpolation, &
+ & na_gl,a1,a2,dq_vdw,lambda,q0cut,ds,ndel,nphiD, &
+ & nr12,nk,maxk, r12max,oneshot, ipri, &
+ & sw_save_memory_vdw, kimg, iprixc
use m_Files, only : nfout
use m_Charge_Density, only : m_CD_get_rspace_charge
use m_FFT, only : fft_box_size_CD,fft_box_size_CD_nonpara
- use m_Crystal_Structure, only : altv,univol
-
- use m_Parallelization, only : npes,mype,mpi_comm_group
+ use m_Crystal_Structure, only : altv,univol, rltv
+ use m_Parallelization, only : npes,mype,mpi_comm_group,m_Parallel_init_mpi_nq, &
+ & ista_nq,iend_nq,np_nq,mp_nq,is_nq,ie_nq,nel_nq, &
+ & map_z_nq
use m_Timing, only : tstatc0_begin,tstatc0_end
implicit none
-
include 'mpif.h'
real(kind=DP),parameter :: pi=PAI
-! Physical values
+ ! Physical values
Real(kind=DP) ExGGA,Ecnl,Ecnl_12,Ecnl_12_ab,Ecnl_3,Ecnl_3s,EcLDA
- Integer na,nb,nc,nabc
- Real(kind=DP) aa(3,3),dv
- Real(kind=DP), Allocatable :: rho(:,:,:),grad(:,:,:)
-
real(kind=DP) :: phi0=2.77d0
-
+
+ Integer na,nb,nc,nabc
+ Real(kind=DP) :: aa(3,3),dv
+ Real(kind=DP), Allocatable :: rho(:,:,:),grad(:,:,:), cgrad(:,:,:,:)
real(kind=DP),allocatable,dimension(:) :: phi_ab
-! Grid points
+ ! Grid points
!!!! Spline curves
Integer nq0
real(kind=DP) :: qa,qb,q0max,q0min
@@ -218,12 +233,12 @@ module m_vdWDF
!!!! The table of phidD
real(kind=DP), allocatable, dimension(:,:) :: phidD
-! Internal parameters
+ ! Internal parameters
Real(kind=DP),parameter :: rhomin=1.d-9
-! Real-space and reciprocal-space Functions
+ ! Real-space and reciprocal-space Functions
Complex*16, Allocatable :: theta_G(:,:,:), &
-& theta_G_ab(:,:,:,:),theta_G_a(:,:,:),theta_G_b(:,:,:)
+ & theta_G_ab(:,:,:,:),theta_G_a(:,:,:),theta_G_b(:,:,:)
Real(kind=DP), Allocatable :: theta_R(:,:,:),dtheta_R(:,:,:,:),ddtheta_R(:,:,:,:)
complex(kind=DP), allocatable, dimension(:,:,:,:) :: ualpha_g,ualpha_r
@@ -239,51 +254,97 @@ module m_vdWDF
integer, parameter :: FFTW_ESTIMATE = 64
integer, parameter :: FFTW_FORWARD = -1
integer, parameter :: FFTW_BACKWARD = +1
- contains
+
+ real(kind=DP), allocatable, dimension(:,:,:) :: dFdrho, dFddrho
+ real(kind=DP), allocatable, dimension(:,:,:) :: rkar
+
+ real(kind=DP) :: s_cnl1(3,3), s_cnl2(3,3), ecnl_vdwdf
+ real(kind=DP) :: s_cnl1_pc(3,3), s_cnl2_pc(3,3)
+
+ ! logical :: grad_rho_eq_0 = .true.
+ logical :: grad_rho_eq_0 = .false.
+
+contains
subroutine print_vdw_parameters()
if(printable)then
- write(nfout,'(a)') '-- parameters for the vdW-DF calculations --'
- write(nfout,'(a,2f15.10,i8)') ' rmax, kmax, nmesh : ',r12max,maxk,nr12
- write(nfout,'(a,3f15.10)') ' dq, lambda, and q0cut : ',dq_vdw,lambda,q0cut
- write(nfout,'(a,2f15.10,i5)') ' q0min, q0max, nq0 : ',q0min,q0max,nq0
- write(nfout,'(a,f15.10)' ) ' ds : ',ds
- write(nfout,'(a,i5,2f15.10)') ' na_gl, a1, a2 : ',na_gl,a1,a2
- if(eval_kernel_by_interpolation)then
- write(nfout,'(a)') ' kernel evaluation : by interpolation'
- write(nfout,'(a,2i8)') ' ndel, nphiD : ',ndel,nphiD
- else
- write(nfout,'(a)') ' kernel evaluation : direct'
- endif
+ write(nfout,'(a)') '-- parameters for the vdW-DF calculations --'
+ write(nfout,'(a,2f15.10,i8)') ' rmax, kmax, nmesh : ',r12max,maxk,nr12
+ write(nfout,'(a,3f15.10)') ' dq, lambda, and q0cut : ',dq_vdw,lambda,q0cut
+ write(nfout,'(a,2f15.10,i5)') ' q0min, q0max, nq0 : ',q0min,q0max,nq0
+ write(nfout,'(a,f15.10)' ) ' ds : ',ds
+ write(nfout,'(a,i5,2f15.10)') ' na_gl, a1, a2 : ',na_gl,a1,a2
+ if(eval_kernel_by_interpolation)then
+ write(nfout,'(a)') ' kernel evaluation : by interpolation'
+ write(nfout,'(a,2i8)') ' ndel, nphiD : ',ndel,nphiD
+ else
+ write(nfout,'(a)') ' kernel evaluation : direct'
+ endif
endif
end subroutine print_vdw_parameters
subroutine initialize_vdwdf_scf(nspin,ispin,na,nb,nc,chgr,grad_rho)
use progress_bar, only : set_printable
+
integer, intent(in) :: nspin,ispin,na,nb,nc
real(kind=DP), dimension(na*nb*nc), intent(in) :: chgr,grad_rho
+
integer :: i,cix,ciy,ciz,nrxyz
+ integer :: idp, mmp, nlphf, cix2, ciy2, ciz2
real(kind=DP) :: q
- call set_printable(printable)
+ call set_printable(printable)
call do_cell_params()
+
+ idp = fft_box_size_CD_nonpara(1,0)
+ mmp = fft_box_size_CD_nonpara(2,0)
+
+ if(kimg == 1) then
+ nlphf = idp/2
+ else
+ nlphf = idp
+ end if
+
rinplw = 1.d0/(dble(na*nb*nc))
q0max = q0cut*1.01d0
q0min = 0.09d0
nq0 = DINT(dLOG((q0max-q0min)*(lambda-1.d0)/dq_vdw+1.d0)/dLOG(lambda))+1
maxk = dble(nr12)/r12max
+ if(firstcall) call m_Parallel_init_mpi_nq(nfout,ipri,printable,nq0)
if(firstcall) call print_vdw_parameters()
call alloc_vdw()
- do cix = 1,na
- do ciy = 1,nb
- do ciz = 1,nc
- nrxyz=(ciz-1)*nb*na+(ciy-1)*na+cix
- rho(cix,ciy,ciz) = chgr(nrxyz)
- grad(cix,ciy,ciz) = grad_rho(nrxyz)
+
+ if ( kimg == 1 ) then
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ if ( cix > nlphf ) then
+ cix2 = idp -cix
+ ciy2 = nb +2 -ciy
+ ciz2 = nc +2 -ciz
+ if ( ciy2 > nb ) ciy2 = ciy2 -nb
+ if ( ciz2 > nc ) ciz2 = ciz2 -nc
+ else
+ cix2 = cix; ciy2 = ciy; ciz2 = ciz
+ endif
+ nrxyz=(ciz2-1)*mmp*nlphf +(ciy2-1)*nlphf +cix2
+ rho(cix,ciy,ciz) = chgr(nrxyz)
+ grad(cix,ciy,ciz) = grad_rho(nrxyz)
+ end do
+ end do
+ end do
+ else
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ nrxyz = (ciz-1)*nb*na +(ciy-1)*na +cix
+ rho(cix,ciy,ciz) = chgr(nrxyz)
+ grad(cix,ciy,ciz) = grad_rho(nrxyz)
+ end do
end do
end do
- end do
+ endif
do i=1,nq0
q = q0min + dq_vdw*(lambda**DBLE(i-1)-1.d0)/(lambda-1.d0)
@@ -291,7 +352,9 @@ module m_vdWDF
enddo
call spline0(nq0,qar,q2ar)
- if(eval_kernel_by_interpolation.and.firstcall) call build_lookup_table(ndel,nphiD,phidD)
+ if (eval_kernel_by_interpolation.and.firstcall) then
+ call build_lookup_table(ndel,nphiD,phidD)
+ endif
firstcall = .false.
end subroutine initialize_vdwdf_scf
@@ -310,6 +373,7 @@ module m_vdWDF
q0min = 0.09d0
nq0 = DINT(dLOG((q0max-q0min)*(lambda-1.d0)/dq_vdw+1.d0)/dLOG(lambda))+1
maxk = dble(nr12)/r12max
+ if(firstcall) call m_Parallel_init_mpi_nq(nfout,ipri,printable,nq0)
call alloc_vdw()
call m_CD_get_rspace_charge(nfout,na,nb,nc,rho,is)
@@ -324,9 +388,9 @@ module m_vdWDF
call spline0(nq0,qar,q2ar)
if(eval_kernel_by_interpolation)then
- if(printable) write(nfout,'(a)') 'building the lookup table for the kernel function ...'
- call build_lookup_table(ndel,nphiD,phidD)
- if(printable) write(nfout,'(a)') '... done'
+ if(printable) write(nfout,'(a)') 'building the lookup table for the kernel function ...'
+ call build_lookup_table(ndel,nphiD,phidD)
+ if(printable) write(nfout,'(a)') '... done'
endif
if(printable) write(nfout,'(a)') '... done initialization'
@@ -341,18 +405,42 @@ module m_vdWDF
aa(i,1:3) = altv(1:3,i)/dble(fft_box_size_CD(i,1))
enddo
dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
-& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
-& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
+ & + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
+ & + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
end subroutine do_cell_params
+ function real_index(iq,pe) result(res)
+ integer, intent(in) :: iq
+ integer, intent(in),optional :: pe
+ integer :: res
+ integer :: ii,mpe
+ mpe = mype
+ if(present(pe))then
+ mpe = pe
+ endif
+ if(mpe==0)then
+ res = iq
+ return
+ endif
+ res = 0
+ do ii=0,mpe-1
+ res = res+nel_nq(ii)
+ enddo
+ res = res+iq
+ return
+ end function real_index
+
subroutine alloc_vdw()
+ integer :: i,cix,ciy,ciz
+ real(kind=DP) :: Ta,Tb,Tc, vec(3), bb(3,3)
+
Allocate(rho(na,nb,nc));rho=0.d0
allocate(grad(na,nb,nc));grad=0.d0
Allocate(theta_G(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
Allocate(theta_R(na,nb,nc))
if(.not.oneshot)then
- Allocate(dtheta_R(nq0,na,nb,nc))
- Allocate(ddtheta_R(nq0,na,nb,nc))
+ Allocate(dtheta_R(np_nq,na,nb,nc))
+ Allocate(ddtheta_R(np_nq,na,nb,nc))
endif
Allocate(theta_G_a(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
Allocate(theta_G_b(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
@@ -360,17 +448,57 @@ module m_vdWDF
if(eval_kernel_by_interpolation.and.firstcall) allocate(phidD(0:ndel,-1:nphiD+1))
allocate(qar(nq0));qar = 0.d0
allocate(q2ar(nq0,nq0));q2ar = 0.d0
- allocate(theta_G_ab(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ ! allocate(theta_G_ab(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ if(sw_save_memory_vdw) then
+ allocate(theta_G_ab(np_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ else
+ allocate(theta_G_ab(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ endif
if(.not.oneshot)then
- allocate(ualpha_g(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
- allocate(ualpha_r(nq0,na,nb,nc))
+ ! allocate(ualpha_g(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ ! allocate(ualpha_r(nq0,na,nb,nc))
+ allocate(dFdrho(na,nb,nc))
+ allocate(dFddrho(na,nb,nc))
endif
+
+ allocate(rkar(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+
+#if 0
+ Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
+ Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
+ Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ rkar(cix,ciy,ciz) = &
+ & DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
+ Enddo
+ Enddo
+ Enddo
+#else
+ Do i=1, 3
+ bb(1,i) = rltv(i,1) /PAI /2.0d0
+ bb(2,i) = rltv(i,2) /PAI /2.0d0
+ bb(3,i) = rltv(i,3) /PAI /2.0d0
+ End Do
+
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ vec(1:3) = dble(cix) *bb(1,1:3) &
+ & +dble(ciy) *bb(2,1:3) &
+ & +dble(ciz) *bb(3,1:3)
+ rkar(cix,ciy,ciz) = DSQRT( vec(1)**2 +vec(2)**2 +vec(3)**2 )
+ End Do
+ End Do
+ End Do
+#endif
end subroutine alloc_vdw
subroutine finalize_vdwdf()
call dealloc()
- contains
+ contains
subroutine dealloc()
deallocate(rho)
deallocate(grad)
@@ -388,9 +516,14 @@ module m_vdWDF
deallocate(q2ar)
deallocate(theta_G_ab)
if(.not.oneshot)then
- deallocate(ualpha_g)
- deallocate(ualpha_r)
+ ! deallocate(ualpha_g)
+ ! deallocate(ualpha_r)
+ deallocate(dFdrho)
+ deallocate(dFddrho)
endif
+ deallocate(rkar)
+ !
+ if ( allocated( cgrad ) ) deallocate( cgrad )
end subroutine dealloc
end subroutine finalize_vdwdf
@@ -404,28 +537,32 @@ module m_vdWDF
real(kind=DP) :: ddel,dphiD
integer :: ierr
integer :: id_sname=-1
+
call tstatc0_begin('build_lookup_table ',id_sname,1)
+
phidD = 0.d0
- ddel = 1/dble(ndel)
+ ddel = 1.d0 /dble(ndel)
dphiD = (q0max*eta1-q0min*etai)/(dble(nphiD))
+
if(oneshot) then
call reset_progress()
call set_end(int(floor(dble(ndel+1)/dble(npes))))
endif
+
do cdel=0,ndel
if(mod(cdel,npes)/=mype) cycle
if(oneshot) call progress()
do cphiD = -1,nphiD+1
del = dble(cdel)*ddel
phiD = q0min*etai + dble(cphiD)*dphiD
- di = phiD*(1+del)
- dk = phiD*(1-del)
+ di = phiD*(1.d0+del)
+ dk = phiD*(1.d0-del)
Call kernel_phi(di,dk,tmp)
phidD(cdel,cphiD) = tmp
enddo
enddo
if(npes>1) &
- & call mpi_allreduce(MPI_IN_PLACE,phidD,(ndel+1)*(nphiD+2),mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ & call mpi_allreduce(MPI_IN_PLACE,phidD,(ndel+1)*(nphiD+2),mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
call tstatc0_end(id_sname)
end subroutine build_lookup_table
@@ -434,15 +571,18 @@ module m_vdWDF
integer :: cqa,ierr
integer :: id_sname = -1
real(kind=DP),allocatable,dimension(:,:,:) :: tmpdr,tmpddr
+
call tstatc0_begin('build_theta ',id_sname,1)
-!+++++++++++++++ Execute FFT for theta_R_ab ++++++++++++++++++++
+
+ !+++++++++++++++ Execute FFT for theta_R_ab ++++++++++++++++++++
if(printable.and.oneshot) &
- & write(nfout,'(a)') 'building theta (spline coefficient x rho) and their Fourier transforms ...'
+ & write(nfout,'(a)') 'building theta (spline coefficient x rho) and their Fourier transforms ...'
if(oneshot)then
call reset_progress()
call set_end(int(floor(dble(nq0)/dble(npes))))
endif
theta_G_ab(:,:,:,:) = (0.d0,0.d0)
+
if(.not.oneshot)then
allocate(tmpdr(na,nb,nc));tmpdr=0.d0
allocate(tmpddr(na,nb,nc));tmpddr=0.d0
@@ -451,32 +591,31 @@ module m_vdWDF
allocate(tmpdr(1,1,1))
allocate(tmpddr(1,1,1))
endif
- Do cqa = 1,nq0
- if(mod(cqa,npes)/=mype) cycle
+ Do cqa = ista_nq,iend_nq
if(oneshot) call progress()
Call theta_ab(na,nb,nc,cqa,nq0,q0min,q0max,rho,grad,rhomin,theta_R,tmpdr,tmpddr)
Call RtoG(na,nb,nc,theta_R,theta_G)
- theta_G_ab(cqa,:,:,:) = theta_G(:,:,:)
+ if(sw_save_memory_vdw)then
+ theta_G_ab(map_z_nq(cqa),:,:,:) = theta_G(:,:,:)
+ else
+ theta_G_ab(cqa,:,:,:) = theta_G(:,:,:)
+ endif
if(.not.oneshot)then
- dtheta_R (cqa,:,:,:) = tmpdr (:,:,:)
- ddtheta_R (cqa,:,:,:) = tmpddr (:,:,:)
+ dtheta_R (map_z_nq(cqa),:,:,:) = tmpdr (:,:,:)
+ ddtheta_R (map_z_nq(cqa),:,:,:) = tmpddr (:,:,:)
endif
Enddo
+
+ if(.not.sw_save_memory_vdw)then
+ call mpi_allreduce(MPI_IN_PLACE,theta_G_ab,nq0*na*nb*nc,mpi_double_complex, &
+ & mpi_sum,mpi_comm_group,ierr)
+ endif
deallocate(tmpdr)
deallocate(tmpddr)
- if(npes>1) then
- call mpi_allreduce(MPI_IN_PLACE,theta_G_ab(1,-(na/2-1),-(nb/2-1),-(nc/2-1)), &
- & nq0*na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
- if(.not.oneshot)then
- call mpi_allreduce(MPI_IN_PLACE,dtheta_R(1,1,1,1), &
- & nq0*na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
- call mpi_allreduce(MPI_IN_PLACE,ddtheta_R(1,1,1,1), &
- & nq0*na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
- endif
- endif
+
if(printable.and.oneshot) write(nfout,'(a)') '... done'
call tstatc0_end(id_sname)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
end subroutine build_theta
subroutine phiab_by_interpl(ca,cb,nr12,phi_ab)
@@ -493,6 +632,7 @@ module m_vdWDF
real(kind=DP) :: phi1u
integer :: id_sname=-1
+
call tstatc0_begin('phiab ',id_sname,1)
phi_ab = 0.d0
@@ -501,8 +641,8 @@ module m_vdWDF
qb = qar(cb)
qab = DSQRT(qa**2+qb**2)
-! Coefficients phi2 and phi4 in the local part is determined to
-! match the non-local part in value and slope at d=d_s.
+ ! Coefficients phi2 and phi4 in the local part is determined to
+ ! match the non-local part in value and slope at d=d_s.
rs = ds/qab
@@ -520,7 +660,7 @@ module m_vdWDF
phi4 = (-1.d0/ds**4)*(phid_s-phi0) + (rs/(2.d0*ds**4))*d_phid_s
i = DINT((ds/qab)/dr12)
-! Non-local part of phi_ab(r12)
+ ! Non-local part of phi_ab(r12)
if(i.ge.nr12)return
ddel = 1/dble(ndel)
do cr12 = i+1,nr12
@@ -533,18 +673,18 @@ module m_vdWDF
phiD = 0.5d0*(di+dk)
cdel = DINT(del/ddel)
cphiD = DINT(DBLE(nphiD)*(phiD-q0min*etai)/(q0max*eta1-q0min*etai))
-! write(6,*) 'cdel, cphiD: ',cdel,cphiD
+ ! write(6,*) 'cdel, cphiD: ',cdel,cphiD
if(cdel.ge.ndel.or.cphiD.ge.nphiD.or.cdel.lt.0.or.cphiD.lt.-1)cycle
phix = del/ddel - dble(cdel)
phiy = dble(nphiD)*(phiD-q0min*etai)/(q0max*eta1-q0min*etai) - dble(cphiD)
- phi1u = (1-phix)*(1-phiy) * phidD(cdel ,cphiD ) &
-& + phix *(1-phiy) * phidD(cdel+1,cphiD ) &
-& +(1-phix)* phiy * phidD(cdel ,cphiD+1) &
-& + phix * phiy * phidD(cdel+1,cphiD+1)
+ phi1u = (1.d0-phix)*(1.d0-phiy) * phidD(cdel ,cphiD ) &
+ & + phix *(1.d0-phiy) * phidD(cdel+1,cphiD ) &
+ & +(1.d0-phix)* phiy * phidD(cdel ,cphiD+1) &
+ & + phix * phiy * phidD(cdel+1,cphiD+1)
phi_ab(cr12) = phi1u
enddo
-! Local part of phi_ab(r12)
+ ! Local part of phi_ab(r12)
Do cr12 = 0,i
r12 = DBLE(cr12)*dr12
@@ -556,20 +696,20 @@ module m_vdWDF
call tstatc0_end(id_sname)
end subroutine phiab_by_interpl
-!** SUBROUTINE phiab **************************************************************************
+ !** SUBROUTINE phiab **************************************************************************
Subroutine phiab(ca,cb,nr12,phi_ab)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer,intent(in) :: ca,cb,nr12
Real(kind=DP),intent(out) :: phi_ab(0:nr12)
-! Internal valuables
+ ! Internal valuables
Integer cr12,i
Real(kind=DP) qab,qa,qb,r12,rs,phiD,dr12,phi2,phi4,phid_s,phid_s1,d_phid_s,d1,d2,abs_d
Real(kind=DP) di,dk,tmp,dr
Parameter(dr=0.001d0)
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
integer :: id_sname=-1
call tstatc0_begin('phiab ',id_sname,1)
@@ -577,9 +717,9 @@ module m_vdWDF
qa = qar(ca)
qb = qar(cb)
qab = DSQRT(qa**2+qb**2)
-
-! Coefficients phi2 and phi4 in the local part is determined to
-! match the non-local part in value and slope at d=d_s.
+
+ ! Coefficients phi2 and phi4 in the local part is determined to
+ ! match the non-local part in value and slope at d=d_s.
rs = ds/qab
@@ -590,159 +730,439 @@ module m_vdWDF
di = qa*(rs+dr)
dk = qb*(rs+dr)
Call kernel_phi(di,dk,phid_s1)
-
+
d_phid_s = (phid_s1 - phid_s)/dr
-
+
phi2 = ( 2.d0/ds**2)*(phid_s-phi0) - (rs/(2.d0*ds**2))*d_phid_s
phi4 = (-1.d0/ds**4)*(phid_s-phi0) + (rs/(2.d0*ds**4))*d_phid_s
i = DINT((ds/qab)/dr12)
-! Non-local part of phi_ab(r12)
+ ! Non-local part of phi_ab(r12)
if(i.ge.nr12)return
+
Do cr12 = i+1,nr12
r12 = DBLE(cr12)*dr12
-
+
di = qa*r12
dk = qb*r12
-
+
Call kernel_phi(di,dk,tmp)
phi_ab(cr12) = tmp
-
+
Enddo
-
-! Local part of phi_ab(r12)
+
+ ! Local part of phi_ab(r12)
Do cr12 = 0,i
r12 = DBLE(cr12)*dr12
-
+
d1 = qa*r12
d2 = qb*r12
phiD = qab*r12
phi_ab(cr12) = phi0 + phi2*phiD**2 + phi4*phiD**4
Enddo
-
+
call tstatc0_end(id_sname)
End subroutine phiab
-!** End SUBROUTINE phiab **********************************************************************
+ !** End SUBROUTINE phiab **********************************************************************
- subroutine vdWdf_core()
+ subroutine vdWdf()
+ if(sw_save_memory_vdw) then
+ call vdWdf_core()
+ !call vdWdf_core2()
+ else
+ call vdWdf_core_org()
+ endif
+ end subroutine vdWdf
+
+ subroutine vdWdf_core_org()
use progress_bar
real(kind=DP) :: fac
- integer :: cqa,cqb,ierr
- integer,allocatable,dimension(:,:) :: ind
- integer :: i,ic,i1,i2,i3
+ integer :: cqaa,cqa,cqb,ierr
+ integer :: i,ic,i2,i3
complex(kind=DP), allocatable, dimension(:,:,:) :: tmpug,tmpur
integer :: id_sname = -1
+ integer :: id_sname3 = -1
+
call tstatc0_begin('vdWdf_core ',id_sname,1)
Ecnl_12 = 0.0d0
if(printable.and.oneshot) &
- & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
- allocate(ind(int(nq0*(nq0-1)*0.5+nq0),2));ind=0
- ic=0
-! do cqa=1,nq0
-! do cqb=cqa,nq0
-! ic=ic+1
-! ind(ic,1) = cqa
-! ind(ic,2) = cqb
-! enddo
-! enddo
+ & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
if(oneshot)then
call reset_progress()
- !call set_end(int(floor(dble(ic)/dble(npes))))
call set_end(int(floor(dble(nq0)/dble(npes))))
endif
if(.not.oneshot)then
allocate(tmpug(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));tmpug=0.d0
- ualpha_g = (0.d0,0.d0)
+ allocate(tmpur(na,nb,nc));tmpur=0.d0
+ ! ualpha_g = (0.d0,0.d0)
else
allocate(tmpug(1,1,1))
endif
-! do i=1,ic
- do cqa=1,nq0
- if(mod(cqa,npes)/=mype) cycle
- theta_G_a(:,:,:) = theta_G_ab(cqa,:,:,:)
- if(.not.oneshot) tmpug=(0.d0,0.d0)
- if(oneshot) call progress()
-! do cqb=cqa,nq0
- do cqb=1,nq0
- !cqa = ind(i,1)
- !cqb = ind(i,2)
- theta_G_b(:,:,:) = theta_G_ab(cqb,:,:,:)
-! fac=2.d0
-! if (cqa.eq.cqb) fac=1.d0
- fac = 1.d0
- if(eval_kernel_by_interpolation) then
- call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
- else
- Call phiab(cqa,cqb,nr12,phi_ab)
+ if(.not.oneshot)then
+ dFdrho=0.d0;dFddrho=0.d0
+ endif
+
+ do cqaa=1,np_nq
+ cqa = real_index(cqaa)
+ theta_G_a(:,:,:) = theta_G_ab(cqa,:,:,:)
+ if (.not.oneshot) tmpug=(0.d0,0.d0)
+ if (oneshot) call progress()
+ call tstatc0_begin('vdw_core_core ',id_sname3,1)
+ do cqb=1,nq0
+ theta_G_b(:,:,:) = theta_G_ab(cqb,:,:,:)
+ fac = 1.d0
+ if(eval_kernel_by_interpolation) then
+ call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
+ else
+ Call phiab(cqa,cqb,nr12,phi_ab)
+ endif
+ Call convolution_3d_by_fft(&
+ & na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
+ Ecnl_12 = Ecnl_12 + Ecnl_12_ab
+ enddo
+ call tstatc0_end(id_sname3)
+ if(.not.oneshot)then
+ call GtoR(na,nb,nc,tmpur,tmpug)
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(cqaa,:,:,:)
+ dFddrho(:,:,:) = dFddrho(:,:,:) + dble(tmpur(:,:,:))*ddtheta_R(cqaa,:,:,:)
endif
- Call convolution_3d_by_fft(na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
-
- Ecnl_12 = Ecnl_12 + Ecnl_12_ab
- enddo
- if(.not.oneshot) ualpha_g(cqa,:,:,:) = tmpug(:,:,:)
enddo
if(.not.oneshot)then
- if(npes>1) &
- & call mpi_allreduce(MPI_IN_PLACE,ualpha_g, &
- & nq0*na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,dFdrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,dFddrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ deallocate(tmpur)
+ endif
+ deallocate(tmpug)
+ endif
+
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,Ecnl_12,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ endif
+ if(printable.and.oneshot) write(nfout,'(a)') '... done'
+ call tstatc0_end(id_sname)
+
+ end subroutine vdWdf_core_org
+
+ subroutine vdWdf_core()
+ use progress_bar
+ real(kind=DP) :: fac, grho, rtmp, esum
+ integer :: cqaa,cqa,cqb,ierr
+ integer :: i,ic,i2,i3, cix, ciy ,ciz
+ complex(kind=DP), allocatable, dimension(:,:,:) :: tmpug,tmpur
+ complex(kind=DP), allocatable, dimension(:,:,:,:) :: theta_buf_s,theta_buf_r
+ integer :: ipos,i0,i1,isend,irecv,ireq,ireqr
+ integer, allocatable, dimension(:) :: ista
+ integer :: id_sname = -1, id_sname2 = -1, id_sname3 = -1
+
+ Ecnl_12 = 0.0d0
+ esum = 0.0d0
+
+ call tstatc0_begin('vdWdf_core ',id_sname,1)
+ if(printable.and.oneshot) &
+ & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
+
+ if(oneshot)then
+ call reset_progress()
+ call set_end(int(floor(dble(nq0)/dble(npes))))
+ endif
+
+ if(npes>1)then
+ allocate(ista(MPI_STATUS_SIZE))
+ allocate(theta_buf_r(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));theta_buf_r=(0.d0,0.d0)
endif
if(.not.oneshot)then
- ualpha_r = (0.d0,0.d0)
+ allocate(tmpug(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));tmpug=0.d0
allocate(tmpur(na,nb,nc));tmpur=0.d0
- do i=1,nq0
- if(mod(i,npes)/=mype) cycle
- tmpug(:,:,:) = ualpha_g(i,:,:,:)
- call GtoR(na,nb,nc,tmpur,tmpug)
- ualpha_r(i,:,:,:) = tmpur(:,:,:)
- enddo
- deallocate(tmpur)
+ ! ualpha_g = (0.d0,0.d0)
+ else
+ allocate(tmpug(1,1,1))
endif
+ if(.not.oneshot)then
+ dFdrho=0.d0;dFddrho=0.d0
+ endif
+
+ irecv = mype+1
+ if(irecv.ge.npes) irecv = irecv-npes
+ isend = mype-1
+ if(isend.lt.0) isend = isend+npes
+
+ do cqaa=1,mp_nq
+ cqa = real_index(cqaa)
+ if (npes>1) theta_buf_r(1:np_nq,:,:,:) = theta_G_ab(1:np_nq,:,:,:)
+ if (cqaa.le.np_nq) theta_G_a(:,:,:) = theta_G_ab(cqaa,:,:,:)
+
+ if (.not.oneshot) tmpug=(0.d0,0.d0)
+ if (oneshot) call progress()
+
+ call tstatc0_begin('vdw_core_core ',id_sname3,1)
+
+ do i0=0,npes-1
+ ipos = i0+mype
+ if(ipos.ge.npes) ipos = ipos-npes
+ if(ipos.lt.0) ipos = ipos+npes
+
+ if(cqaa.le.np_nq)then
+ do i1=1,nel_nq(ipos)
+ cqb = real_index(i1,ipos)
+ if(npes>1)then
+ theta_G_b(:,:,:) = theta_buf_r(i1,:,:,:)
+ else
+ theta_G_b(:,:,:) = theta_G_ab(i1,:,:,:)
+ endif
+
+ fac = 1.d0
+ if(eval_kernel_by_interpolation) then
+ call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
+ else
+ Call phiab(cqa,cqb,nr12,phi_ab)
+ endif
+ Call convolution_3d_by_fft( na,nb,nc,cqa,cqb,nr12,phi_ab, &
+ & theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
+ Ecnl_12 = Ecnl_12 + Ecnl_12_ab
+ enddo
+ endif
+ if(npes>1.and.i0.ne.npes-1)then
+ call tstatc0_begin('vdWdf_core (comm) ',id_sname2,1)
+ allocate(theta_buf_s(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ theta_buf_s = theta_buf_r
+ call mpi_sendrecv(theta_buf_s,mp_nq*na*nb*nc,mpi_double_complex,isend,0, &
+ & theta_buf_r,mp_nq*na*nb*nc,mpi_double_complex,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ deallocate(theta_buf_s)
+ call tstatc0_end(id_sname2)
+ endif
+ enddo
+ call tstatc0_end(id_sname3)
- deallocate(tmpug)
+ if(.not.oneshot.and.cqaa.le.np_nq)then
+ call GtoR(na,nb,nc,tmpur,tmpug)
+#if 1
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(cqaa,:,:,:)
+ if ( .not. grad_rho_eq_0 ) then
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ grho = grad(cix,ciy,ciz)
+ rtmp = rho(cix,ciy,ciz)
+ if ( grho > 1.0d-6 ) then
+ dFddrho(cix,ciy,ciz) = dFddrho(cix,ciy,ciz) &
+ & + dble(tmpur(cix,ciy,ciz)) &
+ & *ddtheta_R(cqaa,cix,ciy,ciz) /grho
+ endif
+ end do
+ end do
+ end do
+ endif
+#else
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(cqaa,:,:,:)
+ if ( .not. grad_rho_eq_0 ) then
+ dFddrho(:,:,:) = dFddrho(:,:,:) + dble(tmpur(:,:,:))*ddtheta_R(cqaa,:,:,:)
+ endif
+#endif
+
+ if ( iprixc >= 2 ) then
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ esum = esum +dble(tmpur(cix,ciy,ciz)) *theta_R(cix,ciy,ciz)
+ end do
+ end do
+ end do
+ endif
+ endif
+ enddo
+
+ if(.not.oneshot)then
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,dFdrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,dFddrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ deallocate(tmpur)
+ endif
+ deallocate(tmpug)
+ endif
if(npes>1) then
call mpi_allreduce(MPI_IN_PLACE,Ecnl_12,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
- if(.not.oneshot) &
- & call mpi_allreduce(MPI_IN_PLACE,ualpha_r,nq0*na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
endif
- deallocate(ind)
+
+ if ( iprixc >=2 ) then
+ esum = esum *univol *rinplw /2.0d0
+ call mpi_allreduce(MPI_IN_PLACE,Esum,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ write(nfout,*) "vdw nonolocal E12 "
+ write(nfout,*) "evaluation in real space : ", esum
+ write(nfout,*) " in reciprocal space : ", ecnl_12
+ endif
+
+ if(npes>1)then
+ deallocate(ista)
+ deallocate(theta_buf_r)
+ endif
if(printable.and.oneshot) write(nfout,'(a)') '... done'
call tstatc0_end(id_sname)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
end subroutine vdWdf_core
+ subroutine vdWdf_core2()
+ use progress_bar
+ real(kind=DP) :: fac
+ integer :: cqbb,cqa,cqb,ierr
+ integer :: i,ic,i2,i3
+ complex(kind=DP), allocatable, dimension(:,:,:) :: tmpug,tmpur
+ complex(kind=DP), allocatable, dimension(:,:,:,:) :: theta_buf_s,theta_buf_r
+ real(kind=DP), allocatable, dimension(:,:,:,:) :: dtheta_buf
+ integer :: ipos,i0,i1,isend,irecv,ireq,ireqr
+ integer, allocatable, dimension(:) :: ista
+ integer :: id_sname = -1
+ integer :: id_sname2 = -1
+
+ call tstatc0_begin('vdWdf_core2 ',id_sname,1)
+ Ecnl_12 = 0.0d0
+ if(printable.and.oneshot) &
+ & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
+ if(oneshot)then
+ call reset_progress()
+ call set_end(int(floor(dble(nq0)/dble(npes))))
+ endif
+ if(npes>1)then
+ allocate(ista(MPI_STATUS_SIZE))
+ allocate(theta_buf_r(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));theta_buf_r=(0.d0,0.d0)
+ if(.not.oneshot)then
+ allocate(dtheta_buf(mp_nq,na,nb,nc));dtheta_buf=0.d0
+ endif
+ endif
+ if(.not.oneshot)then
+ allocate(tmpug(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));tmpug=0.d0
+ allocate(tmpur(na,nb,nc));tmpur=0.d0
+ ! ualpha_g = (0.d0,0.d0)
+ else
+ allocate(tmpug(1,1,1))
+ endif
+ if(.not.oneshot)then
+ dFdrho=0.d0;dFddrho=0.d0
+ endif
+
+ irecv = mype+1
+ if(irecv.ge.npes) irecv = irecv-npes
+ isend = mype-1
+ if(isend.lt.0) isend = isend+npes
+
+ if (npes>1) theta_buf_r(1:np_nq,:,:,:) = theta_G_ab(1:np_nq,:,:,:)
+ do i0=0,npes-1
+ ipos = i0+mype
+ if(ipos.ge.npes) ipos = ipos-npes
+ if(ipos.lt.0) ipos = ipos+npes
+ do i1=1,nel_nq(ipos)
+ cqa = real_index(i1,ipos)
+ if(npes>1)then
+ theta_G_a(:,:,:) = theta_buf_r(i1,:,:,:)
+ else
+ theta_G_a(:,:,:) = theta_G_ab(i1,:,:,:)
+ endif
+ do cqbb=1,np_nq
+ theta_G_b(:,:,:) = theta_G_ab(cqbb,:,:,:)
+ fac = 1.d0
+ cqb = real_index(cqbb)
+ if(eval_kernel_by_interpolation) then
+ call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
+ else
+ Call phiab(cqa,cqb,nr12,phi_ab)
+ endif
+ Call convolution_3d_by_fft(&
+ & na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
+ Ecnl_12 = Ecnl_12 + Ecnl_12_ab
+ enddo
+ if(.not.oneshot)then
+ ! call mpi_allreduce(MPI_IN_PLACE,tmpug,na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
+ call GtoR(na,nb,nc,tmpur,tmpug)
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(i1,:,:,:)
+ dFddrho(:,:,:) = dFddrho(:,:,:) + dble(tmpur(:,:,:))*ddtheta_R(i1,:,:,:)
+ endif
+ enddo
+ if(npes>1)then
+ call tstatc0_begin('vdWdf_core (comm) ',id_sname2,1)
+ allocate(theta_buf_s(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ theta_buf_s = theta_buf_r
+ call mpi_sendrecv(theta_buf_s,mp_nq*na*nb*nc,mpi_double_complex,isend,0, &
+ & theta_buf_r,mp_nq*na*nb*nc,mpi_double_complex,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ if(.not.oneshot)then
+ dtheta_buf = dtheta_R
+ call mpi_sendrecv(dtheta_buf,mp_nq*na*nb*nc,mpi_double_precision,isend,0, &
+ & dtheta_R, mp_nq*na*nb*nc,mpi_double_precision,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ dtheta_buf = ddtheta_R
+ call mpi_sendrecv(dtheta_buf,mp_nq*na*nb*nc,mpi_double_precision,isend,0, &
+ & ddtheta_R, mp_nq*na*nb*nc,mpi_double_precision,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ endif
+ deallocate(theta_buf_s)
+ call tstatc0_end(id_sname2)
+ endif
+ enddo
+
+ if(.not.oneshot)then
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,dFdrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,dFddrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ deallocate(tmpur)
+ endif
+ deallocate(tmpug)
+ endif
+
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,Ecnl_12,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ endif
+ if(npes>1)then
+ deallocate(ista)
+ deallocate(theta_buf_r)
+ if(.not.oneshot) deallocate(dtheta_buf)
+ endif
+ if(printable.and.oneshot) write(nfout,'(a)') '... done'
+ call tstatc0_end(id_sname)
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ end subroutine vdWdf_core2
+
subroutine corrections()
- !!$if(printable) write(nfout,'(a)') 'calculating correction terms and contribution from the LDA ...'
+!!$if(printable) write(nfout,'(a)') 'calculating correction terms and contribution from the LDA ...'
if(printable.and.oneshot) write(nfout,'(a)') 'calculating correction terms ...'
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Call piDphi(Ecnl_3,Ecnl_3s)
!!$ Call cLDA(na,nb,nc,rho,rhomin,dv,EcLDA)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if(printable.and.oneshot) write(nfout,'(a)') '... done'
end subroutine corrections
subroutine theta_ab(nx,ny,nz,ca,nq0,q0min,q0max,rho,grad,rhomin,theta_R,dtheta_R,ddtheta_R)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer, intent(in) :: nx,ny,nz,ca,nq0
Real(kind=DP), intent(in) :: q0min,q0max,rhomin
Real(kind=DP), intent(in) :: rho(nx,ny,nz),grad(nx,ny,nz)
real(kind=DP), intent(out) :: theta_R(nx,ny,nz),dtheta_R(nx,ny,nz),ddtheta_R(nx,ny,nz)
-! Internal valuables
+ ! Internal valuables
Integer cir,cix,ciy,ciz
Real(kind=DP) ni,dni,q0,dqdn,dqddn
real(kind=DP),allocatable,dimension(:) :: y,y2tmp
real(kind=DP) :: yout,y1out
+ integer :: id_sname = -1
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ call tstatc0_begin('theta_ab ',id_sname,1)
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(y(nq0));y=0.d0;y(ca)=1.d0
allocate(y2tmp(nq0));y2tmp(:) = q2ar(ca,:)
-! For the functions theta_R
+ ! For the functions theta_R
Do cir = 1,nx*ny*nz
cix = 1+(cir-1-MOD(cir-1+ny*nz,ny*nz))/(ny*nz)
ciy = 1+(cir-ny*nz*(cix-1)-1-MOD(cir-1+nz,nz))/nz
@@ -762,23 +1182,24 @@ module m_vdWDF
End do
deallocate(y)
deallocate(y2tmp)
+ call tstatc0_end(id_sname)
end subroutine theta_ab
-!** End SUBROUTINE theta_ab *******************************************************************
+ !** End SUBROUTINE theta_ab *******************************************************************
-!** SUBROUTINE piDphi **********************************************************************************
+ !** SUBROUTINE piDphi **********************************************************************************
Subroutine piDphi(Ecii,Ecii_s)
implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
real(kind=DP), intent(out) :: Ecii,Ecii_s
Real(kind=DP) da,db,a1,a2,dr
Parameter (dr = 0.001d0)
Integer ci,cj,ck,ca,cb
-! Gauss-Legendre integration
+ ! Gauss-Legendre integration
Integer cD,nD
Parameter (nD=10)
Real(kind=DP) maxD,minD,dD,LD,PLD,LDxi(nD),LDwi(nD)
@@ -792,23 +1213,23 @@ module m_vdWDF
Real(kind=DP) x,nnx,nny,nnz,nn2,r
Real(kind=DP) nxp,nxm,nyp,nym,nzp,nzm
Real(kind=DP) zx(-3:3),zy(-3:3),zz(-3:3),rn(3,-3:3)
-
+
Real(kind=DP) phi
Real(kind=DP) temp,rs,phid_s,phid_s1,d_phid_s,phi2,phi4
-! The table of phi1D
+ ! The table of phi1D
Integer c1D,n1D,ierr
Parameter(n1D = 1000)
Real(kind=DP) d1D,max1D,D,phix,phiy
Real(kind=DP) phi1D(0:n1D+1)
real(kind=DP) :: q0,dqdn,dqddn
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
-! Make the table of phi1D
+ !---------------------- Calculation Start ----------------------
+ ! Make the table of phi1D
max1D = ds
d1D = max1D/DBLE(n1D)
Do c1D = 0,n1D+1
@@ -877,42 +1298,40 @@ module m_vdWDF
phi4 = (-1.d0/ds**4)*(phid_s-phi0) + (rs/(2.d0*ds**4))*d_phid_s
Ecii_s = Ecii_s + 0.5d0*4.d0*pi*dv*(n**2)* &
-& (phi0*(rs**3)*(q0**0)/3.d0 + &
-& phi2*(rs**5)*(q0**2)/5.d0 + &
-& phi4*(rs**7)*(q0**4)/7.d0)
+ & (phi0*(rs**3)*(q0**0)/3.d0 + &
+ & phi2*(rs**5)*(q0**2)/5.d0 + &
+ & phi4*(rs**7)*(q0**4)/7.d0)
Enddo
if(npes>1) call mpi_allreduce(MPI_IN_PLACE,Ecii_s,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
End Subroutine piDphi
-!** End SUBROUTINE piDphi **********************
+ !** End SUBROUTINE piDphi **********************
-!** SUBROUTINE cLDA ****************************
+ !** SUBROUTINE cLDA ****************************
Subroutine cLDA(na,nb,nc,rho,rhomin,dv,EcLDA)
Implicit none
-!************************ Note *********************************
-! This Algorism follows Dion's 1-shot method.
-!
-! This program is a subroutine.
-! This program calculates the correlation energy from LDA.
-! The formula is given at Eq.(58) (p.93) of 'Theory of the
-! Inhomogeneous Electron Gas' Lundqvist, March.
-!
-!
-! Input
-! rho(nrxyz,nsipn) : Total density
-!
-! Output
-! EcLDA : Correlation energy from LDA.
-!
-!
-! Written by Youky Ono in 2009/Jul.
-!***************************************************************
-
-
+ !************************ Note *********************************
+ ! This Algorism follows Dion's 1-shot method.
+ !
+ ! This program is a subroutine.
+ ! This program calculates the correlation energy from LDA.
+ ! The formula is given at Eq.(58) (p.93) of 'Theory of the
+ ! Inhomogeneous Electron Gas' Lundqvist, March.
+ !
+ !
+ ! Input
+ ! rho(nrxyz,nsipn) : Total density
+ !
+ ! Output
+ ! EcLDA : Correlation energy from LDA.
+ !
+ !
+ ! Written by Youky Ono in 2009/Jul.
+ !***************************************************************
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
integer,intent(in) :: na,nb,nc
real(kind=DP),intent(in) :: rho(na,nb,nc)
real(kind=DP),intent(in) :: rhomin
@@ -926,11 +1345,9 @@ module m_vdWDF
real(kind=DP) e,m
parameter (e=1.d0,m=1.d0) ! Hatree atomic unit
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-
-
-!---------------------- Calculation Start ----------------------
+ !---------------------- Calculation Start ----------------------
EcLDA=0
Do cjr = 1,na*nb*nc
if(mod(cjr,npes)/=mype) cycle
@@ -938,102 +1355,105 @@ module m_vdWDF
cjy = 1+(cjr-nb*nc*(cjx-1)-1-MOD(cjr-1+nc,nc))/nc
cjz = cjr-nc*(nb*(cjx-1)-1+cjy)
n = MAX(rho(cjx,cjy,cjz),rhomin)
-
+
rs = ((3.d0/(4.d0*pi*n))**(1.d0/3.d0))/aB
x = rs/11.4d0
ec = -0.0666d0*0.5d0*((1.d0+x**3)*DLOG(1.d0+1.d0/x)-x**2+x/2.d0-1.d0/3.d0)
-
+
EcLDA = EcLDA + dv*n*ec
Enddo
if(npes>1) call mpi_allreduce(MPI_IN_PLACE,EcLDA,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
End Subroutine cLDA
-!** End SUBROUTINE cLDA **********************
+ !** End SUBROUTINE cLDA **********************
-!** SUBROUTINE RtoG ***************************************************************************
-! Execute FFT and transform theta_R to theta_G
+ !** SUBROUTINE RtoG ***************************************************************************
+ ! Execute FFT and transform theta_R to theta_G
Subroutine RtoG(na,nb,nc,theta_R,theta_G)
Implicit none
!!include "fftw3.f"
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer na,nb,nc,cix,ciy,ciz,ca,cb,cc
Real(kind=DP) rx,ry,rz,kx,ky,kz,ra,rb,rc,ka,kb,kc,rk,r12,x,y,z,term,term1
Real(kind=DP) theta_R(na,nb,nc)
Complex(kind=DP) theta_G(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
-! FFTW3 !!!
+ ! FFTW3 !!!
integer(kind=DP) :: plan
Complex(kind=DP),allocatable :: temp_R(:,:,:),temp_G(:,:,:)
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(temp_R(na,nb,nc))
allocate(temp_G(0:na-1,0:nb-1,0:nc-1))
-!***** FFT **************************************************
+ !***** FFT **************************************************
Do cix = 1,na
- Do ciy = 1,nb
- Do ciz = 1,nc
- temp_R(cix,ciy,ciz) = DCMPLX(theta_R(cix,ciy,ciz))
- Enddo
- Enddo
+ Do ciy = 1,nb
+ Do ciz = 1,nc
+ temp_R(cix,ciy,ciz) = DCMPLX(theta_R(cix,ciy,ciz))
+ Enddo
+ Enddo
Enddo
-! FFTW3 !!!
+ ! FFTW3 !!!
call dfftw_plan_dft_3d(plan,na,nb,nc,temp_R,temp_G,FFTW_FORWARD,FFTW_ESTIMATE)
call dfftw_execute(plan)
call dfftw_destroy_plan(plan)
Do ca = -(na/2-1),na/2
- Do cb = -(nb/2-1),nb/2
- Do cc = -(nc/2-1),nc/2
- cix = MOD(ca+na,na)
- ciy = MOD(cb+nb,nb)
- ciz = MOD(cc+nc,nc)
- theta_G(ca,cb,cc) = temp_G(cix,ciy,ciz) / DBLE(na*nb*nc)
- Enddo
- Enddo
+ Do cb = -(nb/2-1),nb/2
+ Do cc = -(nc/2-1),nc/2
+ cix = MOD(ca+na,na)
+ ciy = MOD(cb+nb,nb)
+ ciz = MOD(cc+nc,nc)
+ theta_G(ca,cb,cc) = temp_G(cix,ciy,ciz) / DBLE(na*nb*nc)
+ Enddo
+ Enddo
Enddo
-!***** END of FFT ******************************************
+ !***** END of FFT ******************************************
- deallocate(temp_R)
- deallocate(temp_G)
+ deallocate(temp_R); deallocate(temp_G)
End subroutine RtoG
-!** End SUBROUTINE RtoG ***********************************************************************
+ !** End SUBROUTINE RtoG ***********************************************************************
subroutine GtoR(na,nb,nc,theta_R,theta_G)
-! include "fftw3.f"
+ ! include "fftw3.f"
integer,intent(in) :: na,nb,nc
complex(kind=DP), dimension(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2), intent(in) :: theta_G
complex(kind=DP), dimension(na,nb,nc), intent(out) :: theta_R
+
integer :: ca,cb,cc,cix,ciy,ciz
integer(kind=DP) :: plan
complex(kind=DP),allocatable :: temp_R(:,:,:),temp_G(:,:,:)
integer :: id_sname=-1
+
call tstatc0_begin('GtoR ',id_sname,1)
+
allocate(temp_R(na,nb,nc))
allocate(temp_G(0:na-1,0:nb-1,0:nc-1))
+
Do ca = -(na/2-1),na/2
- Do cb = -(nb/2-1),nb/2
- Do cc = -(nc/2-1),nc/2
- cix = MOD(ca+na,na)
- ciy = MOD(cb+nb,nb)
- ciz = MOD(cc+nc,nc)
- temp_G(cix,ciy,ciz) = theta_G(ca,cb,cc)
- Enddo
- Enddo
+ Do cb = -(nb/2-1),nb/2
+ Do cc = -(nc/2-1),nc/2
+ cix = MOD(ca+na,na)
+ ciy = MOD(cb+nb,nb)
+ ciz = MOD(cc+nc,nc)
+ temp_G(cix,ciy,ciz) = theta_G(ca,cb,cc)
+ Enddo
+ Enddo
Enddo
-! FFTW3 !!!
+ ! FFTW3 !!!
call dfftw_plan_dft_3d(plan,na,nb,nc,temp_G,temp_R,FFTW_BACKWARD,FFTW_ESTIMATE)
call dfftw_execute(plan)
call dfftw_destroy_plan(plan)
-!***** END of FFT ******************************************
+ !***** END of FFT ******************************************
- theta_R = temp_R/dble(na*nb*nc)
-! theta_R = temp_R
+ ! theta_R = temp_R/dble(na*nb*nc)
+ theta_R = temp_R
deallocate(temp_R)
deallocate(temp_G)
@@ -1041,7 +1461,7 @@ module m_vdWDF
end subroutine GtoR
subroutine get_phi_ab_g(nr12,phi_ab,phi_ab_g)
-! include "fftw3.f"
+ ! include "fftw3.f"
integer, intent(in) :: nr12
real(kind=DP), dimension(0:nr12), intent(in) :: phi_ab
real(kind=DP), dimension(0:nr12), intent(out) :: phi_ab_g
@@ -1050,6 +1470,10 @@ module m_vdWDF
integer :: cr,ck
integer(kind=DP) :: plan
real(kind=DP) :: dd,r12,term,rk
+ real(kind=DP) :: rr
+ complex(kind=DP) :: zsum
+ complex(kind=DP), parameter :: zi = ( 0.0d0, 1.0d0 )
+
integer :: id_sname = -1
call tstatc0_begin('get_phi_ab_g ',id_sname,1)
allocate(cphiab_r(0:nr12));cphiab_r=0.d0
@@ -1058,20 +1482,27 @@ module m_vdWDF
dd = r12max/dble(nr12)
do cr=0,nr12
- cphiab_r(cr) = dcmplx(phi_ab(cr)*dble(cr),0.d0)
+ rr = dble(cr) *dd
+ cphiab_r(cr) = dcmplx( phi_ab(cr)*rr, 0.d0 )
enddo
+
+#if 0
call dfftw_plan_dft_1d(plan,nr12+1,cphiab_r,cphiab_g,FFTW_BACKWARD,FFTW_ESTIMATE)
+#else
+ call dfftw_plan_dft_1d( plan, nr12, cphiab_r(0:nr12-1), cphiab_g(0:nr12-1), &
+ & FFTW_BACKWARD, FFTW_ESTIMATE )
+#endif
call dfftw_execute(plan)
call dfftw_destroy_plan(plan)
do ck=1,nr12
rk = dble(ck)/r12max
- phi_ab_g(ck) = 2.d0*dd**2*dimag(cphiab_g(ck))/(dble(rk))
- enddo
+ phi_ab_g(ck) = 2.d0 *dd *dimag(cphiab_g(ck))/(dble(rk))
+ enddo
Do ck = 0,0
rk = dd * dble(ck)
- term = 0
+ term = 0.0d0
Do cr = 0,nr12
r12 = dd*dble(cr)
term = term + phi_ab(cr) * (r12**2)
@@ -1079,23 +1510,19 @@ module m_vdWDF
phi_ab_g(ck) = 4.0d0*pi*dd * term
End do
- deallocate(cphiab_r)
- deallocate(cphiab_g)
+ deallocate(cphiab_r); deallocate(cphiab_g)
+
+ phi_ab_g = phi_ab_g / univol
-! if(qa==1)then
-! do ck=0,nr12
-! rk = dble(ck)/r12max
-! write(qa*35+qb,*) rk,phi_ab_g(ck)
-! enddo
-! endif
call tstatc0_end(id_sname)
+
end Subroutine get_phi_ab_g
Subroutine convolution_3d_by_fft(na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
integer, intent(in) :: na,nb,nc,cqa,cqb,nr12
complex(kind=DP), intent(in) :: theta_G_a(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
complex(kind=DP), intent(in) :: theta_G_b(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
@@ -1113,64 +1540,79 @@ module m_vdWDF
Real(kind=DP),allocatable :: core_G(:)
+ real*8 :: dd
+
real(kind=DP) :: pi2rk
integer :: id_sname = -1
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
call tstatc0_begin('convolution_3d_by_fft ',id_sname,1)
allocate(core_G(0:nr12));core_G=0.d0
nabc = na*nb*nc
-
- Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
- Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
- Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
+ ! dd = r12max/dble(nr12)
call get_phi_ab_g(nr12,phi_ab,core_G)
+
dk = 1.d0/r12max
temp_c = (0.0d0,0.0d0)
!tmpug = 0.d0
- Do ciz = -(nc/2-1),nc/2
- Do ciy = -(nb/2-1),nb/2
- Do cix = -(na/2-1),na/2
- rk = DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
- !If(rk.LT.maxk) Then
- ck = dint(rk/dk)
- phix = (rk - dk*DBLE(ck))/dk
- phiy = 1.0 - phix
- term = phiy*core_G(ck) + phix*core_G(ck+1)
- !Else
- ! term = 0.0d0
- !Endif
-
- temp_c = temp_c + &
-& DCONJG(theta_G_a(cix,ciy,ciz)) * &
-& theta_G_b(cix,ciy,ciz) * &
-& term
- if(.not.oneshot) tmpug(cix,ciy,ciz) = tmpug(cix,ciy,ciz)+theta_G_b(cix,ciy,ciz)*term*dv*nabc!*0.5d0*fac
- Enddo
- Enddo
- Enddo
+ if(oneshot)then
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ rk = rkar(cix,ciy,ciz)
+ ck = dint(rk/dk)
+
+ phix = (rk - dk*DBLE(ck))/dk
+ phiy = 1.0d0 -phix
+ term = phiy*core_G(ck) + phix*core_G(ck+1)
+
+ temp_c = temp_c + term *DCONJG(theta_G_a(cix,ciy,ciz)) &
+ & * theta_G_b(cix,ciy,ciz)
+ Enddo
+ Enddo
+ Enddo
+ else
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ rk = rkar(cix,ciy,ciz)
+ ck = dint(rk/dk)
+
+ phix = (rk - dk*DBLE(ck))/dk
+ phiy = 1.0d0 - phix
+ term = phiy*core_G(ck) + phix*core_G(ck+1)
+
+ temp_c = temp_c + term *DCONJG(theta_G_a(cix,ciy,ciz)) &
+ & * theta_G_b(cix,ciy,ciz)
+
+ tmpug(cix,ciy,ciz) = tmpug(cix,ciy,ciz) &
+ & +theta_G_b(cix,ciy,ciz)*term *univol
+ Enddo
+ Enddo
+ Enddo
+ endif
- temp_c = temp_c * dv*nabc
+ temp_c = temp_c * univol**2
Ecnl_12_ab = 0.5d0*DBLE(temp_c)*fac
- !tmpug(:,:,:) = tmpug(:,:,:)*dv*nabc*0.5d0*fac
-!***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
+ !***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
deallocate(core_G)
call tstatc0_end(id_sname)
+
End subroutine convolution_3d_by_fft
-!** End SUBROUTINE convolution_3d *************************************************************
+ !** End SUBROUTINE convolution_3d *************************************************************
Subroutine convolution_3d(na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,Ecnl_12_ab)
Implicit none
-! include "fftw3.f"
+ ! include "fftw3.f"
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
integer, intent(in) :: na,nb,nc,cqa,cqb,nr12
complex(kind=DP), intent(in) :: theta_G_a(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
complex(kind=DP), intent(in) :: theta_G_b(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
@@ -1189,21 +1631,21 @@ module m_vdWDF
Real(kind=DP),allocatable :: phiab_r(:)
real(kind=DP) :: pi2rk
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(core_G(0:nk-1))
allocate(phiab_r(0:nr12));phiab_r=0.d0
nabc = na*nb*nc
-! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
-!& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
-!& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
-
- Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
- Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
- Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
+ ! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
+ !& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
+ !& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
+
+ ! Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
+ ! Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
+ ! Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
-!***** Make the core function and execute 3d-FFT by hand *****
+ !***** Make the core function and execute 3d-FFT by hand *****
dr12 = r12max/dble(nr12)
dk = maxk/dble(nk-1)
@@ -1232,71 +1674,72 @@ module m_vdWDF
Enddo
core_G(ck) = 2.d0 * dr12 * term / rk
End do
-!***** END of Make the core function *************************
+ !***** END of Make the core function *************************
-! if(cqa==1)then
-! do ck=0,nr12
-! rk = dk * dble(ck)
-! write((cqa+1)*35+cqb,*) rk,core_G(ck)
-! enddo
-! endif
-!***** Calculate 'theta_G_a*core_G*theta_G_b' ***************
+ ! if(cqa==1)then
+ ! do ck=0,nr12
+ ! rk = dk * dble(ck)
+ ! write((cqa+1)*35+cqb,*) rk,core_G(ck)
+ ! enddo
+ ! endif
+ !***** Calculate 'theta_G_a*core_G*theta_G_b' ***************
dk = maxk/dble(nk-1)
temp_c = (0.0,0.0)
Do cix = -(na/2-1),na/2
- Do ciy = -(nb/2-1),nb/2
- Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do ciz = -(nc/2-1),nc/2
- rk = DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
- If(rk.LT.maxk) Then
- ck = DINT(rk/dk)
- phix = (rk - dk*DBLE(ck))/dk
- phiy = 1.0 - phix
- term = phiy*core_G(ck) + phix*core_G(ck+1)
- Else
- term = 0.0d0
- Endif
-
- temp_c = temp_c + &
-& DCONJG(theta_G_a(cix,ciy,ciz)) * &
-& theta_G_b(cix,ciy,ciz) * &
-& term
- Enddo
- Enddo
+ !rk = DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
+ rk = rkar(cix,ciy,ciz)
+ If(rk.LT.maxk) Then
+ ck = DINT(rk/dk)
+ phix = (rk - dk*DBLE(ck))/dk
+ phiy = 1.0 - phix
+ term = phiy*core_G(ck) + phix*core_G(ck+1)
+ Else
+ term = 0.0d0
+ Endif
+
+ temp_c = temp_c + &
+ & DCONJG(theta_G_a(cix,ciy,ciz)) * &
+ & theta_G_b(cix,ciy,ciz) * &
+ & term
+ Enddo
+ Enddo
Enddo
temp_c = temp_c * dv*nabc
Ecnl_12_ab = 0.5d0*DBLE(temp_c)
-!***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
+ !***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
deallocate(core_G)
deallocate(phiab_r)
End subroutine convolution_3d
-!** End SUBROUTINE convolution_3d *************************************************************
+ !** End SUBROUTINE convolution_3d *************************************************************
Subroutine d_q0(n,dn,q0min,q0max,q0,dqdn,dqddn)
Implicit None
-!************************ Note *********************************
-! This program calculates q0.
-!
-! Input
-! rho(nrxyz,nsipn) : Total density
-!
-! Output
-! q0 :
-!
-!
-!
-! Written by Youky Ono
-!***************************************************************
+ !************************ Note *********************************
+ ! This program calculates q0.
+ !
+ ! Input
+ ! rho(nrxyz,nsipn) : Total density
+ !
+ ! Output
+ ! q0 :
+ !
+ !
+ !
+ ! Written by Youky Ono
+ !***************************************************************
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
real(kind=DP), intent(in) :: n,dn,q0min,q0max
real(kind=DP), intent(out) :: q0,dqdn,dqddn
Double Precision rs,x,nn2,r,term1,term2,term3,rnn2
@@ -1307,17 +1750,17 @@ module m_vdWDF
integer :: i
real(kind=DP) :: s2,s,qq
real(kind=DP) :: drsdn,dxdn,dexcdn,dsdn,dkFdn
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
+ !---------------------- Calculation Start ----------------------
nn2 = dn*dn
rnn2 = dsqrt(nn2)
rs = (3.d0/(4.d0*pi*n))**(1.d0/3.d0)
-! Eq.(58), (59) (p.93-94) of Theory of the Inhomogeneous Electron gas.
-! S.Lundqvist and N.H.March 1983 Plenum Press, NY
+ ! Eq.(58), (59) (p.93-94) of Theory of the Inhomogeneous Electron gas.
+ ! S.Lundqvist and N.H.March 1983 Plenum Press, NY
x = rs/11.4d0
GxcLDA = 0.5d0*((1.d0+x**3)*DLog(1.d0+1.d0/x)-x**2+x/2.d0-1.d0/3.d0)
excLDA = -0.458d0/rs-0.0666d0*GxcLDA
@@ -1329,22 +1772,37 @@ module m_vdWDF
call hxxc(qq,q0max,q0,dq)
q0 = max(q0,q0min)
-
+
if(q0.eq.q0min)then
- dqdn = 0.d0;dqddn=0.d0
+ dqdn = 0.d0;dqddn=0.d0
else
- drsdn = -(3.d0/(4.d0*PAI))**(1.d0/3.d0)/3.d0*n**(-4.d0/3.d0)
- dxdn = drsdn/11.4d0
- dexcdn = (0.458d0/(rs*rs))*drsdn-0.0333d0*(3*x*x*dlog(1+1.d0/x)-(1+x**3)/(x*(x+1))-2*x+0.5d0)*dxdn
- dkFdn = (pi/kF)**2
- dsdn = -(rnn2/(4*kF*n*kF*n))*(dkFdn*n+kF)
- dqdn = -(4.d0*pi/3.d0)*dexcdn-(Zab/9.d0)*(2*s*dsdn*kF+s2*dkFdn)
- dqddn = -(Zab/9.d0)*s/n
- dqdn = dqdn*dq
- dqddn = dqddn*dq
+#if 0
+ drsdn = -(3.d0/(4.d0*PAI))**(1.d0/3.d0)/3.d0*n**(-4.d0/3.d0)
+ dxdn = drsdn/11.4d0
+ dexcdn = (0.458d0/(rs*rs))*drsdn &
+ & -0.0333d0*(3*x*x*dlog(1+1.d0/x)-(1+x**3)/(x*(x+1))-2*x+0.5d0)*dxdn
+ dkFdn = (pi/kF)**2
+!!! dsdn = -(rnn2/(4*kF*n*kF*n))*(dkFdn*n+kF)
+ dsdn = -(rnn2/(2*kF*n*kF*n))*(dkFdn*n+kF)
+ dqdn = -(4.d0*pi/3.d0)*dexcdn-(Zab/9.d0)*(2*s*dsdn*kF+s2*dkFdn)
+ dqddn = -(Zab/9.d0)*s/n
+
+#else
+ drsdn = -rs /3.0d0 /n
+ dxdn = drsdn/11.4d0
+ dexcdn = (0.458d0/(rs*rs))*drsdn &
+ & -0.0333d0*(3*x*x*dlog(1+1.d0/x)-(1+x**3)/(x*(x+1))-2*x+0.5d0)*dxdn
+ dkFdn = kF /3.0d0 /n
+ dsdn = -s /(kF*n) *(dkFdn*n+kF)
+ dqdn = -(4.d0*pi/3.d0)*dexcdn-(Zab/9.d0)*(2*s*dsdn*kF+s2*dkFdn)
+! dqddn = -(Zab/9.d0)*s2 *2.0 /dn *KF
+ dqddn = -(Zab/9.d0)*s/n
+#endif
+ dqdn = dqdn*dq
+ dqddn = dqddn*dq
endif
End Subroutine d_q0
-!** End SUBROUTINE d_q0 ***********************************************************************
+ !** End SUBROUTINE d_q0 ***********************************************************************
subroutine hxxc(x,xc,hx,dhx)
real(kind=DP), intent(in) :: x,xc
@@ -1362,62 +1820,59 @@ module m_vdWDF
dhx = xc*dexp(-summ)*dsumm
end subroutine hxxc
-!** SUBROUTINE derivation *********************************************************************
+ !** SUBROUTINE derivation *********************************************************************
Subroutine derivation(na,nb,nc,aa,rho,dv,grad)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
-! The unit cell and the electron density information
+ ! The unit cell and the electron density information
integer,intent(in) :: na,nb,nc
real(kind=DP), intent(in) :: rho(na,nb,nc)
Real(kind=DP), intent(in) :: aa(3,3)
real(kind=DP), intent(in) :: dv
real(kind=DP), intent(out) :: grad(na,nb,nc)
-! Integers
+ ! Integers
Integer i,j,k,cx,cy,cz,nabc
-! Internal valuables
+ ! Internal valuables
Integer zx(-3:3),zy(-3:3),zz(-3:3)
Real(kind=DP) rn(3,-3:3),detr,bb(3,3)
Real(kind=DP),allocatable :: darho(:,:,:),dbrho(:,:,:),dcrho(:,:,:)
real(kind=DP) :: dx,dy,dz
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(darho(na,nb,nc));darho=0.d0
allocate(dbrho(na,nb,nc));dbrho=0.d0
allocate(dcrho(na,nb,nc));dcrho=0.d0
-! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
-!& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
-!& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
+ ! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
+ !& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
+ !& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
Do cx = 1,na
- Do cy = 1,nb
- Do cz = 1,nc
+ Do cy = 1,nb
+ Do cz = 1,nc
- Do j = -3,3
- zx(j) = MOD(2*na+(cx+j)-1,na)+1
- zy(j) = MOD(2*nb+(cy+j)-1,nb)+1
- zz(j) = MOD(2*nc+(cz+j)-1,nc)+1
-
- rn(1,j) = rho(zx(j),cy,cz)
- rn(2,j) = rho(cx,zy(j),cz)
- rn(3,j) = rho(cx,cy,zz(j))
- Enddo
-
- darho(cx,cy,cz) = &
-& (rn(1,3)-9.d0*rn(1,2)+45.d0*rn(1,1)-45.d0*rn(1,-1)+9.d0*rn(1,-2)-rn(1,-3))/(60.d0)
- dbrho(cx,cy,cz) = &
-& (rn(2,3)-9.d0*rn(2,2)+45.d0*rn(2,1)-45.d0*rn(2,-1)+9.d0*rn(2,-2)-rn(2,-3))/(60.d0)
- dcrho(cx,cy,cz) = &
-& (rn(3,3)-9.d0*rn(3,2)+45.d0*rn(3,1)-45.d0*rn(3,-1)+9.d0*rn(3,-2)-rn(3,-3))/(60.d0)
- Enddo
- Enddo
+ Do j = -3,3
+ zx(j) = MOD(2*na+(cx+j)-1,na)+1
+ zy(j) = MOD(2*nb+(cy+j)-1,nb)+1
+ zz(j) = MOD(2*nc+(cz+j)-1,nc)+1
+
+ rn(1,j) = rho(zx(j),cy,cz)
+ rn(2,j) = rho(cx,zy(j),cz)
+ rn(3,j) = rho(cx,cy,zz(j))
+ Enddo
+
+ darho(cx,cy,cz) = (rn(1,3)-9.d0*rn(1,2)+45.d0*rn(1,1)-45.d0*rn(1,-1)+9.d0*rn(1,-2)-rn(1,-3))/(60.d0)
+ dbrho(cx,cy,cz) = (rn(2,3)-9.d0*rn(2,2)+45.d0*rn(2,1)-45.d0*rn(2,-1)+9.d0*rn(2,-2)-rn(2,-3))/(60.d0)
+ dcrho(cx,cy,cz) = (rn(3,3)-9.d0*rn(3,2)+45.d0*rn(3,1)-45.d0*rn(3,-1)+9.d0*rn(3,-2)-rn(3,-3))/(60.d0)
+ Enddo
+ Enddo
Enddo
detr = (aa(1,1)*aa(2,2)*aa(3,3)+aa(1,2)*aa(2,3)*aa(3,1)+aa(1,3)*aa(2,1)*aa(3,2)) &
-& - (aa(1,1)*aa(2,3)*aa(3,2)+aa(1,2)*aa(2,1)*aa(3,3)+aa(1,3)*aa(2,2)*aa(3,1))
+ &- (aa(1,1)*aa(2,3)*aa(3,2)+aa(1,2)*aa(2,1)*aa(3,3)+aa(1,3)*aa(2,2)*aa(3,1))
bb(1,1) = (aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2))/detr
bb(2,1) = -(aa(2,1)*aa(3,3)-aa(2,3)*aa(3,1))/detr
@@ -1430,15 +1885,14 @@ module m_vdWDF
bb(3,3) = (aa(1,1)*aa(2,2)-aa(1,2)*aa(2,1))/detr
Do cx = 1,na
- Do cy = 1,nb
- Do cz = 1,nc
-
- dx = (bb(1,1)*darho(cx,cy,cz) + bb(1,2)*dbrho(cx,cy,cz) + bb(1,3)*dcrho(cx,cy,cz))
- dy = (bb(2,1)*darho(cx,cy,cz) + bb(2,2)*dbrho(cx,cy,cz) + bb(2,3)*dcrho(cx,cy,cz))
- dz = (bb(3,1)*darho(cx,cy,cz) + bb(3,2)*dbrho(cx,cy,cz) + bb(3,3)*dcrho(cx,cy,cz))
- grad(cx,cy,cz) = dsqrt(dx**2+dy**2+dz**2)
- Enddo
- Enddo
+ Do cy = 1,nb
+ Do cz = 1,nc
+ dx = (bb(1,1)*darho(cx,cy,cz) + bb(1,2)*dbrho(cx,cy,cz) + bb(1,3)*dcrho(cx,cy,cz))
+ dy = (bb(2,1)*darho(cx,cy,cz) + bb(2,2)*dbrho(cx,cy,cz) + bb(2,3)*dcrho(cx,cy,cz))
+ dz = (bb(3,1)*darho(cx,cy,cz) + bb(3,2)*dbrho(cx,cy,cz) + bb(3,3)*dcrho(cx,cy,cz))
+ grad(cx,cy,cz) = dsqrt(dx**2+dy**2+dz**2)
+ Enddo
+ Enddo
Enddo
deallocate(darho)
@@ -1446,7 +1900,7 @@ module m_vdWDF
deallocate(dcrho)
End subroutine derivation
-!** End SUBROUTINE derivation *****************************************************************
+ !** End SUBROUTINE derivation *****************************************************************
subroutine spline0(nq0,x,y2)
integer, intent(in) :: nq0
@@ -1483,8 +1937,8 @@ module m_vdWDF
real(kind=DP), intent(in) :: a,b
real(kind=DP) :: res
res = 2.d0*((3.d0-a*a)*b*DCOS(b)*DSIN(a) + (3.d0-b*b)*a*DCOS(a)*DSIN(b) &
-& + (a*a+b*b-3.d0)*DSIN(a)*DSIN(b) &
-& - 3.d0*a*b*DCOS(a)*DCOS(b))/((a*b)**3)
+ & + (a*a+b*b-3.d0)*DSIN(a)*DSIN(b) &
+ & - 3.d0*a*b*DCOS(a)*DCOS(b))/((a*b)**3)
end function Wab
function Twxyz(w,x,y,z) result (res)
@@ -1494,30 +1948,30 @@ module m_vdWDF
res = 0.5d0*(1.d0/(w+x)+1.d0/(y+z))*(1.d0/((w+y)*(x+z))+1.d0/((w+z)*(y+x)))
end function Twxyz
-!** SUBROUTINE kernel_phi *********************************************************************
+ !** SUBROUTINE kernel_phi *********************************************************************
Subroutine kernel_phi(di,dk,phi)
implicit none
-!************************ Note *********************************
-! This Algorism follows Dion's 1-shot method.
-!
-! This program is a subroutine.
-! This program calculates the kernel function phi.
-!
-! Input
-!
-!
-! Output
-! phi :
-!
-!
-!
-! Written by Youky Ono in 2013/Jan.
-!***************************************************************
+ !************************ Note *********************************
+ ! This Algorism follows Dion's 1-shot method.
+ !
+ ! This program is a subroutine.
+ ! This program calculates the kernel function phi.
+ !
+ ! Input
+ !
+ !
+ ! Output
+ ! phi :
+ !
+ !
+ !
+ ! Written by Youky Ono in 2013/Jan.
+ !***************************************************************
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
real(kind=DP), intent(in) :: di,dk
real(kind=DP), intent(out) :: phi
Integer ca,cb,nb
@@ -1527,75 +1981,75 @@ module m_vdWDF
real(kind=DP) :: dr
-! Gauss-Legendre integration
+ ! Gauss-Legendre integration
Real(kind=DP),allocatable, dimension(:) :: xi,wi
Real(kind=DP) :: fac
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
-! Call gauleg for Gauss-Legendre integral
- allocate(xi(na_gl));xi=0.d0
- allocate(wi(na_gl));wi=0.d0
- Call gauleg(a1,a2,na_gl,xi,wi)
-
- phi = 0.d0
- Do ca=1,na_gl
- Do cb=1,ca
- fac=2.d0
- if(ca.eq.cb) fac=1.d0
- a = xi(ca)
- b = xi(cb)
-
- v1 = (a**2)/(2*hofy(a,di))
- v2 = (b**2)/(2*hofy(b,di))
- v3 = (a**2)/(2*hofy(a,dk))
- v4 = (b**2)/(2*hofy(b,dk))
- phi = phi + fac*wi(ca)*wi(cb)*(a*a*b*b)*Wab(a,b)*Twxyz(v1,v2,v3,v4)
- End Do
- End Do
-
- phi = phi * 2*m*(e**4)/(pi**2)
- deallocate(xi)
- deallocate(wi)
+ !---------------------- Calculation Start ----------------------
+ ! Call gauleg for Gauss-Legendre integral
+ allocate(xi(na_gl));xi=0.d0
+ allocate(wi(na_gl));wi=0.d0
+ Call gauleg(a1,a2,na_gl,xi,wi)
+
+ phi = 0.d0
+ Do ca=1,na_gl
+ Do cb=1,ca
+ fac=2.d0
+ if(ca.eq.cb) fac=1.d0
+ a = xi(ca)
+ b = xi(cb)
+
+ v1 = (a**2)/(2.d0*hofy(a,di))
+ v2 = (b**2)/(2.d0*hofy(b,di))
+ v3 = (a**2)/(2.d0*hofy(a,dk))
+ v4 = (b**2)/(2.d0*hofy(b,dk))
+ phi = phi + fac*wi(ca)*wi(cb)*(a*a*b*b)*Wab(a,b)*Twxyz(v1,v2,v3,v4)
+ End Do
+ End Do
+
+ phi = phi * 2.d0 *m *(e**4)/(pi**2)
+ deallocate(xi)
+ deallocate(wi)
end Subroutine kernel_phi
-!** End SUBROUTINE kernel_phi *****************************************************************
+ !** End SUBROUTINE kernel_phi *****************************************************************
-!** SUBROUTINE gauleg **********************************************************************************
+ !** SUBROUTINE gauleg **********************************************************************************
Subroutine gauleg(x1,x2,n,xi,wi)
Implicit none
real(kind=DP), intent(in) :: x1,x2
integer, intent(in) :: n
real(kind=DP), intent(out) :: xi(n),wi(n)
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer m,j,i
REAL(kind=DP) z1,z,xm,xl,pp,p3,p2,p1,eta
Parameter (eta=0.0000000001d0)
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
+ !---------------------- Calculation Start ----------------------
m=(n+1)/2
xm=0.5d0*(x2+x1)
xl=0.5d0*(x2-x1)
-! === DEBUG by tkato 2014/04/22 ================================================
+ ! === DEBUG by tkato 2014/04/22 ================================================
z1 = 0.0d0
-! ==============================================================================
+ ! ==============================================================================
Do i=1,m
z=DCOS(pi*(i-0.25d0)/(n+0.5d0))
Do While (ABS(z-z1).GT.eta)
p1=1.0d0
p2=0.0d0
-
+
Do j=1,n
p3=p2
P2=p1
p1=((2.0d0*j-1.d0)*z*p2-(j-1.d0)*p3)/dble(j)
Enddo
-
+
pp=n*(z*p1-p2)/(z*z-1.d0)
z1=z
z=z1-p1/pp
@@ -1607,50 +2061,52 @@ module m_vdWDF
wi(n+1-i) = wi(i)
Enddo
End Subroutine gauleg
-!** End SUBROUTINE gauleg ******************************************************************************
+ !** End SUBROUTINE gauleg ******************************************************************************
-!** SUBROUTINE outputs ************************************************************************
+ !** SUBROUTINE outputs ************************************************************************
Subroutine outputs()
Implicit none
Ecnl = Ecnl_12 + Ecnl_3 - Ecnl_3s
if(printable)then
- write(nfout,'(a)') 'Here are the results : '
- Write(nfout,*) ' '
- Write(nfout,11) ExGGA
- Write(nfout,*) ' '
- Write(nfout,12) EcLDA
- Write(nfout,13) Ecnl
- Write(nfout,14) EcLDA + Ecnl
- Write(nfout,*) ' '
- Write(nfout,15) EcLDA + Ecnl + ExGGA
- Write(nfout,*) ' '
-11 Format('E_total(GGA exchange) = ',F19.13)
-
-12 Format('Ec(LDA) = ',F19.13)
-13 Format('Ec(nl) = ',F19.13)
-14 Format('Ec (= Ec(LDA) + Ec(nl) ) = ',F19.13)
+ write(nfout,'(a)') 'Here are the results : '
+ Write(nfout,*) ' '
+ Write(nfout,11) ExGGA
+ Write(nfout,*) ' '
+ Write(nfout,12) EcLDA
+ Write(nfout,13) Ecnl
+ Write(nfout,14) EcLDA + Ecnl
+ Write(nfout,*) ' '
+ Write(nfout,15) EcLDA + Ecnl + ExGGA
+ Write(nfout,*) ' '
+11 Format('E_total(GGA exchange) = ',F19.13)
+
+12 Format('Ec(LDA) = ',F19.13)
+13 Format('Ec(nl) = ',F19.13)
+14 Format('Ec (= Ec(LDA) + Ec(nl) ) = ',F19.13)
-15 Format('E_total(vdW-DF) = ',F19.13)
+15 Format('E_total(vdW-DF) = ',F19.13)
- Write(nfout,*) ' Given in Hartree atomic units'
- Write(nfout,*) ' '
+ Write(nfout,*) ' Given in Hartree atomic units'
+ Write(nfout,*) ' '
endif
End Subroutine outputs
-!** End SUBROUTINE outputs ********************************************************************
+ !** End SUBROUTINE outputs ********************************************************************
- subroutine get_dFdrho_dFddrho(na,nb,nc,dFdrho,dFddrho)
+ subroutine get_dFdrho_dFddrho(na,nb,nc,dFdrho_,dFddrho_)
integer, intent(in) :: na,nb,nc
- real(kind=DP), dimension(na,nb,nc), intent(out) :: dFdrho,dFddrho
+ real(kind=DP), dimension(na,nb,nc), intent(out) :: dFdrho_,dFddrho_
integer :: i,i1,i2,i3
- dFdrho = 0.0d0;dFddrho = 0.0d0
- do i=1,nq0
- dFdrho (:,:,:) = dFdrho (:,:,:) + dble(ualpha_r(i,:,:,:))*dtheta_R (i,:,:,:)/(univol*rinplw)
- dFddrho(:,:,:) = dFddrho(:,:,:) + dble(ualpha_r(i,:,:,:))*ddtheta_R(i,:,:,:)/(univol*rinplw)
- enddo
-
+ dFdrho_ = dFdrho
+ dFddrho_ = dFddrho
+ ! dFdrho = 0.0d0;dFddrho = 0.0d0 ! this can be calculated on the fly!!
+ ! do i=1,nq0
+ ! dFdrho (:,:,:) = dFdrho (:,:,:) + dble(ualpha_r(i,:,:,:))*dtheta_R (i,:,:,:)/(univol*rinplw)
+ ! dFddrho(:,:,:) = dFddrho(:,:,:) + dble(ualpha_r(i,:,:,:))*ddtheta_R(i,:,:,:)/(univol*rinplw)
+ ! enddo
+
end subroutine get_dFdrho_dFddrho
diff -uprN phase0_2015.01/src_phase/mdmain0.F90 phase0_2015.01.01/src_phase/mdmain0.F90
--- phase0_2015.01/src_phase/mdmain0.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/mdmain0.F90 2016-07-12 12:51:19.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 482 $)
!
! MAIN PROGRAM: PHASE
!
@@ -32,7 +32,7 @@
! Consortium.
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
-! $Id: mdmain0.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: mdmain0.F90 482 2016-04-08 08:40:45Z jkoga $
!
program PHASE
#ifdef NEC_TIMER
@@ -42,7 +42,7 @@ program PHASE
implicit none
logical :: ChargeDensity_is_Converged, TotalEnergy_is_Divergent
logical :: Already_Converged, Already_Converged2
- logical :: Positron_bulk, Positron_defect
+ logical :: Positron_scf, Positron_nonscf
logical :: Hubbard_model
logical :: Forces_are_Converged, Ending_Time, Force_errors_are_tolerable,UnitCell_Converged
!!$ logical :: ChargeDensity_is_Fixed
@@ -101,6 +101,8 @@ program PHASE
#endif
call Ewald_and_Structure_Factor
+ if ( Positron_scf() ) call Initial_pWaveFunctions()
+
call Initial_Electronic_Structure
if(ChargeDensity_is_Fixed() .and. One_by_one_in_each_rank_k()) then ! icond=2, 3
@@ -133,6 +135,8 @@ program PHASE
! ============================================================ 5.0
call Renewal_of_WaveFunctions
+ if ( Positron_scf() ) call Renewal_of_pWaveFunctions
+
call ChargeDensity_Construction(0)
call Potential_Construction
@@ -149,7 +153,8 @@ program PHASE
if ( PotentialMix() ) then
else
call Renewal_of_Potential
- if(Hubbard_model()) then
+ if ( Positron_scf() ) call Renewal_of_pPotential
+ if (Hubbard_model() ) then
call Renewal_of_Hubbard_Parameters
call Renewal_of_Hubbard_Potential
end if
@@ -167,6 +172,10 @@ program PHASE
call Move_Ions
call MDIterationNumber_Setting
call Ewald_and_Structure_Factor
+ if ( Hubbard_model() ) then
+ call Renewal_of_Hubbard_Parameters
+ call Renewal_of_Hubbard_Potential
+ end if
!!$ call MDIterationNumber_Setting
end if
if(BreakMD(force_conv))then
@@ -185,16 +194,21 @@ program PHASE
#endif
end if
- if(Already_Converged2() .and. .not.Positron_defect() .and. Positron_bulk()) then
+ if ( Already_Converged2() ) then
+ if ( Positron_nonscf() ) then
#ifdef NEC_ITER_REG
- call FTRACE_REGION_BEGIN("POSITRON")
+ call FTRACE_REGION_BEGIN("POSITRON")
#endif
- call Renewal_of_pPotential()
- call Solve_pWaveFunctions()
+ call Initial_pWaveFunctions()
+ call Renewal_of_pPotential()
+ call Solve_pWaveFunctions()
#ifdef NEC_ITER_REG
- call FTRACE_REGION_END("POSITRON")
+ call FTRACE_REGION_END("POSITRON")
#endif
- end if
+ else if ( Positron_scf() ) then
+ call Write_Positron_LifeTime
+ end if
+ endif
#ifdef NEC_ITER_REG
call FTRACE_REGION_BEGIN("FINAL")
@@ -577,4 +591,11 @@ contains
#endif
call m_CtrlP_set_init_status(.true.)
end subroutine Array_Deallocate
+
+ subroutine Write_Positron_LifeTime
+ use m_Positron_Wave_Functions, only : m_pWF_wlifetime
+
+ call m_pWF_wlifetime()
+ end subroutine Write_Positron_LifeTime
+
end program PHASE
diff -uprN phase0_2015.01/src_phase/mpi_dummy.F90 phase0_2015.01.01/src_phase/mpi_dummy.F90
--- phase0_2015.01/src_phase/mpi_dummy.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/mpi_dummy.F90 2016-07-12 12:51:19.000000000 +0900
@@ -169,6 +169,12 @@ subroutine mpi_copy( send_buf, recv_buf,
end if
end
+subroutine mpi_sendrecv(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf,recvcount,recvtype,source,recvtag,comm,status,ierr)
+ integer :: sendcount,sendtype,dest,sendtag,recvcount,recvtype,source,recvtag,comm,status,ierr
+ logical(4) :: sendbuf(sendcount*2),recvbuf(recvcount*2)
+ call mpi_copy( sendbuf, recvbuf, sendcount, sendtype, ierr )
+end
+
#ifndef _NO_ARG_DUMMY_
function iargc()
iargc = 0
diff -uprN phase0_2015.01/src_phase/vdW.F90 phase0_2015.01.01/src_phase/vdW.F90
--- phase0_2015.01/src_phase/vdW.F90 2015-08-05 14:45:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/vdW.F90 2016-07-12 12:51:19.000000000 +0900
@@ -48,7 +48,7 @@ subroutine vdW_scf(nspin,ispin,na,nb,nc,
call build_theta()
call vdWdf_core()
call corrections()
- ecnl = (Ecnl_12 + Ecnl_3 - Ecnl_3s)/(univol*rinplw)
+ ecnl = Ecnl_12 + Ecnl_3 - Ecnl_3s
call get_dFdrho_dFddrho(na,nb,nc,dFdrho,dFddrho)
call finalize_vdwdf()
call tstatc0_end(id_sname)
diff -uprN phase0_2015.01/src_phase/version.h phase0_2015.01.01/src_phase/version.h
--- phase0_2015.01/src_phase/version.h 2015-09-15 12:16:21.000000000 +0900
+++ phase0_2015.01.01/src_phase/version.h 2016-07-12 12:51:19.000000000 +0900
@@ -1 +1 @@
-integer, parameter :: svn_revision = 460
+integer, parameter :: svn_revision = 511
diff -uprN phase0_2015.01/src_phase_3d/ChargeDensity_Construction.F90 phase0_2015.01.01/src_phase_3d/ChargeDensity_Construction.F90
--- phase0_2015.01/src_phase_3d/ChargeDensity_Construction.F90 2015-09-14 15:34:33.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/ChargeDensity_Construction.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 455 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 494 $)
!
! SUBROUINE: ChargeDensity_Construction, FermiEnergyLevel,
! CD_Softpart_plus_Hardpart
@@ -32,7 +32,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine ChargeDensity_Construction(ic)
-! $Id: ChargeDensity_Construction.F90 455 2015-09-07 08:04:26Z yamasaki $
+! $Id: ChargeDensity_Construction.F90 494 2016-06-02 00:54:16Z jkoga $
use m_Total_Energy, only : m_TE_total_energy, ehartr
use m_Charge_Density, only : m_CD_convergence_check &
& , m_CD_softpart_3D, m_CD_hardpart &
@@ -64,7 +64,7 @@ subroutine ChargeDensity_Construction(ic
use m_Control_Parameters, only : nspin, kimg, af
use m_Kpoints, only : k_symmetry
use m_Const_Parameters, only : GAMMA
- use m_Parallelization, only : np_e, ista_k, iend_k, map_k, myrank_k,ista_kngp,iend_kngp
+ use m_Parallelization, only : np_e, ista_k, iend_k, map_k, myrank_k,ista_kngp,iend_kngp,mpi_ke_world
use m_PseudoPotential, only : nlmta
@@ -77,11 +77,13 @@ subroutine ChargeDensity_Construction(ic
!! use m_Total_Energy, only : m_TE_total_energy_noncl
! ========================================================================= 11.0
+ use m_PlaneWaveBasisSet, only : kgp
use m_FFT, only : fft_box_size_CD
+
implicit none
include 'mpif.h'
@@ -123,7 +125,7 @@ subroutine ChargeDensity_Construction(ic
! =================== added by K. Tagami ============ 5.0
if ( sw_eval_energy_before_charge == ON ) then
- call m_TE_total_energy(nfout,display_on,kv3)
+ call m_TE_total_energy(nfout,display_on,kv3)
endif
! =================================================== 5.0
@@ -153,16 +155,20 @@ subroutine ChargeDensity_Construction(ic
if(sw_esm==ON)then
nfftcd = fft_box_size_CD(1,0)*fft_box_size_CD(2,0)*fft_box_size_CD(3,0)
allocate(vhar(nfftcd));vhar=(0.d0,0.d0)
- allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+! allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+ allocate(chgc(1:kgp,nspin));chgc=(0.d0,0.d0)
if(kimg==1)then
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),0.d0)
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),0.d0)
+ chgc(ig,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),0.d0)
enddo
else
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),chgq_l(ig,2,1:nspin))
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),chgq_l(ig,2,1:nspin))
+ chgc(ig,1:nspin) = dcmplx(chgq_l(ig,1,1:nspin),chgq_l(ig,2,1:nspin))
enddo
endif
+ call mpi_allreduce(mpi_in_place,chgc,kgp*nspin,mpi_double_complex,mpi_sum,mpi_ke_world,ierr)
call esm_hartree(chgc,ehartr,vhar)
ehartr = 0.5d0*ehartr !Ry -> Ha
deallocate(chgc)
@@ -172,7 +178,7 @@ subroutine ChargeDensity_Construction(ic
if ( sw_eval_energy_before_charge == OFF ) then
- call m_TE_total_energy(nfout,display_on,kv3)
+ call m_TE_total_energy(nfout,display_on,kv3)
endif
! ======================================================== 5.0
@@ -207,7 +213,7 @@ contains
end subroutine FermiEnergyLevel
subroutine CD_Softpart_plus_Hardpart
-! $Id: ChargeDensity_Construction.F90 455 2015-09-07 08:04:26Z yamasaki $
+! $Id: ChargeDensity_Construction.F90 494 2016-06-02 00:54:16Z jkoga $
!fj#ifdef __TIMER_SUB__
!fj call timer_sta(716)
!fj#endif
diff -uprN phase0_2015.01/src_phase_3d/ChargeDensity_Mixing.F90 phase0_2015.01.01/src_phase_3d/ChargeDensity_Mixing.F90
--- phase0_2015.01/src_phase_3d/ChargeDensity_Mixing.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/ChargeDensity_Mixing.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 492 $)
!
! SUBROUINE: ChargeDensity_Mixing
!
@@ -31,7 +31,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine ChargeDensity_Mixing
-! $Id: ChargeDensity_Mixing.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: ChargeDensity_Mixing.F90 492 2016-05-31 03:06:04Z jkoga $
use m_Const_Parameters, only : DP,SIMPLE,BROYD1,BROYD2,DFP,PULAY,RMM2P,ON &
& , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION, CONTINUATION, SKIP
use m_Charge_Density, only : m_CD_check
@@ -49,7 +49,7 @@ subroutine ChargeDensity_Mixing
& , m_CtrlP_set_rmx &
& , m_CtrlP_waymix_now &
& , m_CtrlP_set_mix_parameter &
- & , sw_hubbard
+ & , sw_hubbard, sw_mix_occ_matrix
use m_Files, only : nfout
use m_IterationNumbers, only : iteration_electronic, iteration_ionic &
& , m_Iter_cmix_reset
@@ -187,10 +187,10 @@ contains
case (SIMPLE)
call m_CD_simple_mixing( nfout,rmxt_tot )
call m_CD_simple_mixing_hard( nfout, rmxt_hard )
- if ( sw_hubbard == ON ) then
+ if ( sw_hubbard == ON .and.sw_mix_occ_matrix==OFF ) then
call Renewal_of_OccMat( .false., ON ) ! hsr --> om
- call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
+ if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case (BROYD1)
! call m_CD_mix_broyden1_with_hsr(rmxt_tot)
@@ -198,22 +198,21 @@ contains
stop
case (BROYD2)
- call m_CD_mix_broyden2_with_hsr(nfout,rmxt_tot)
- if ( sw_hubbard == ON ) then
+ call m_CD_mix_broyden2_with_hsr(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
+ if ( sw_hubbard == ON .and. sw_mix_occ_matrix==OFF ) then
call Renewal_of_OccMat(.false., ON ) ! hsr --> om
- call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
-
+ if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case (DFP)
! call m_CD_mix_DFP(rmxt_tot)
write(*,*) 'Not supported '
stop
case (PULAY)
- call m_CD_mix_pulay_with_hsr(nfout,rmxt_tot)
- if ( sw_hubbard == ON ) then
+ call m_CD_mix_pulay_with_hsr(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
+ if ( sw_hubbard == ON .and. sw_mix_occ_matrix==OFF ) then
call Renewal_of_OccMat(.false., ON ) ! hsr --> om
- call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
endif
+ if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case default
stop ' ! waymix is invalid'
end select mixing_way
diff -uprN phase0_2015.01/src_phase_3d/Convergence_Check.F90 phase0_2015.01.01/src_phase_3d/Convergence_Check.F90
--- phase0_2015.01/src_phase_3d/Convergence_Check.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Convergence_Check.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! FUNCTION: Ending_Time(), ckiter(), ChargeDensity_is_Converged(),
! TotalEnergy_is_Divergent(), Forces_are_Converged(),
@@ -37,7 +37,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
logical function Ending_Time()
-! $Id: Convergence_Check.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Convergence_Check.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Const_Parameters, only : INITIAL, CONTINUATION, FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
use m_Files, only : nfstop,nfout,m_Files_open_nfstop,m_Files_close_nfstop
use m_IterationNumbers, only : iteration, iteration_ionic, iteration_electronic
@@ -45,6 +45,7 @@ logical function Ending_Time()
& , max_TS_iteration_is_given, max_mdstep_is_given, printable &
& , m_CtrlP_ckcput, m_CtrlP_rd_istop
use m_Parallelization, only : mype,mpi_comm_group
+
implicit none
include 'mpif.h' ! MPI
@@ -209,6 +210,12 @@ logical function ChargeDensity_is_Conver
& truncate_vxw_updating, sw_update_vxw, oneshot
! ======================================================================== 12.5Exp
+! === Postitron SCF === 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : positron_GGGC
+ use m_Positron_Wave_Functions, only : m_pWF_update_lifetime
+! ===================== 2015/11/28
+
implicit none
logical, save :: renew_wf_again = .false.
logical :: EigenValues_are_Converged
@@ -320,6 +327,10 @@ logical function ChargeDensity_is_Conver
! <--
end if
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == positron_GGGC ) call m_pWF_update_lifetime
+ endif
+
! =========================== KT_Test ================= 12.5Exp
if ( sw_hybrid_functional == ON ) then
if ( truncate_vxw_updating .and. sw_update_vxw == OFF ) then
@@ -1095,6 +1106,38 @@ logical function Positron_Defect()
end if
end function Positron_Defect
+! ==== Positron SCF === 2015/11/28
+logical function Positron_scf()
+ use m_Const_Parameters, only : OFF, Positron_CONV
+ use m_Control_Parameters, only : sw_positron, positron_method
+
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_CONV ) then
+ Positron_scf = .false.
+ else
+ Positron_scf = .true.
+ end if
+ else
+ Positron_scf = .false.
+ endif
+end function Positron_scf
+
+logical function Positron_nonscf()
+ use m_Const_Parameters, only : OFF, Positron_CONV
+ use m_Control_Parameters, only : sw_positron, positron_method
+
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_CONV ) then
+ Positron_nonscf = .true.
+ else
+ Positron_nonscf = .false.
+ end if
+ else
+ Positron_nonscf = .false.
+ endif
+end function Positron_nonscf
+! ========== 2015/11/28
+
logical function Structure_is_fixed()
! Coded by T. Yamasaki, 25 Jul. 2008
use m_Const_Parameters, only : ON, VERLET
diff -uprN phase0_2015.01/src_phase_3d/EsmPack/Esm.F90 phase0_2015.01.01/src_phase_3d/EsmPack/Esm.F90
--- phase0_2015.01/src_phase_3d/EsmPack/Esm.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/EsmPack/Esm.F90 2016-07-12 12:51:52.000000000 +0900
@@ -227,9 +227,9 @@ END SUBROUTINE esm_ggen_2d
SUBROUTINE esm_hartree (rhog, ehart, aux )
Use ESM_VARS
IMPLICIT NONE
-#ifdef __MPI__
- include 'mpif.h'
-#endif
+!#ifdef __MPI__
+! include 'mpif.h'
+!#endif
!
COMPLEX(8) :: rhog(ngm,nspin) ! n(G)
REAL(8), Intent(Out) :: ehart ! Hartree energy
@@ -339,22 +339,22 @@ SUBROUTINE esm_hartree (rhog, ehart, aux
vg3(1:nr3x,ng_2d)=vg2(1:nr3x)*2.d0
enddo
-#ifdef __MPI__
- n1h=nr1x/2;n2h=nr2x/2
- allocate(vg3_mpi(1:nr3x,-n2h:n2h,-n1h:n1h));vg3_mpi(:,:,:)=(0.d0,0.d0)
- do ng_2d=1,ngm_2d
- k1 = mill_2d(1,ng_2d)
- k2 = mill_2d(2,ng_2d)
- vg3_mpi(:,k2,k1) = vg3(:,ng_2d)
- enddo
- call mpi_allreduce(MPI_IN_PLACE,vg3_mpi,nr3x*nr2x*nr1x,mpi_double_complex,mpi_sum,communicator,ierr)
- do ng_2d=1,ngm_2d
- k1 = mill_2d(1,ng_2d)
- k2 = mill_2d(2,ng_2d)
- vg3(:,ng_2d) = vg3_mpi(:,k2,k1)
- enddo
- deallocate(vg3_mpi)
-#endif
+!#ifdef __MPI__
+! n1h=nr1x/2;n2h=nr2x/2
+! allocate(vg3_mpi(1:nr3x,-n2h:n2h,-n1h:n1h));vg3_mpi(:,:,:)=(0.d0,0.d0)
+! do ng_2d=1,ngm_2d
+! k1 = mill_2d(1,ng_2d)
+! k2 = mill_2d(2,ng_2d)
+! vg3_mpi(:,k2,k1) = vg3(:,ng_2d)
+! enddo
+! call mpi_allreduce(MPI_IN_PLACE,vg3_mpi,nr3x*nr2x*nr1x,mpi_double_complex,mpi_sum,communicator,ierr)
+! do ng_2d=1,ngm_2d
+! k1 = mill_2d(1,ng_2d)
+! k2 = mill_2d(2,ng_2d)
+! vg3(:,ng_2d) = vg3_mpi(:,k2,k1)
+! enddo
+! deallocate(vg3_mpi)
+!#endif
deallocate(vg2,vg2_in)
!$omp end parallel
@@ -507,9 +507,9 @@ SUBROUTINE esm_hartree (rhog, ehart, aux
vg3(1:nr3x,ng_2d)=vg2(1:nr3x)*2.d0
-#ifdef __MPI__
- call mpi_allreduce(MPI_IN_PLACE,vg3(1,ng_2d),nr3x,mpi_double_complex,mpi_sum,communicator,ierr)
-#endif
+!#ifdef __MPI__
+! call mpi_allreduce(MPI_IN_PLACE,vg3(1,ng_2d),nr3x,mpi_double_complex,mpi_sum,communicator,ierr)
+!#endif
deallocate(vg2,vg2_in)
endif ! if( ng_2d > 0 )
@@ -537,9 +537,9 @@ SUBROUTINE esm_hartree (rhog, ehart, aux
#ifdef __PARA
call mp_sum( ehart, intra_pool_comm )
#endif
-#ifdef __MPI__
- call mpi_allreduce(MPI_IN_PLACE,ehart,1,mpi_double_precision,mpi_sum,communicator,ierr)
-#endif
+!#ifdef __MPI__
+! call mpi_allreduce(MPI_IN_PLACE,ehart,1,mpi_double_precision,mpi_sum,communicator,ierr)
+!#endif
! Map to FFT mesh (nrxx)
aux=0.0d0
@@ -594,7 +594,6 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
!
! here the local variables
!
- real(8), external :: qe_erfc, qe_erf
real(8) :: gp2, t(2), gp, sa, z1, z0, L
integer :: k1, k2, k3, ipol, it1, it2, ng_2d
real(8) :: tt, z, zp, kk1, kk2, g, cc1, cc2, arg1, arg2, t1, t2, ff, argmax, ew
@@ -640,7 +639,7 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
tt=upf_zp(it1)*upf_zp(it2)*2.0*pi/sa
- kk1=0.5d0*(-(z-zp)*qe_erf(g*(z-zp))-exp(-g**2*(z-zp)**2)/g/sqrt(pi))
+ kk1=0.5d0*(-(z-zp)*erf(g*(z-zp))-exp(-g**2*(z-zp)**2)/g/sqrt(pi))
if (esm_bc.eq.'bc1') then
kk2=0.d0
@@ -668,8 +667,8 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cc1=cc1+(t1+t2)/4.d0/gp
if (esm_bc.eq.'bc1') then
@@ -708,8 +707,8 @@ SUBROUTINE esm_ewald ( charge, alpha, ew
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cc1=cc1+cos(ff)*(t1+t2)/4.d0/gp
if (esm_bc.eq.'bc1') then
@@ -791,8 +790,6 @@ subroutine esm_local_(nrx,aux,natm,ngaus
! here the local variables
!
complex(8),allocatable :: vloc3(:,:),vg2(:),vg2_in(:)
-! real(8), external :: qe_erf, qe_erfc
- real(8) :: qe_erf, qe_erfc
real(8) :: t(3),tt,gp,gp2,sa,z1,z0,pp,cc,ss,t1,t2, &
z,zp,arg11,arg12,arg21,arg22,v0,tmp,L,argmax, &
z_l,z_r
@@ -849,8 +846,8 @@ subroutine esm_local_(nrx,aux,natm,ngaus
arg21= gp*(z-zp)
arg21=min(arg21,argmax)
arg22= gp/2.d0/tmp+tmp*(z-zp)
- t1=exp(arg11)*qe_erfc(arg12)
- t2=exp(arg21)*qe_erfc(arg22)
+ t1=exp(arg11)*erfc(arg12)
+ t2=exp(arg21)*erfc(arg22)
cc1=cc1+bgauss(it,ig)*cs*(t1+t2)/4.d0/gp
enddo
if (esm_bc.eq.'bc1') then
@@ -909,7 +906,7 @@ subroutine esm_local_(nrx,aux,natm,ngaus
cc1=(0.d0,0.d0)
do ig=1,ngauss
tmp=sqrt(agauss(it,ig))
- cc1=cc1+bgauss(it,ig)*0.5d0*(-(z-zp)*qe_erf(tmp*(z-zp)) &
+ cc1=cc1+bgauss(it,ig)*0.5d0*(-(z-zp)*erf(tmp*(z-zp)) &
-exp(-tmp**2*(z-zp)**2)/tmp/sqrt(pi))
enddo
if (esm_bc.eq.'bc1') then
@@ -924,12 +921,12 @@ subroutine esm_local_(nrx,aux,natm,ngaus
! smoothing cell edge potential (avoiding unphysical oscillation)
do ig=1,ngauss
tmp=sqrt(agauss(it,ig))
- f1=f1+tt*bgauss(it,ig)*0.5d0*(-(z_r-zp)*qe_erf(tmp*(z_r-zp)) &
+ f1=f1+tt*bgauss(it,ig)*0.5d0*(-(z_r-zp)*erf(tmp*(z_r-zp)) &
-exp(-tmp**2*(z_r-zp)**2)/tmp/sqrt(pi))
- f2=f2+tt*bgauss(it,ig)*0.5d0*(-(z_l-zp)*qe_erf(tmp*(z_l-zp)) &
+ f2=f2+tt*bgauss(it,ig)*0.5d0*(-(z_l-zp)*erf(tmp*(z_l-zp)) &
-exp(-tmp**2*(z_l-zp)**2)/tmp/sqrt(pi))
- f3=f3-tt*bgauss(it,ig)*0.5d0*qe_erf(tmp*(z_r-zp))
- f4=f4-tt*bgauss(it,ig)*0.5d0*qe_erf(tmp*(z_l-zp))
+ f3=f3-tt*bgauss(it,ig)*0.5d0*erf(tmp*(z_r-zp))
+ f4=f4-tt*bgauss(it,ig)*0.5d0*erf(tmp*(z_l-zp))
enddo
if(esm_bc.eq.'bc1')then
f1=f1+tt*0.d0
@@ -1004,7 +1001,6 @@ subroutine esm_force_ew ( alpha, forceio
!
! here the local variables
!
- real(8), external :: qe_erfc, qe_erf
integer :: it1, it2, ipol, k1, k2, k3, ng_2d
integer :: nth, ith, omp_get_num_threads, omp_get_thread_num
real(8) :: t1_for, t2_for, z, zp, kk1_for, kk2_for, g, gp2, gp, z1, t(2), L
@@ -1052,7 +1048,7 @@ subroutine esm_force_ew ( alpha, forceio
endif
t2_for=upf_zp(it1)*upf_zp(it2)*fpi/sa
- kk1_for=0.5d0*qe_erf(g*(z-zp))
+ kk1_for=0.5d0*erf(g*(z-zp))
if (esm_bc.eq.'bc1') then
kk2_for=0.d0
else if (esm_bc.eq.'bc2') then
@@ -1078,8 +1074,8 @@ subroutine esm_force_ew ( alpha, forceio
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cz1_for=0.d0
if (esm_bc.eq.'bc1') then
cz2_for=0.d0
@@ -1119,8 +1115,8 @@ subroutine esm_force_ew ( alpha, forceio
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cx1_for=cx1_for+sin(ff)*(t1+t2)/4.d0/gp*k1
cy1_for=cy1_for+sin(ff)*(t1+t2)/4.d0/gp*k2
@@ -1175,8 +1171,8 @@ subroutine esm_force_ew ( alpha, forceio
arg2= gp*(z-zp)
arg1=min(arg1,argmax)
arg2=min(arg2,argmax)
- t1=exp(arg1)*qe_erfc(gp/2.d0/g-g*(z-zp))
- t2=exp(arg2)*qe_erfc(gp/2.d0/g+g*(z-zp))
+ t1=exp(arg1)*erfc(gp/2.d0/g-g*(z-zp))
+ t2=exp(arg2)*erfc(gp/2.d0/g+g*(z-zp))
cx1_for=cx1_for+sin(ff)*(t1+t2)/4.d0/gp*k1
cy1_for=cy1_for+sin(ff)*(t1+t2)/4.d0/gp*k2
@@ -1276,7 +1272,6 @@ subroutine esm_force_lc_ (nrx, aux, natm
!
complex(8),allocatable :: vlocx(:), vlocy(:), vlocdz(:)
real(8),allocatable :: for(:,:),for_g(:,:)
- real(8), external :: qe_erf, qe_erfc
real(8) :: t(3),tt,gp,gp2,sa,z1,z0,pp,cc,ss,t1,t2,z,zp,L,forcelc2(3,nat)
real(8) :: arg11,arg12,arg21,arg22,tmp,r1,r2,fx1,fy1,fz1,fx2,fy2,fz2,argmax
integer :: iz,ig,it,ipol,k1,k2,k3,ng,n1,n2,n3,ng_2d
@@ -1357,8 +1352,8 @@ subroutine esm_force_lc_ (nrx, aux, natm
arg21= gp*(z-zp)
arg21=min(arg21,argmax)
arg22= gp/2.d0/tmp+tmp*(z-zp)
- t1=exp(arg11)*qe_erfc(arg12)
- t2=exp(arg21)*qe_erfc(arg22)
+ t1=exp(arg11)*erfc(arg12)
+ t2=exp(arg21)*erfc(arg22)
cx1=cx1+bgauss(it,ig)*CMPLX(ss, -cc, kind=8) &
*(t1+t2)/4.d0/gp*k1
cy1=cy1+bgauss(it,ig)*CMPLX(ss, -cc, kind=8) &
@@ -1440,7 +1435,7 @@ subroutine esm_force_lc_ (nrx, aux, natm
cc1=(0.d0,0.d0)
do ig=1,ngauss
tmp=sqrt(agauss(it,ig))
- cc1=cc1+bgauss(it,ig)*(0.5d0*qe_erf(tmp*(z-zp)))
+ cc1=cc1+bgauss(it,ig)*(0.5d0*erf(tmp*(z-zp)))
enddo
if (esm_bc.eq.'bc1') then
cc2=(0.d0,0.d0)
diff -uprN phase0_2015.01/src_phase_3d/EsmPack/Makefile phase0_2015.01.01/src_phase_3d/EsmPack/Makefile
--- phase0_2015.01/src_phase_3d/EsmPack/Makefile 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/EsmPack/Makefile 2016-07-12 12:51:52.000000000 +0900
@@ -2,8 +2,8 @@
FFLAG = $(INCLUDE) $(OMPFLAG) $(MPIFLAG)
-OBJ = qe_erf.o fft.o vector.o Ewald.o Esm.o EsmInterface.o
-OBJ_P = qe_erf.o fft.o vector.o Ewald.o Esm.o EsmPack.o
+OBJ = fft.o vector.o Ewald.o Esm.o EsmInterface.o
+OBJ_P = fft.o vector.o Ewald.o Esm.o EsmPack.o
LIBFLAG = -L/usr/local/lib -lfftw3 -lblas -llapack
.f90.o:
diff -uprN phase0_2015.01/src_phase_3d/EsmPack/qe_erf.f90 phase0_2015.01.01/src_phase_3d/EsmPack/qe_erf.f90
--- phase0_2015.01/src_phase_3d/EsmPack/qe_erf.f90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/EsmPack/qe_erf.f90 1970-01-01 09:00:00.000000000 +0900
@@ -1,35 +0,0 @@
-! Copyright (c) 2012, Minoru Otani <minoru.otani@aist.go.jp>
-!
-! Permission is hereby granted, free of charge, to any person
-! obtaining a copy of this software and associated documentation
-! files (the "Software"), to deal in the Software without restriction,
-! including without limitation the rights to use, copy, modify, merge,
-! publish, distribute, sublicense, and/or sell copies of the Software,
-! and to permit persons to whom the Software is furnished to do so,
-! subject to the following conditions:
-
-! The above copyright notice and this permission notice shall be
-! included in all copies or substantial portions of the Software.
-
-! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-! OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-! NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-! HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-! WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
-! DEALINGS IN THE SOFTWARE.
-
-Function qe_erf(x)
- Implicit none
- Real(8), Intent(In) :: x
- Real(8) :: qe_erf
- qe_erf = erf(x)
-End Function qe_erf
-
-Function qe_erfc(x)
- Implicit none
- Real(8), Intent(In) :: x
- Real(8) :: qe_erfc
- qe_erfc = erfc(x)
-End Function qe_erfc
diff -uprN phase0_2015.01/src_phase_3d/Finalization_of_mpi.F90 phase0_2015.01.01/src_phase_3d/Finalization_of_mpi.F90
--- phase0_2015.01/src_phase_3d/Finalization_of_mpi.F90 2015-09-14 15:35:37.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Finalization_of_mpi.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 449 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! SUBROUINE: Finalization_of_mpi
!
@@ -14,7 +14,7 @@
!
!=======================================================================
subroutine Finalization_of_mpi
-! $Id: Finalization_of_mpi.F90 449 2015-08-06 04:37:59Z jkoga $
+! $Id: Finalization_of_mpi.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Parallelization, only : m_Parallel_end_mpi
use m_PlaneWaveBasisSet, only : m_pwBS_dealloc_ngpt_igfp_gr &
& , m_pwBS_dealloc_ylm_l
@@ -30,7 +30,7 @@ subroutine Finalization_of_mpi
use m_XC_Potential, only : m_XC_dealloc_vxc_3D
#endif
#ifdef _POSITRON_
- use m_epc_potential, only : m_epc_dealloc
+ use m_epc_potential, only : m_epc_dealloc, m_epc_dealloc_vlhxc_p
use m_Positron_Wave_Functions,only:m_pWF_deallocate_pzaj_etc
#endif
@@ -62,6 +62,7 @@ subroutine Finalization_of_mpi
#endif
#ifdef _POSITRON_
call m_epc_dealloc()
+ call m_epc_dealloc_vlhxc_p
call m_pWF_deallocate_pzaj_etc()
#endif
call m_ES_dealloc_Dhub()
diff -uprN phase0_2015.01/src_phase_3d/Initial_Electronic_Structure.F90 phase0_2015.01.01/src_phase_3d/Initial_Electronic_Structure.F90
--- phase0_2015.01/src_phase_3d/Initial_Electronic_Structure.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Initial_Electronic_Structure.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 481 $)
!
! SUBROUINE: Initial_Electronic_Structure, Initial_WaveFunctions_ek
!
@@ -31,7 +31,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine Initial_Electronic_Structure
-! $Id: Initial_Electronic_Structure.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: Initial_Electronic_Structure.F90 481 2016-03-25 02:51:57Z jkoga $
use m_Const_Parameters, only : Gauss_distrib_func, from_wave_functions&
& , INITIAL, CONTINUATION, FIXED_CHARGE &
& , FIXED_CHARGE_CONTINUATION, ON, OFF, EXECUT &
@@ -53,7 +53,9 @@ subroutine Initial_Electronic_Structure
& , nfcntn_bin_paw &
& , file_existance_contfiles &
& , m_Files_check_nfzaj_existance, m_Files_check_nfchgt_existance &
- & , m_Files_check_file_existance
+ & , m_Files_check_file_existance &
+ & , m_Files_open_nfcntn_bin_paw,m_Files_close_nfcntn_bin_paw &
+ & , m_Files_nfcntn_bin_paw_exists
use m_Control_Parameters, only : ipri, iprichargedensity, initial_chg, icond, nspin, intzaj &
& , evaluation_eko_diff &
& , skip_alloc_phonon, sw_phonon, sw_calc_force, neg, neg_previous &
@@ -118,7 +120,7 @@ subroutine Initial_Electronic_Structure
use m_PseudoPotential, only : qitg_l , nqitg &
& , psc_l &
& , rhvg_l &
- & , modnrm, m_PP_gfqwei_3D, flg_paw, epc
+ & , modnrm, m_PP_gfqwei_3D, flg_paw, epc, m_PP_rd_PAW_parameters
use m_XC_Potential, only : m_XC_cal_potential_3D
use m_Control_Parameters, only : nspin, af, kimg, from_PSEUDOPOTENTIAL_FILE &
& , istress,sw_fine_STM_simulation
@@ -209,6 +211,10 @@ subroutine Initial_Electronic_Structure
! ========================================= 13.0D
+! ==== EXP_CELLOPT === 2015/09/24
+ use m_IterationNumbers, only : iteration_unit_cell
+ use m_Control_Parameters, only : sw_read_nfchgt_prev_cell, sw_read_nfzaj_prev_cell
+! ==================== 2015/09/24
implicit none
integer :: iloop
@@ -384,7 +390,9 @@ subroutine Initial_Electronic_Structure
end if
!---- set wave functions ----
- if(intzaj == by_random_numbers) then
+ if ( iteration_unit_cell > 1 .and. sw_read_nfzaj_prev_cell == ON ) then
+ call read_zaj( condition =-4 )
+ else if(intzaj == by_random_numbers) then
#ifdef FJ_TIMER
! call mpi_barrier(mpi_comm_group, ierr)
call timer_sta(40)
@@ -402,7 +410,7 @@ subroutine Initial_Electronic_Structure
else if(intzaj == by_matrix_diagon) then
else if(intzaj == FILE) then
- call read_zaj()
+ call read_zaj( condition = 1 )
! === ik is not defined here!!! by tkato 2013/02/12 ============================
!!$ call m_ES_betar_dot_WFs_3D(nfout,ik) ! (fsrfsi)
do ik = 1, kv3, af+1
@@ -550,8 +558,11 @@ contains
end do
else
call m_CD_rd_chgq(nfout,nfchgt,F_CHGT_in_partitioned)
- if ( flg_paw .and. read_charge_hardpart == YES ) then
+ if ( flg_paw .and. read_charge_hardpart == YES .and. m_Files_nfcntn_bin_paw_exists()) then
+ call m_Files_open_nfcntn_bin_paw()
+ call m_PP_rd_PAW_parameters(nfout,nfcntn_bin_paw)
call m_CD_rd_hsr(nfcntn_bin_paw)
+ call m_Files_close_nfcntn_bin_paw()
endif
end if
@@ -562,7 +573,11 @@ contains
!!$ if ( flg_paw .and. ) then
!!$ call m_CD_rd_hsr(nfcntn_bin_paw)
!!$ endif
+
+ else if(condition == -4) then ! coordinate-continuation
+!
end if
+
end subroutine read_charge_density
subroutine read_efermi()
@@ -623,12 +638,12 @@ contains
subroutine EXX()
use m_ES_ExactExchange, only : m_ES_EXX_gather_valence_states, m_ES_EXX_kernel &
- & , m_ES_EXX_occup, sw_rspace_hyb &
+ & , m_ES_EXX_occup &
& , m_ES_EXX_init0 &
& , m_ES_EXX_ylm, m_ES_EXX_crotylm
call m_ES_EXX_init0()
if(modnrm == EXECUT ) then
- if(sw_rspace_hyb==OFF) call m_ES_EXX_ylm()
+ call m_ES_EXX_ylm()
call m_ES_EXX_crotylm()
end if
call m_ES_EXX_occup(nfout)
@@ -641,9 +656,17 @@ contains
call m_OP_rd_occ_mat(nfout) ! -> om
end subroutine read_occ_mat
- subroutine read_zaj()
+ subroutine read_zaj( condition )
+ integer, intent(in) :: condition
+
call m_Files_open_nfzaj()
- call m_ESIO_rd_WFs(nfout,nfzaj,F_ZAJ_in_partitioned)
+
+ if ( condition == 1 ) then
+ call m_ESIO_rd_WFs(nfout,nfzaj,F_ZAJ_in_partitioned)
+
+ else if ( condition == -4 ) then ! coordinate-continuation
+ endif
+
end subroutine read_zaj
subroutine check_neg()
diff -uprN phase0_2015.01/src_phase_3d/Initialization.F90 phase0_2015.01.01/src_phase_3d/Initialization.F90
--- phase0_2015.01/src_phase_3d/Initialization.F90 2015-08-05 15:07:35.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Initialization.F90 2016-07-12 12:51:52.000000000 +0900
@@ -77,6 +77,7 @@ subroutine Initialization(init_mpi)
! $Id: Initialization.F90 440 2015-08-03 07:18:01Z ktagami $
use m_Parallelization, only : m_Parallel_init_comm_world
use m_Parallelization, only : m_Parallel_get_nproc_from_arg_3D
+ use m_Control_Parameters,only: m_CtrlP_set_sw_scalapack
use m_Timing, only : m_Timing_wd_timenow, m_Timing_init_timer
use m_Files, only : nfout &
& , m_Files_open_standardout &
@@ -107,6 +108,9 @@ subroutine Initialization(init_mpi)
if(printable) call m_Timing_wd_timenow("program start")
call m_Parallel_get_nproc_from_arg_3D(printable)
+#ifdef _USE_SCALAPACK_
+ call m_CtrlP_set_sw_scalapack(printable)
+#endif
call aavers ! -(here)
endif
call m_Files_check_file_existance
@@ -160,7 +164,7 @@ contains
subroutine aavers
include 'version.h' ! svn_revision
character(len=72) :: vers, system, codename
- write(vers,'("phase/0 2015.01 Revision:",i5, " --- 3D_Parallel --")') svn_revision
+ write(vers,'("phase/0 2015.01.01 Revision:",i5," -- 3D_Parallel --")') svn_revision
codename = 'phaseUnif'
system = ''
diff -uprN phase0_2015.01/src_phase_3d/InputData_Analysis.F90 phase0_2015.01.01/src_phase_3d/InputData_Analysis.F90
--- phase0_2015.01/src_phase_3d/InputData_Analysis.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/InputData_Analysis.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 475 $)
!
! SUBROUINE: cnstr_fcvect_work_alloc, cnstr_fcvect_work_dealloc,
! get_CS_and_ionic_system_data, read_ntyp_natm_natm2, read_altv,
@@ -34,7 +34,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine InputData_Analysis()
-! $Id: InputData_Analysis.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: InputData_Analysis.F90 475 2016-02-23 05:22:18Z jkoga $
use m_Files, only : nfinp, nfout, nfcntn, file_existance_contfiles, file_existance_3contfiles &
& , m_Files_open_nfcntn &
& , m_Files_check_file_names &
@@ -76,7 +76,7 @@ subroutine InputData_Analysis()
& , sw_phonon, sw_positron &
& , driver &
& , sw_phonon, sw_wannier90 &
- & , fixed_charge_k_parallel &
+ & , fixed_charge_k_parallel, neg_is_given &
& , m_CtrlP_rd_parameters, m_CtrlP_rd_iconvergence &
& , m_CtrlP_rd_iconv_ek &
& , m_CtrlP_rd_numk_zajsaved &
@@ -149,12 +149,13 @@ subroutine InputData_Analysis()
integer :: iret, f_closeInputFile
logical :: ex
logical,save :: first_call = .true.
- logical :: initialization_required
+ logical :: initialization_required, inputfilestyle_is_new = .false.
if(.not.initialization_required()) return
if(m_CtrlP_check_inputfilestyle(nfinp) == NEW_) then
if(printable) write(nfout,'(" !*--- input-file style = NEW")')
+ inputfilestyle_is_new = .true.
call m_Files_reopen_nfinp(1)
if(first_call)then
call m_CtrlP_rd_printlevel(nfout)
@@ -165,10 +166,6 @@ subroutine InputData_Analysis()
call m_Files_open_nfdynm_cif_initially()
if(first_call) call m_CtrlP_rd_accuracy(nfout)
call m_CS_rd_n(nfout)
-#ifndef _EMPIRICAL_
- call m_CtrlP_rd_wfsolver(nfout)
- call m_CtrlP_rd_chargemix(nfout)
-#endif
call m_CtrlP_rd_struc_evol(nfout)
call m_CtrlP_rd_postproc(nfout)
#ifndef _EMPIRICAL_
@@ -178,6 +175,13 @@ subroutine InputData_Analysis()
call m_IS_rd_n(nfout)
call m_IS_set_ionic_mass(nfout)
+#ifndef _EMPIRICAL_
+ if(neg_is_given) then
+ call m_CtrlP_rd_wfsolver(nfout,natm2)
+ call m_CtrlP_rd_chargemix(nfout)
+ end if
+#endif
+
#ifndef _EMPIRICAL_
call m_PP_rd_window_param(nfout)
@@ -353,6 +357,25 @@ subroutine InputData_Analysis()
iret = f_closeInputFile()
first_call = .false.
+
+ if(.not.neg_is_given) then
+ call Check_of_Pseudopotential() !-(PseudoPotential_Construction.F90), set neg properly
+
+ if(inputfilestyle_is_new) then
+ call m_Files_reopen_nfinp(1)
+#ifndef _EMPIRICAL_
+!!$ call m_CtrlP_dealloc_wfsolver()
+ call m_CtrlP_rd_wfsolver(nfout,natm)
+ call m_CtrlP_rd_chargemix(nfout)
+#endif
+ iret = f_closeInputFile()
+ else
+ if(printable) then
+ write(nfout,'(" !** inputfilestyle = OLD, and you cannot omit number_of_bands in the inputfile")')
+ end if
+ stop 'inputfilestyle = OLD, and you cannot omit number_of_bands in the inputfile'
+ end if
+ end if
contains
subroutine cnstr_fcvect_work_alloc
if(printable) write(nfout,'(" ! natm = ",i6," << cnstr_fcvect_work_alloc >>")') natm
@@ -566,7 +589,7 @@ contains
end subroutine InputData_Analysis
subroutine InputData_Analysis_neb()
-! $Id: InputData_Analysis.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: InputData_Analysis.F90 475 2016-02-23 05:22:18Z jkoga $
use m_Files, only : nfout, nfcntn &
& , m_Files_reopen_nfcntn
use m_Ionic_System, only : m_IS_rd_pos_and_v
diff -uprN phase0_2015.01/src_phase_3d/Makefile phase0_2015.01.01/src_phase_3d/Makefile
--- phase0_2015.01/src_phase_3d/Makefile 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile 2016-07-12 13:15:25.000000000 +0900
@@ -0,0 +1,542 @@
+.SUFFIXES:
+.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+
+# Platform : GNU Linux (EM64T/AMD64)
+# Prog. model : MPI parallel
+# Compiler : Intel Fortran compiler
+# BLAS/LAPACK : System-installed MKL
+# FFT : System-installed FFTW3 library
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
+F90 = mpif90
+CC = gcc -m64
+CPP =
+AR = ar -vq
+LINK = mpif90
+F90FLAGS = -traceback
+F77FLAGS = -traceback
+CFLAGS = -O -DINTEL
+
+ESM = yes
+ifdef ESM
+CPPESM=-DENABLE_ESM_PACK
+LESM=-lesm
+else
+CPPESM=
+endif
+
+CPPFLAGS = -DLinux -DFFTW3 -D_MPIFFT_ -DDISABLE_VDWDF -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DPAW3D -DUSE_NONBLK_COMM ${CPPESM}
+LFLAGS =
+F90FLAGS_FIXED = -extend_source -Fl -fixed
+F90FLAGS_FREE = -extend_source -Fl
+MKLHOME=
+INCLUDE=
+LIBS = -L./ ${LESM} -Wl,--start-group -lmkl_scalapack_lp64 -lmkl_blacs_intelmpi_lp64 -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -Bdynamic -lfftw3 -lpthread
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
+
+ifdef ESM
+ESM_LIB = libesm.a
+else
+ESM_LIB =
+endif
+LAPACK =
+FFTOBJECT = mpifft.o
+OBJ_INPUTPARSE = input_parse.o
+
+
+PHASE_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o #z_tool_timer.o
+
+PHASE_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_ES_occup.o \
+m_FiniteElectricField.o \
+m_ES_ExactExchange.o \
+m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
+m_CD_Mag_Moment.o \
+m_epc_potential.o \
+m_Positron_Wave_Functions.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_WF_by_MatDiagon.o m_ES_dos.o m_Hubbard.o \
+m_KineticEnergy_Density.o \
+m_vdWDF.o \
+m_Ldos.o m_XC_Potential.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_OP_Moment.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o \
+m_constraints.o \
+m_ELF.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o \
+m_Wannier.o m_Replica.o Renewal_of_ChgCtrlParam.o \
+m_LinearResponse_Control.o \
+m_LinearResponse_Qpt.o \
+m_rttddft.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o
+
+PHASE_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+PHASE_F_OTHERSUBS = mdmain.o constraint_main.o meta_dynamics.o NEB.o Preparation_for_mpi.o \
+Preparation_for_ESM.o \
+scf_routines.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o\
+input_interface.o Initialization.o \
+WriteDownData_onto_Files.o Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o \
+Renewal_of_WaveFunctions.o \
+Renewal_of_pWaveFunctions.o \
+IterationNumbers_Setting.o ChargeDensity_Construction.o \
+ChargeDensity_Mixing.o Renewal_of_Potential.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Renewal_of_pPotential.o Renewal_of_Hubbard_Parameters.o \
+Convergence_Check.o Forces.o \
+Move_Ions.o Initial_MD_Condition.o \
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o miscellaneous.o\
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+mpi_dummy.o WriteDownData_onto_Files_ek.o \
+GaussLeg.o lib_int_deri_add.o \
+rttddft_main.o \
+Potential_Construction.o Potential_Mixing.o ThomasFermiWeiz.o \
+Epsilon_postscf.o vdW.o
+
+# for vc_nl
+NLOBJ = vc_nl.o
+
+ifndef SX_DGEMM
+PHASE_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o \
+gncpp_xc_gga_rad.o \
+decfft_ent.o \
+spg+tetra.o
+else
+PHASE_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+spg+tetra.o \
+dgemm__.o
+endif
+
+EKCAL_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+EKCAL_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_epc_potential.o \
+m_Positron_Wave_Functions.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
+m_CD_Mag_Moment.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_WF_by_MatDiagon.o m_ES_dos.o m_Hubbard.o \
+m_KineticEnergy_Density.o \
+m_vdWDF.o \
+m_Ldos.o m_XC_Potential.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_constraints.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o\
+m_ELF.o m_Wannier.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o \
+m_LinearResponse_Control.o \
+m_LinearResponse_Qpt.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o
+
+
+EKCAL_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+EKCAL_F_OTHERSUBS = ekmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o\
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+vdW.o
+
+ifndef SX_DGEMM
+EKCAL_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+gncpp_xc_gga_rad.o \
+decfft_ent.o
+else
+EKCAL_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+EPS_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+EPS_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_Positron_Wave_Functions.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_dos.o m_Hubbard.o \
+m_epc_potential.o \
+m_vdWDF.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
+m_CD_Mag_Moment.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o m_ES_WF_by_MatDiagon.o \
+m_KineticEnergy_Density.o \
+m_Ldos.o m_ELF.o \
+m_constraints.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_Wannier.o m_Wannier90.o \
+m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
+m_ES_occup_EPS.o m_Epsilon_ek.o \
+m_LinearResponse_Control.o \
+m_LinearResponse_Qpt.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o
+
+EPS_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+EPS_F_OTHERSUBS = epsmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o\
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+Initialization_Epsilon.o Shift_Kpoint.o \
+Reset_Kpoint.o Preparation_for_Calc_Epsilon.o \
+Transition_moment_Epsilon.o Calc_Epsilon.o \
+Nonlinear_Optics_Epsilon.o WriteDownData_onto_Files_Epsilon.o \
+PseudoPotential_ek_Epsilon.o Dealloc_Radr_and_Wos_Epsilon.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+vdW.o
+
+ifndef SX_DGEMM
+EPS_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o
+else
+EPS_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+TDLR_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
+m_IterationNumbers.o
+
+TDLR_UPPER_MODULES = \
+m_Control_Parameters.o m_Files.o m_Timing.o \
+m_Crystal_Structure.o m_FFT.o m_Ionic_System.o \
+m_CS_SpaceGroup.o m_CS_Magnetic.o \
+m_Orbital_QuantumNum.o \
+m_Kpoints.o m_PseudoPotential.o m_PlaneWaveBasisSet.o \
+m_Realspace.o \
+m_SpinOrbit_Potential.o m_SpinOrbit_FromFile.o \
+m_ES_NonCollinear.o \
+m_NonLocal_Potential.o m_Electronic_Structure.o \
+m_ES_nonlocal.o m_ES_ortho.o m_ES_wf_extrpl.o m_ES_initialWF.o \
+m_FiniteElectricField.o \
+m_Positron_Wave_Functions.o \
+m_ES_ExactExchange.o \
+m_ES_occup.o m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
+m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
+m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
+m_ES_dos.o m_Hubbard.o \
+m_epc_potential.o \
+m_vdWDF.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
+m_CD_Mag_Moment.o \
+string.o m_db.o \
+m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
+m_PAW_XC_Potential.o \
+m_SpinOrbit_RadInt.o \
+m_ES_Mag_Constraint.o \
+m_Total_Energy.o \
+m_OP_Moment.o \
+m_Force.o m_Stress.o m_ES_WF_by_submat.o m_ES_WF_by_MatDiagon.o \
+m_UnitCell.o \
+m_KineticEnergy_Density.o \
+m_Ldos.o m_ELF.o \
+m_constraints.o \
+m_BerryPhase.o m_BP_Properties.o \
+m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
+m_Wannier.o m_Wannier90.o \
+m_Screening_FFT.o m_Screening.o m_External_Potential.o \
+m_Excitation.o \
+m_ES_occup_EPS.o \
+m_LinearResponse_Control.o \
+m_LinearResponse_Qpt.o \
+m_LinearResponse_Tools.o m_LinearResponse_Density.o \
+m_LinearResponse_NonInt.o m_LinearResponse_ALDA.o \
+m_LinearResponse_Kernel.o m_LinearResponse_BS.o \
+m_LinearResponse_Spectrum.o \
+m_Potential_Mixing.o m_ThomasFermiW_Potential.o
+
+TDLR_F_SUBROUTINES = Preparation.o \
+InputData_Analysis.o PseudoPotential_Construction.o
+
+TDLR_F_OTHERSUBS = tdlrmain.o constraint_main.o Preparation_for_mpi.o \
+scf_routines.o \
+bottom_Subroutines.o \
+spline.o \
+b_Crystal_Structure.o b_Electronic_Structure.o \
+b_Words.o b_PseudoPotential.o \
+b_PseudoPotential_EXX.o \
+b_Fermi.o b_Kpoints.o \
+b_PlaneWaveBasisSet.o b_Ionic_System.o \
+b_XC_Potential.o b_PAW_XC_Potential.o \
+b_XC_OmegaPBE.o \
+b_XC_metagga.o \
+b_Ldos_f77.o \
+input_interface.o Initialization.o \
+Ewald_and_Structure_Factor.o \
+Initial_Electronic_Structure.o Renewal_of_WaveFunctions.o \
+IterationNumbers_Setting.o \
+ChargeDensity_Construction.o Renewal_of_Potential.o \
+ChargeDensity_Mixing.o \
+Renewal_of_Hubbard_Potential.o Renewal_of_OccMat.o \
+Convergence_Check.o Forces.o \
+WriteDownData_onto_Files.o \
+Initial_MD_Condition.o WriteDownData_onto_Files_ek.o \
+Stress.o Postprocessing.o \
+Finalization_of_mpi.o \
+miscellaneous.o \
+b_BerryPhase.o \
+heap_sort.o real_spherical_harmonics.o \
+Real_space_integ.o crotylm.o \
+screening_correction.o \
+PseudoPotential_ek_Epsilon.o \
+mpi_dummy.o \
+GaussLeg.o lib_int_deri_add.o \
+ThomasFermiWeiz.o Renewal_of_ChgCtrlParam.o \
+b_LinearResponse_Kernel.o b_LinearResponse_exc.o \
+LinearResponse_Proc.o LinearResponse_Spec.o \
+vdW.o
+
+ifndef SX_DGEMM
+TDLR_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o
+else
+TDLR_OBJECTSF77 = \
+b_PseudoPotential_f77.o \
+b_Force_f77.o \
+rmmsubs.o spg+tetra.o \
+decfft_ent.o \
+gncpp_xc_gga_rad.o \
+dgemm__.o
+endif
+
+
+
+PHASE_OBJECTS = $(FFTOBJECT) $(PHASE_LOWER_MODULES) $(PHASE_UPPER_MODULES) $(PHASE_F_SUBROUTINES) $(PHASE_F_OTHERSUBS) $(PHASE_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+EKCAL_OBJECTS = $(FFTOBJECT) $(EKCAL_LOWER_MODULES) $(EKCAL_UPPER_MODULES) $(EKCAL_F_SUBROUTINES) $(EKCAL_F_OTHERSUBS) $(EKCAL_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+EPS_OBJECTS = $(FFTOBJECT) $(EPS_LOWER_MODULES) $(EPS_UPPER_MODULES) $(EPS_F_SUBROUTINES) $(EPS_F_OTHERSUBS) $(EPS_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+TDLR_OBJECTS = $(FFTOBJECT) $(TDLR_LOWER_MODULES) $(TDLR_UPPER_MODULES) $(TDLR_F_SUBROUTINES) $(TDLR_F_OTHERSUBS) $(TDLR_OBJECTSF77) $(OBJ_INPUTPARSE)
+
+all : phase epsmain
+
+ifdef ESM
+phase : $(ESM_LIB) $(LAPACK) $(PHASE_OBJECTS) $(NLOBJ)
+ $(LINK) $(PHASE_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+else
+phase : $(LAPACK) $(PHASE_OBJECTS) $(NLOBJ)
+ $(LINK) $(PHASE_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+endif
+
+ekcal : $(LAPACK) $(EKCAL_OBJECTS) $(NLOBJ)
+ $(LINK) $(EKCAL_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+epsmain : $(LAPACK) $(EPS_OBJECTS) $(NLOBJ)
+ $(LINK) $(EPS_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+tdlrmain : $(LAPACK) $(TDLR_OBJECTS) $(NLOBJ)
+ $(LINK) $(TDLR_OBJECTS) $(NLOBJ) $(LFLAGS) $(LIBS) -o $@
+
+ifdef NO_MPI
+libesm.a:
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="" AR="$(AR)"
+else
+libesm.a:
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
+endif
+
+liblapack.a:
+ cd LAPACK; make F77="$(F90)" F77FLAGS="$(F77FLAGS)" AR="$(AR)"
+
+libblas.a:
+ cd BLAS; make F77="$(F90)" F77FLAGS="$(F77FLAGS)" AR="$(AR)"
+
+$(OBJ_INPUTPARSE):$(@:.o=.c) $(@:.o=.h)
+ $(CC) -c $(CFLAGS) $(@:.o=.c)
+
+.f.o:
+ $(F90) -c $(F77FLAGS) $*.f
+
+.f90.o:
+ $(F90) -c $(F90FLAGS) $*.f90
+
+.F.o:
+ $(F90) -c $(F77FLAGS) $(CPPFLAGS) $*.F
+
+.F90.o:
+ $(F90) -c $(F90FLAGS) $(CPPFLAGS) $*.F90
+
+clean:
+ \rm -f *.o *.mod *.a *.lib *.L *.list phase epsmain
+ \cd LAPACK; make clean
+ \cd BLAS; make clean
+ \cd EsmPack; make clean
+
+install: phase epsmain
+ \mv -f phase ../bin/phase.3d
+ \mv -f epsmain ../bin/epsmain.3d
diff -uprN phase0_2015.01/src_phase_3d/Makefile.K phase0_2015.01.01/src_phase_3d/Makefile.K
--- phase0_2015.01/src_phase_3d/Makefile.K 2015-10-18 02:53:28.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile.K 2016-07-28 03:57:57.082513457 +0900
@@ -1,6 +1,9 @@
.SUFFIXES:
.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
F90 = mpifrtpx
CC = fccpx
CPP =
@@ -10,7 +13,7 @@ F90FLAGS = -Nsetvalue -Kfast,parallel,op
F77FLAGS = -Nsetvalue -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 -c -V -Qa,d,i,p,t,x -Koptmsg=2
CFLAGS = -DINTEL -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2
-ESM=YES
+ESM = yes
ifdef ESM
CPPESM=-DENABLE_ESM_PACK
LESM=-lesm
@@ -18,16 +21,15 @@ else
CPPESM=
endif
+CPPFLAGS = -DLinux -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DPAW3D -DUSE_NONBLK_COMM ${CPPESM}
+LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
INCLUDE=-I/home/apps/fftw/3.3/include
-
-CPPFLAGS = -DLinux -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DUSE_NONBLK_COMM ${CPPESM}
-
-LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
-LIBS = -L./ ${LESM} -Kopenmp -lm -SSL2MPI -SSL2BLAMP -SCALAPACK \
+LIBS = -L./ ${LESM} -Kopenmp -lm -SSL2MPI -SSL2BLAMP -SCALAPACK \
-L/home/apps/fftw/3.3/lib64 -lfftw3 -lfftw3_omp -lfftw3_mpi $(KLINK) $(EIGEN_LIBS) #/opt/FJSVtclang/GM-1.2.0-13/lib64/libtofupa.o
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
+
ifdef ESM
ESM_LIB = libesm.a
else
@@ -39,7 +41,7 @@ OBJ_INPUTPARSE = input_parse.o
PHASE_LOWER_MODULES = m_Const_Parameters.o m_ErrorMessages.o m_Parallelization.o \
-m_IterationNumbers.o
+m_IterationNumbers.o #z_tool_timer.o
PHASE_UPPER_MODULES = \
m_Control_Parameters.o m_Files.o m_Timing.o \
@@ -57,7 +59,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -167,7 +169,7 @@ m_ES_occup.o m_ES_WF_by_SDor
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
@@ -271,7 +273,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -286,7 +288,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -379,7 +380,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -395,7 +396,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase_3d/Makefile.frtpx phase0_2015.01.01/src_phase_3d/Makefile.frtpx
--- phase0_2015.01/src_phase_3d/Makefile.frtpx 2015-10-18 02:54:02.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile.frtpx 2016-07-28 03:58:08.816858850 +0900
@@ -1,14 +1,17 @@
.SUFFIXES:
.SUFFIXES: .o .F .f .F90 .f90 .c .mod
+###########################################################################
+###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
+###########################################################################
F90 = mpifrtpx
CC = fccpx
CPP =
AR = ar qv
LINK = mpifrtpx
-F90FLAGS = -Nsetvalue -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 -c -V -Qa,d,i,p,t,x -Koptmsg=2
-F77FLAGS = -Nsetvalue -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 -c -V -Qa,d,i,p,t,x -Koptmsg=2
-CFLAGS = -DINTEL -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2
+F90FLAGS = -Kparallel,ocl,preex,array_private,auto,simd=2,openmp -c -V -Qa,d,i,p,t,x -Koptmsg=2
+F77FLAGS = -Kparallel,ocl,preex,array_private,auto,simd=2,openmp -c -V -Qa,d,i,p,t,x -Koptmsg=2
+CFLAGS = -DINTEL -Kfast,parallel,ocl,preex,array_private,auto,simd=2,openmp -DINTEL
ESM=YES
ifdef ESM
@@ -18,12 +21,10 @@ else
CPPESM=
endif
-INCLUDE=-I/usr/local/fftw/3.3/include
-
CPPFLAGS = -DLinux -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DUSE_NONBLK_COMM ${CPPESM}
-
-LFLAGS = -Kfast,parallel,openmp,ocl,preex,array_private,auto,simd=2,mfunc=2 #-W0,-zprl=Src2ex
-LIBS = -L./ ${LESM} -L/usr/local/fftw/3.3/lib64 -lfftw3 -lfftw3_omp -lfftw3_mpi -SSL2BLAMP $(KLINK) -SCALAPACK -Kopenmp #ScaLAPACK+FFTW3.3
+LFLAGS = -Kfast,parallel,ocl,preex,array_private,auto,simd=2,openmp,mfunc=2 -DINTEL #-W0,-zprl=Src2ex
+INCLUDE=-I/usr/local/fftw/3.3/lib64/../include
+LIBS = -L./ ${LESM} -L/usr/local/fftw/3.3/lib64 -lfftw3 -lfftw3_omp -lfftw3_mpi -SSL2BLAMP $(KLINK) -SCALAPACK -Kopenmp #ScaLAPACK+FFTW3.3
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
@@ -56,7 +57,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -166,7 +167,7 @@ m_ES_occup.o m_ES_WF_by_SDor
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
@@ -270,7 +271,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -285,7 +286,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -378,7 +378,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -394,7 +394,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase_3d/Makefile.gfortran+scalapack+fftw+mpi phase0_2015.01.01/src_phase_3d/Makefile.gfortran+scalapack+fftw+mpi
--- phase0_2015.01/src_phase_3d/Makefile.gfortran+scalapack+fftw+mpi 2015-10-17 06:47:49.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile.gfortran+scalapack+fftw+mpi 2016-07-28 03:39:18.885026857 +0900
@@ -26,7 +26,7 @@ else
CPPESM=
endif
-CPPFLAGS = -DLinux -D_GNU_FORTRAN_ -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DUSE_NONBLK_COMM ${CPPESM}
+CPPFLAGS = -DLinux -D_GNU_FORTRAN_ -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DPAW3D -DUSE_NONBLK_COMM ${CPPESM}
LFLAGS =
INCLUDE=-I/usr/local/fftw/include
LAPACK_LIB = -L/usr/local/scalapack -lscalapack -L/usr/local/lapack -llapack -lblas
@@ -65,7 +65,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -175,7 +175,7 @@ m_ES_occup.o m_ES_WF_by_SDor
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
@@ -279,7 +279,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -294,7 +294,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -387,7 +386,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -403,7 +402,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase_3d/Makefile.ifort+mpi phase0_2015.01.01/src_phase_3d/Makefile.ifort+mpi
--- phase0_2015.01/src_phase_3d/Makefile.ifort+mpi 2015-10-18 13:03:06.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile.ifort+mpi 2016-07-28 03:14:00.645108340 +0900
@@ -26,15 +26,17 @@ else
CPPESM=
endif
-CPPFLAGS = -DLinux -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DUSE_NONBLK_COMM ${CPPESM}
+CPPFLAGS = -DLinux -DFFTW3 -D_MPIFFT_ -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DPAW3D -DUSE_NONBLK_COMM ${CPPESM}
LFLAGS = -mkl
MKLROOT=/opt/intel/mkl
INCLUDE=-I$(MKLROOT)/include/fftw
# Intel MKL (intel64)
LAPACK_LIB = -lmkl_scalapack_lp64 -lmkl_blacs_intelmpi_lp64 -lmkl_sequential
+#LAPACK_LIB = -lmkl_scalapack_lp64 -lmkl_blacs_openmpi_lp64 -lmkl_sequential
#LAPACK_LIB = -L$(MKLROOT)/lib/intel64 -lmkl_scalapack_lp64 -lmkl_blacs_intelmpi_lp64 -lmkl_intel_lp64 -lmkl_sequential -lmkl_core
# Intel MKL (ia32)
#LAPACK_LIB = -lmkl_scalapack_core -lmkl_blacs_intelmpi -lmkl_sequential
+#LAPACK_LIB = -lmkl_scalapack_core -lmkl_blacs_openmpi -lmkl_sequential
#LAPACK_LIB = -L$(MKLROOT)/lib/ia32 -lmkl_scalapack_core -lmkl_blacs_intelmpi -lmkl_intel -lmkl_sequential -lmkl_core
#FFT_LIB = -L$(MKLROOT)/interfaces/fftw3xf -lfftw3xf_intel
LIBS = -L. ${LESM} $(LAPACK_LIB) $(FFT_LIB)
@@ -71,7 +73,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -181,7 +183,7 @@ m_ES_occup.o m_ES_WF_by_SDor
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
@@ -285,7 +287,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -300,7 +302,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -393,7 +394,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -409,7 +410,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase_3d/Makefile.mpiifort+mkl phase0_2015.01.01/src_phase_3d/Makefile.mpiifort+mkl
--- phase0_2015.01/src_phase_3d/Makefile.mpiifort+mkl 2015-08-05 16:29:28.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile.mpiifort+mkl 2016-07-12 12:51:52.000000000 +0900
@@ -66,7 +66,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -176,7 +176,7 @@ m_ES_occup.o m_ES_WF_by_SDor
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
@@ -280,7 +280,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -295,7 +295,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -388,7 +387,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -404,7 +403,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase_3d/Makefile.tmpl phase0_2015.01.01/src_phase_3d/Makefile.tmpl
--- phase0_2015.01/src_phase_3d/Makefile.tmpl 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Makefile.tmpl 2016-07-12 12:51:52.000000000 +0900
@@ -18,7 +18,7 @@ m_FiniteElectricField.o \
m_ES_ExactExchange.o \
m_ES_WF_by_SDorCG.o m_ES_WF_by_Davidson.o \
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
@@ -128,7 +128,7 @@ m_ES_occup.o m_ES_WF_by_SDor
m_ES_WF_by_ModifiedDavidson.o m_ES_WF_by_RMM.o \
m_epc_potential.o \
m_Positron_Wave_Functions.o \
-m_Charge_Density.o m_CD_mixing.o m_Dipole.o m_Orbital_Population.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_Dipole.o \
m_CD_Mag_Moment.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_ES_LHXC.o m_ES_Intgr_VlhxcQlm.o m_ES_IO.o \
@@ -232,7 +232,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -247,7 +247,6 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Wannier.o m_Wannier90.o \
m_ValenceBand_Spectrum.o m_CoreLevel_Spectrum.o \
@@ -340,7 +339,7 @@ m_ES_LHXC.o m_ES_Intgr_Vlhx
m_ES_dos.o m_Hubbard.o \
m_epc_potential.o \
m_vdWDF.o \
-m_Charge_Density.o m_CD_mixing.o m_XC_Potential.o \
+m_Charge_Density.o m_Orbital_Population.o m_CD_mixing.o m_XC_Potential.o \
m_CD_Mag_Moment.o \
string.o m_db.o \
m_PAW_Tecplot.o m_PAW_ChargeDensity.o m_PAW_Hartree.o \
@@ -356,7 +355,7 @@ m_Ldos.o m_ELF.o \
m_constraints.o \
m_BerryPhase.o m_BP_Properties.o \
m_Representation.o m_Raman.o m_Phonon.o m_Dipole.o \
-m_Orbital_Population.o m_Wannier.o m_Wannier90.o \
+m_Wannier.o m_Wannier90.o \
m_Screening_FFT.o m_Screening.o m_External_Potential.o \
m_Excitation.o \
m_ES_occup_EPS.o \
diff -uprN phase0_2015.01/src_phase_3d/Move_Ions.F90 phase0_2015.01.01/src_phase_3d/Move_Ions.F90
--- phase0_2015.01/src_phase_3d/Move_Ions.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Move_Ions.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 482 $)
!
! SUBROUINE: Move_Ions, wd_cps_and_forces
!
@@ -33,11 +33,11 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine Move_Ions
-! $Id: Move_Ions.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Move_Ions.F90 482 2016-04-08 08:40:45Z jkoga $
use m_Control_Parameters, only : iprimd, c_iteration2GDIIS &
& , m_CtrlP_what_is_mdalg &
& , m_CtrlP_set_gdiisoptmode &
- & , sw_charge_predictor,sw_wf_predictor,sw_rspace
+ & , sw_charge_predictor,sw_wf_predictor,sw_rspace,af
use m_Const_Parameters, only : DP, TEMPERATURE_CONTROL, VERLET &
&, BLUEMOON, QUENCHED_CONSTRAINT, QUENCHED_MD, NORMAL_MODE_ANALYSIS &
&, HYPERPLANE_ADAPTIVE_COORDINATE, HAC, T_CONTROL, GDIIS, ORDINA &
@@ -50,7 +50,8 @@ subroutine Move_Ions
& , m_IS_cp_cps2cpo,m_IS_wd_pos_and_v &
& , m_IS_phonon_force, m_IS_cg, m_IS_cg2 &
& , m_IS_evaluate_v_verlet &
- & , m_IS_update_cps_history
+ & , m_IS_update_cps_history &
+ & , m_IS_force_af_symmetry
!!$ & , forcmx_constraint_quench, almda, mdmode &
use m_Force, only : forc_l, forcmx
use m_IterationNumbers, only : iteration_ionic,iteration
@@ -150,6 +151,8 @@ subroutine Move_Ions
endif
! ============================================================== 13.0B
+ if (af/=0) call m_IS_force_af_symmetry(nfout)
+
if(iprimd >= 2) call m_IS_wd_forc(forc_l)
if(sw_rspace==ON)then
diff -uprN phase0_2015.01/src_phase_3d/NEB.F90 phase0_2015.01.01/src_phase_3d/NEB.F90
--- phase0_2015.01/src_phase_3d/NEB.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/NEB.F90 2016-07-12 12:51:52.000000000 +0900
@@ -106,6 +106,9 @@ subroutine do_neb()
if (.not.pp_generated) then
call PseudoPotential_Construction
pp_generated = .true.
+#ifdef ENABLE_ESM_PACK
+ call Preparation_for_ESM()
+#endif
else
if ( flg_paw ) then
if ( itr > 1 .or. neb%cond%condition == 1 ) then
diff -uprN phase0_2015.01/src_phase_3d/Postprocessing.F90 phase0_2015.01.01/src_phase_3d/Postprocessing.F90
--- phase0_2015.01/src_phase_3d/Postprocessing.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Postprocessing.F90 2016-07-12 12:51:52.000000000 +0900
@@ -50,7 +50,7 @@
!
!$$#ifndef PARA3D
subroutine Postprocessing(ignore_convergence)
-! $Id: Postprocessing.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: Postprocessing.F90 489 2016-05-24 04:15:54Z ktagami $
use m_Const_Parameters, only : DP, ON, OFF, FORCE_CONVERGED, INITIAL, CONTINUATION &
& , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION &
& , Gauss_distrib_func, EK, SCF &
@@ -86,7 +86,7 @@ subroutine Postprocessing(ignore_converg
use m_Ionic_System, only : natm, natm2, ityp, iwei, iatomn, pos &
& , m_IS_pack_all_ions_in_uc &
& , m_IS_set_natm_prim,m_IS_set_napt_prim
- use m_PseudoPotential, only : ival
+ use m_PseudoPotential, only : ival, flg_paw
use m_Files, only : nfout,nfdos,nfchr,nfwfk,nfldos,nfelf &
& , nfvlc, nfcntn_bin_stm &
& , m_Files_open_nfdos, m_Files_open_nfchr &
@@ -184,7 +184,7 @@ subroutine Postprocessing(ignore_converg
use m_Control_Parameters, only : sw_wf_squared_rspace, charge_filetype, &
- & sw_wf_integ_moment
+ & sw_wf_integ_moment, sw_calc_contact_density
implicit none
@@ -253,7 +253,6 @@ subroutine Postprocessing(ignore_converg
end if
end if
-! ============== KT_add ====================== 13.0E
if ( m_CtrlP_way_of_smearing() == Fermi_Dirac ) then
if ( ekmode == ON ) then
call m_ESoc_count_charge_belowEF_ek( nfout )
@@ -261,28 +260,19 @@ subroutine Postprocessing(ignore_converg
call m_ESoc_count_charge_belowEF( nfout )
endif
endif
-! ============================================ 13.0E
! -------- Population ----
! --------- DOS ------
-!
-! ================================ modified by K. Tagami ============ 11.0
-!! if(sw_dos == ON) call calc_totaldos()
- ! contained in this file, calculate total dos
-!
if (sw_dos == ON) then
call m_ESdos_alloc_dos_weight()
call calc_totaldos()
end if
-! =================================================================== 11.0
! ---- LDOS ----------
!
if(sw_ldos == ON) then
-! =================== added by K. Tagami =============== 11.0
call calc_localdos()
-! ======================================================= 11.0
end if
! ------ Charge Distrib ----
@@ -301,7 +291,6 @@ subroutine Postprocessing(ignore_converg
! ------ STM or Work function ---
!
if (sw_fine_STM_simulation == ON) then
-!!$ call write_potential_for_STM_noncl
call write_potential_for_STM
endif
@@ -445,7 +434,6 @@ contains
end subroutine calc_totaldos
-! ===================== added by K. Tagami ====================== 11.0
subroutine calc_localdos()
if (ekmode == OFF) then
@@ -526,9 +514,7 @@ contains
end subroutine calc_localdos
-! ============================================================== 11.0
-! ========================= added by K. Tagami =============== 11.0
subroutine calc_spatial_chg_distrib
integer :: iloop, iloop2
@@ -663,9 +649,8 @@ contains
end subroutine calc_partial_charge
-! ============================================================ 11.0
-! ============================ added by K. Tagami ================= 11.0
+
subroutine write_potential_for_STM
integer :: ismax
@@ -720,14 +705,9 @@ contains
end subroutine write_potential_for_STM
-! ================================================================= 11.0
-!================================== modified by K. Tagami ========== 11.0
-! subroutine wd_fine_STM_parameters()
-!
subroutine wd_fine_STM_parameters( ismax )
integer, intent(in) :: ismax
-! ================================================================= 11.0
integer :: ik
write(nfout,'(" !!STM: kg(kng) = ",i8)') kg
@@ -770,12 +750,8 @@ contains
end do
end subroutine check_neordr_nrvf_ordr
-! ====================================== modified by K. Tagami ========== 11.0
-! subroutine wd_ArraySize_Parameters_For_STM(nf_bin)
-!
subroutine wd_ArraySize_Parameters_For_STM( nf_bin, ismax )
integer, intent(in) :: ismax
-! ======================================================================== 11.0
integer, intent(in) :: nf_bin
if(mype == 0) then
diff -uprN phase0_2015.01/src_phase_3d/Preparation.F90 phase0_2015.01.01/src_phase_3d/Preparation.F90
--- phase0_2015.01/src_phase_3d/Preparation.F90 2015-09-14 15:36:00.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Preparation.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 458 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 474 $)
!
! SUBROUINE: fft_box_finding_way, Preparation, Preparation_ek
!
@@ -36,8 +36,17 @@
#define _INCLUDE_EXX_
#endif
+#ifdef FJ_TIMER
+# define __TIMER_FJ_START_w_BARRIER(str,a) call mpi_barrier(str,ierr) ; call timer_sta(a)
+# define __TIMER_FJ_START(a) call timer_sta(a)
+# define __TIMER_FJ_STOP(a) call timer_end(a)
+#else
+# define __TIMER_FJ_START(a)
+# define __TIMER_FJ_STOP(a)
+#endif
+
subroutine Preparation()
-! $Id: Preparation.F90 458 2015-09-09 06:05:42Z ktagami $
+! $Id: Preparation.F90 474 2016-02-09 09:32:53Z yamasaki $
use m_Const_Parameters, only:DP,FILE,GENERAL,OUTER,INNER,SIMPLE_CUBIC &
& ,HEXAGONAL,TETRAHEDRON &
& ,INITIAL,CONTINUATION,FIXED_CHARGE &
@@ -190,6 +199,7 @@ subroutine Preparation()
use m_ES_WF_by_MatDiagon, only : m_ESmat_set_reduced_basis_mode
+
implicit none
integer :: outer_or_inner
include 'mpif.h'
@@ -231,15 +241,10 @@ subroutine Preparation()
if(symmetry_method == AUTOMATIC) then
call m_CS_SG_auto_gnrt_sym_op(.true.,nfout) ! -(m_CS_SpaceGroup) -> nopr,af
else
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(31)
-#endif
+ __TIMER_FJ_START(31)
call m_CS_gnrt_symmetry_operations(.true.,nfout) ! -(m_Crystal_Structure) -> nopr,af
!!$ call m_CS_gnrt_symm_operators_tl(.true.,nfout) ! -(m_Crystal_Structure) -> nopr,af
-#ifdef FJ_TIMER
- call timer_end(31)
-#endif
+ __TIMER_FJ_STOP(31)
end if
call m_CS_alloc_op_tau(nfout)
call m_CS_alloc_op_tau_tl(nfout)
@@ -247,15 +252,10 @@ subroutine Preparation()
call m_CS_SG_auto_gnrt_sym_op(paramset,nfout) ! paramset == .false.
call m_IS_symmetrize_atom_pos(nfout) ! -> cps,pos
else
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(31)
-#endif
+ __TIMER_FJ_START(31)
call m_CS_gnrt_symmetry_operations(paramset,nfout) ! paramset == .false.
call m_CS_gnrt_symm_operators_tl(paramset,nfout) ! -(m_Crystal_Structure) -> nopr,af
-#ifdef FJ_TIMER
- call timer_end(31)
-#endif
+ __TIMER_FJ_STOP(31)
end if
call m_CS_SG_print_space_group_name(nfout)
@@ -284,15 +284,10 @@ subroutine Preparation()
call m_IS_inv_sym_off(nfout) ! -> inversion_symmetry
end if
call m_IS_alloc_napt()
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(31)
-#endif
+ __TIMER_FJ_START(31)
call m_CS_wd_op_and_tau(nfout)
call m_IS_symm_check_of_pos()
-#ifdef FJ_TIMER
- call timer_end(31)
-#endif
+ __TIMER_FJ_STOP(31)
if(ekmode /= GRID .and. sw_phonon == ON) then
call m_Phonon_alloc_qvec()
@@ -338,14 +333,9 @@ subroutine Preparation()
! ============================================================ 13.0F
#endif
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(41)
-#endif
+ __TIMER_FJ_START(41)
call m_pwBS_generate_G_vectors_3D() ! ->n_rGv,n_rGpv ->kgp
-#ifdef FJ_TIMER
- call timer_end(41)
-#endif
+ __TIMER_FJ_STOP(41)
call m_Parallel_init_mpi_kngp_3D(nfout,ipriparallel,kgp) ! -(m_Parallelization) ->ista_kngp,iend_kngp
call m_pwBS_set_ngabc_kngp_l_3D
@@ -354,14 +344,9 @@ subroutine Preparation()
& call m_Files_open_kpoint_files(way_ksample,nbztyp_spg)
call m_pwBS_alloc_ngpt_igfp_gr_3D()
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_calc_length_of_G_3D() ! -> gr_l
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
call m_pwBS_G_trans_functions_3D() ! -> ngpt_l: Set of G-vectors translated according to symmetry operations
ggacmp_parallel_rev = ggacmp_parallel
@@ -398,37 +383,22 @@ subroutine Preparation()
if(icond == PREPARATION_ONLY .or. icond == INITIAL .or. icond == CONTINUATION .or. &
& icond==COORDINATE_CONTINUATION) then
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=paramset) ! -> kg1, nbase,iba (when paramset==.false.)
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
else if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) then
!!$ if(ekmode == OFF)&
!!$ & stop ' ! combination of ekmode and icond is illegal (Preparation)'
call m_Files_close_files_initial0()
call m_Files_open_nfeng(icond)
if(ekmode == OFF .and. fixed_charge_k_parallel == ALL_AT_ONCE) then
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=paramset) ! -> kg1, nbase,iba (when paramset==.false.)
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
else
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=.true.) ! -> kg1, iba
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
call m_Kp_alloc_kpoints_ek() ! -> kv3_ek (=kv3), allocate(vkxyz_ek,qwgt_ek)
call m_Kp_cp_vkxyz_to_vkxyz_ek()
if(fixed_charge_k_parallel == ONE_BY_ONE) then
@@ -440,14 +410,9 @@ subroutine Preparation()
call m_pwBS_cp_iba_to_iba_ek()
if(icond == FIXED_CHARGE_CONTINUATION) &
& call m_ES_cp_iconv(numk_tmp,iconv_ek_tmp)
-#ifdef FJ_TIMER
-! call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(28)
-#endif
+ __TIMER_FJ_START(28)
call m_pwBS_for_each_WF(preallocation=.false.) ! -> kg1, iba
-#ifdef FJ_TIMER
- call timer_end(28)
-#endif
+ __TIMER_FJ_STOP(28)
end if
else
stop ' icond is illegal (Preparation)'
@@ -463,6 +428,9 @@ subroutine Preparation()
call m_pwBS_exxCD()
endif
! ========== ======================================= 13.0F
+ if(ipri>=1) write(nfout,'(" _INCLUDE_EXX_ is defined")')
+#else
+ if(ipri>=1) write(nfout,'(" _INCLUDE_EXX_ is not defined")')
#endif
if(sw_ldos == ON) then
diff -uprN phase0_2015.01/src_phase_3d/Preparation_for_ESM.F90 phase0_2015.01.01/src_phase_3d/Preparation_for_ESM.F90
--- phase0_2015.01/src_phase_3d/Preparation_for_ESM.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Preparation_for_ESM.F90 2016-07-12 12:51:52.000000000 +0900
@@ -9,7 +9,7 @@ subroutine Preparation_for_ESM()
use m_FFT, only : fft_box_size_CD
use m_Crystal_Structure, only : altv
use m_Parallelization, only : npes,mype, ista_kngp, iend_kngp, mpi_ke_world
- use m_PlaneWaveBasisSet, only : ngabc_kngp_l,igfp_l
+ use m_PlaneWaveBasisSet, only : ngabc_kngp_l,igfp_l,kgp
implicit none
include 'mpif.h'
@@ -32,25 +32,29 @@ subroutine Preparation_for_ESM()
do i=1,natm
ival_at(i) = ival(ityp(i))
enddo
- allocate(ngabc_esm(3,1:iend_kngp-ista_kngp+1));ngabc_esm=0
+! allocate(ngabc_esm(3,1:iend_kngp-ista_kngp+1));ngabc_esm=0
+ allocate(ngabc_esm(3,1:kgp));ngabc_esm=0
do i=1,3
do j=ista_kngp,iend_kngp
- ngabc_esm(i,j-ista_kngp+1) = ngabc_kngp_l(j,i)
+ ngabc_esm(i,j) = ngabc_kngp_l(j,i)
enddo
enddo
+ call mpi_allreduce(mpi_in_place,ngabc_esm,3*kgp,mpi_integer,mpi_sum,mpi_ke_world,ierr)
allocate(cps_tmp(3,natm))
do i=1,3
do j=1,natm
cps_tmp(i,j) = cps(j,i)
enddo
enddo
- allocate(igfp_l_esm(1:iend_kngp-ista_kngp+1));igfp_l_esm=0
+ allocate(igfp_l_esm(1:kgp));igfp_l_esm=0
do i=ista_kngp,iend_kngp
- igfp_l_esm(i-ista_kngp+1) = igfp_l(i)
+ igfp_l_esm(i) = igfp_l(i)
enddo
+ call mpi_allreduce(mpi_in_place,igfp_l_esm,kgp,mpi_integer,mpi_sum,mpi_ke_world,ierr)
+
call Esm_interface_map_parameters(natm,ival_at,cps_tmp,1.0d0,altv, &
& fft_box_size_CD(1,0),fft_box_size_CD(2,0),fft_box_size_CD(3,0), &
- & esm_bc_c,.false.,iend_kngp-ista_kngp+1,nspin,ngabc_esm, &
+ & esm_bc_c,.false.,kgp,nspin,ngabc_esm, &
& igfp_l_esm,igfp_l_esm,esm_w,2.0d0*esm_e_field, esm_izwall, &
& esm_z_wall, esm_bar_height,esm_bar_width)
call Esm_interface_set_communicator(mpi_ke_world)
diff -uprN phase0_2015.01/src_phase_3d/Preparation_for_mpi.F90 phase0_2015.01.01/src_phase_3d/Preparation_for_mpi.F90
--- phase0_2015.01/src_phase_3d/Preparation_for_mpi.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Preparation_for_mpi.F90 2016-07-12 12:51:52.000000000 +0900
@@ -40,7 +40,7 @@ subroutine Preparation_for_mpi(prepare_c
use m_Files, only : nfout
use m_Control_Parameters, only : ipriparallel,nspin,neg,printable,ngnode_nbmx &
& , flag_mpi_g_dot_r,flag_mpi_g_dot_r_k &
- & , icond, ekmode, fixed_charge_k_parallel, sw_rsb &
+ & , icond, ekmode, fixed_charge_k_parallel, sw_rsb, neg_is_given &
& , m_CtrlP_flag_mpi_G_dot_R, fftbox_divide_cube &
& , fftbox_3ddiv_1, fftbox_3ddiv_2, fftbox_3ddiv_3 &
& , fftbox_div_1, fftbox_div_2, sw_fft_xzy
@@ -100,10 +100,12 @@ subroutine Preparation_for_mpi(prepare_c
if(prepare_communicators==ON)then
- call m_Parallel_init_mpi_elec_3D(nfout,ipriparallel,printable,neg,kv3,nspin,kg1,iba)
- call make_index_band_3D(nfout,ipriparallel,printable,kv3,neg &
- & , nblocksize_mgs,nblocksize_mgs_is_given,nblocksize_mgs_default)
- call make_index_band_for_Gdiv_3D(neg, nblocksize_mgs,nblocksize_mgs_is_given,nblocksize_mgs_default)
+!!$ if(neg_is_given) then
+ call m_Parallel_init_mpi_elec_3D(nfout,ipriparallel,printable,neg,kv3,nspin,kg1,iba)
+ call make_index_band_3D(nfout,ipriparallel,printable,kv3,neg &
+ & , nblocksize_mgs,nblocksize_mgs_is_given,nblocksize_mgs_default)
+ call make_index_band_for_Gdiv_3D(neg, nblocksize_mgs,nblocksize_mgs_is_given,nblocksize_mgs_default)
+!!$ end if
#ifdef FFT_3D_DIVISION
call m_Parallel_mpi_fft_box_3div(nfout,ipriparallel,printable,fft_box_size_WF,kimg, &
& fftbox_3ddiv_1, fftbox_3ddiv_2,fftbox_3ddiv_3)
diff -uprN phase0_2015.01/src_phase_3d/PseudoPotential_Construction.F90 phase0_2015.01.01/src_phase_3d/PseudoPotential_Construction.F90
--- phase0_2015.01/src_phase_3d/PseudoPotential_Construction.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/PseudoPotential_Construction.F90 2016-07-12 12:51:52.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 483 $)
!
! SUBROUINE: check_gncpp_type, PP_construction_paramset
! PseudoPotential_Construction, PseudoPotential_ek
@@ -38,7 +38,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
subroutine PseudoPotential_Construction
-! $Id: PseudoPotential_Construction.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: PseudoPotential_Construction.F90 483 2016-04-27 04:02:48Z ktagami $
use m_PseudoPotential, only : m_PP_alloc0_ps_ntyp, m_PP_alloc_ps_ntyp &
& , m_PP_dealloc_ps_ntyp &
& , m_PP_set_mmesh, m_PP_set_nloc &
@@ -63,6 +63,7 @@ subroutine PseudoPotential_Construction
& , m_PP_check_file_format
use m_PseudoPotential, only : nlmta,nlmt,lmta,ilmt
use m_Parallelization, only : m_Parallel_init_mpi_nlmta_3D
+ use m_Parallelization, only : m_Parallel_init_mpi_kngp_exx
use m_PseudoPotential, only : ae_wavefunctions_are_detected
use m_PseudoPotential, only : m_PP_alloc_qitg_wan, m_PP_set_dk_wan &
, m_PP_alloc_qitg_fef, m_PP_set_dk_fef
@@ -88,8 +89,8 @@ subroutine PseudoPotential_Construction
& , num_projectors, projector_type, intzaj &
& , sw_wannier, sw_berry_phase, corecharge_cntnbin, sw_fef &
& , ekmode, fixed_charge_k_parallel, continuation_using_ppdata &
- & , m_CtrlP_set_ppprinted,sw_rspace, sw_rspace_hyb, sw_hybrid_functional &
- & , sw_ldos, sw_rspace_ldos, m_CtrlP_rspace_integ_all_OK
+ & , m_CtrlP_set_ppprinted,sw_rspace, sw_hybrid_functional &
+ & , sw_ldos, sw_rspace_ldos, m_CtrlP_rspace_integ_all_OK,nmax_G_hyb
use m_PlaneWaveBasisSet, only : kgp,gr_l,ngshell,ngshell_range
use m_Const_Parameters, only : OLD,ON, SPHERICAL_HARMONICS, NO
use m_Files, only : m_Files_open_ps_files,m_Files_close_ps_files,nfcntn_bin &
@@ -132,7 +133,7 @@ subroutine PseudoPotential_Construction
& , m_OP_Qnum_alloc_orb_ind_data
! ============== 2014/08/01
- use m_Realspace, only : m_RS_resolve_mesh_soft
+ use m_Realspace, only : m_RS_resolve_mesh_soft,m_RS_resolve_mesh_hard, m_RS_build_qr_clm_ylm
use m_ES_ExactExchange, only : m_ES_EXX_set_nmax_G_hyb
@@ -154,6 +155,7 @@ subroutine PseudoPotential_Construction
if(sw_hybrid_functional == ON) then
call m_CtrlP_set_hybrid_parameters
call m_ES_EXX_set_nmax_G_hyb
+ call m_Parallel_init_mpi_kngp_exx(nfout,ipriparallel,nmax_G_hyb)
endif
! ======================================================== 12.5Exp
@@ -357,26 +359,26 @@ subroutine PseudoPotential_Construction
& .and. ekmode==ON ) then
! =================13.0S
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl
-! ==========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl
+#endif
if(sw_orb_popu == ON) then
call m_PP_make_qorb(nfout)
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_phir_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> phig
-! ===========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_phir_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> phig
+#endif
call m_PP_cnstrct_crotylm(nfout) !-> crotylm
end if
if(sw_use_add_proj == ON) then
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_add_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl_add
-! ===========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_add_betar_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> snl_add
+#endif
end if
if(intzaj == by_pseudo_atomic_orbitals) then
-! ========================================== modified by K. Tagami ========= 0.2
-! call m_NLP_paor_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> paog
-! ===========================================================================
+#ifdef EXP_WFN_PROJ
+ call m_NLP_paor_dot_PWs(nfout,kv3,vkxyz) !(kbint) --> paog
+#endif
end if
if(num_projectors > 0) then
@@ -570,4 +572,95 @@ contains
end subroutine PseudoPotential_Construction
+subroutine Check_of_Pseudopotential
+ use m_Const_Parameters, only : DP, OLD
+ use m_Files, only : nfout,nfpot &
+ & , m_Files_open_ps_file, m_Files_close_ps_file
+#ifndef ENABLE_ESM_PACK
+ use m_Control_Parameters, only : ipripp &
+#else
+ use m_Control_Parameters, only : ipripp, esm_qbac &
+#endif
+ & , neg,m_CtrlP_set_neg_properly, m_CntrlP_set_neg, m_CntrlP_set_meg
+ use m_Crystal_Structure, only : additional_charge
+ use m_Ionic_System, only : ntyp, iatom, iatomn, ivan, zeta1, qex
+ use m_PseudoPotential, only : m_PP_rd_ival
+ use m_Parallelization, only : mpi_comm_group
+ use m_Ionic_System, only : natm,ionic_charge_atomtyp, ionic_charge_atoms &
+ & , mag_moment0_atoms_is_defined
+ implicit none
+ include 'mpif.h' ! MPI
+ integer :: it, ierror, nfpp
+ real(kind=DP),allocatable,dimension(:) :: ivalt ! d(ntyp) #valence electrons
+ real(kind=DP) :: totch_t, ival
+ allocate(ivalt(ntyp))
+ nfpp = 0
+ do it = 1, ntyp
+ call m_Files_open_ps_file(ivan,iatomn,ntyp,it,ierror)
+ if(ierror /= 0) call mpi_stop(nfout)
+ if(ipripp >= 2) write(nfout,'(" !! PP_Construction: it = ",i3)') it
+ if(ivan(it) /= OLD) then
+ nfpp = nfpp + 1
+ call m_PP_rd_ival(nfpot(nfpp),it,nfout,ival) ! -> ival
+ else if(ivan(it) == OLD) then
+ endif
+
+ call mpi_bcast(ival,1,mpi_double_precision,0,mpi_comm_group,ierror)
+ ivalt(it) = ival
+ call m_Files_close_ps_file(it)
+ end do
+ totch_t = 0.d0
+ do it = 1, ntyp
+ totch_t = totch_t + ivalt(it)*iatom(it) + qex(it)
+ write(nfout,'(" ## it = ",i5,", ivalt = ",f8.4, " iatom = ",f8.4," qex = ",f8.4)') it, ivalt(it),iatom(it),qex(it)
+ end do
+ call mpi_bcast(totch_t,1,mpi_double_precision,0,mpi_comm_group,ierror)
+#ifdef ENABLE_ESM_PACK
+ totch_t = totch_t - esm_qbac
+#endif
+! ===== KT_add === 2014/06/08
+ totch_t = totch_t - additional_charge ! totch is num. of electrons
+! ================ 2014/06/08
+#ifdef INIT_CHARGE_ATOM_BY_ATOM
+ if ( mag_moment0_atoms_is_defined ) then
+ do ia=1, natm
+ totch_t = totch_t -ionic_charge_atoms(ia)
+ end do
+ else
+ do it = 1, ntyp
+ totch_t = totch_t -ionic_charge_atomtyp(it)
+ end do
+ endif
+#else
+ do it = 1, ntyp
+ totch_t = totch_t -ionic_charge_atomtyp(it)
+ end do
+#endif
+
+ if(totch_t >= neg*2.0) then
+ if(ipripp >= 0) then
+ write(nfout,'(" ### Warning(1309): Number of bands(neg) is insufficient:")')
+ write(nfout,'(" totch = ",f10.3," >= neg*2.0 = ",f10.3)') totch_t, neg*2.0
+ end if
+ if(dabs(sum(zeta1)) > 0.d0) then
+ call m_CtrlP_set_neg_properly(1.3*totch_t) ! -> neg
+ else
+ call m_CtrlP_set_neg_properly(totch_t) ! -> neg
+ end if
+ call m_CntrlP_set_meg(neg)
+!!$ call m_CntrlP_set_neg(neg)
+ if(ipripp >= 0) then
+ write(nfout,'(" ### Reset value of neg = ",i8)') neg
+ write(nfout,'(" totch = ",f10.3," <= neg*2.0 = ",f10.3)') totch_t, neg*2.0
+ end if
+ else
+ if(ipripp >= 0) then
+ write(nfout,'(" ### Number of bands(neg) is sufficient:")')
+ write(nfout,'(" totch = ",f10.3," < neg*2.0 = ",f10.3)') totch_t, neg*2.0
+ end if
+ end if
+
+ deallocate(ivalt)
+end subroutine Check_of_Pseudopotential
+
diff -uprN phase0_2015.01/src_phase_3d/Renewal_of_ChgCtrlParam.f90 phase0_2015.01.01/src_phase_3d/Renewal_of_ChgCtrlParam.f90
--- phase0_2015.01/src_phase_3d/Renewal_of_ChgCtrlParam.f90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Renewal_of_ChgCtrlParam.f90 2016-07-12 12:51:53.000000000 +0900
@@ -10,7 +10,8 @@ subroutine Renewal_of_Chg_Ctrl_Param
use m_Const_Parameters, only : MSD, CG, SD, LMSD, LMCG,lmeazyCG, lmmsd
use m_Control_Parameters, only : m_CtrlP_solver_for_WFs_now, intzaj
- use m_IterationNumbers, only : iteration, iteration_ionic, iteration_electronic
+ use m_IterationNumbers, only : iteration, iteration_ionic, iteration_electronic, &
+ & iteration_unit_cell
use m_Control_Parameters, only : sw_update_charge_hsr, eval_energy_before_charge
use m_Control_Parameters, only : sw_recomposing, sw_force_simple_mixing
@@ -41,7 +42,10 @@ subroutine Renewal_of_Chg_Ctrl_Param
& nmax_intermid_lambda, &
& edelta_change_lambda_first, &
& edelta_change_lambda_last, &
- & max_iterations_mag_constraint
+ & max_iter_elec_mag_constraint, &
+ & max_iter_ion_mag_constraint, &
+ & max_iter_cell_mag_constraint, &
+ & sw_fix_charge_after_constraint
! ================= KT_add =================== 13.0XX
use m_Control_Parameters, only : sw_calc_ekin_density, &
@@ -59,17 +63,19 @@ subroutine Renewal_of_Chg_Ctrl_Param
& edelta_start_wf_mixing
! =========================== 13.0U3
+ use m_Parallelization, only : mype
+
implicit none
real(kind=DP) :: edeltab_per_atom, edeltb_per_atom, edelta
-! ----------------------- UUU
- if ( sw_monitor_atomcharge == ON ) then
- if ( iteration_ionic >1 .and. iteration_electronic ==1 ) then
- call m_CD_set_rad_cov_default
- call m_CD_set_rad_cov_now
- endif
- endif
+! -----------------------
+! if ( sw_monitor_atomcharge == ON ) then
+! if ( iteration_ionic >1 .and. iteration_electronic ==1 ) then
+! call m_CD_set_rad_cov_default
+! call m_CD_set_rad_cov_now
+! endif
+! endif
! ------------------
edelta = m_TE_what_is_edeltb_now()
@@ -290,25 +296,50 @@ contains
logical, save :: First = .true.
logical, save :: mag_constraint_is_over = .false.
logical, save :: lambda_is_changed
- real(kind=DP), save :: lambda_org, lambda_old
+ integer, save :: sw_fix_charge_after_constr_org
+
+ real(kind=DP), save :: lambda_org, lambda_old, lambda_00
integer :: i, nn
real(kind=DP) :: c1, ratio
+ if ( First ) then
+ lambda_org = mag_constraint_lambda;
+ lambda_old = mag_constraint_lambda
+ sw_fix_charge_after_constr_org = sw_fix_charge_after_constraint
+ istep = 1
+ First = .false.
+ else
+! if ( iteration_unit_cell > 1 .and. iteration_ionic == 1 &
+! & .and. iteration_electronic == 1 ) then
+! mag_constraint_is_over = .false.
+! mag_constraint_lambda = lambda_org
+!! istep = 1; count = 0
+! endif
+ if ( iteration_electronic == 1 ) then
+ mag_constraint_is_over = .false.
+ mag_constraint_lambda = lambda_org
+ sw_fix_charge_after_constraint = sw_fix_charge_after_constr_org
+ istep = 1; count = 0
+ endif
+ endif
+
if ( damping_method_mag_constraint == 0 ) return
- if ( mag_constraint_is_over ) return
- if ( iteration_ionic > 1 ) then
+ if ( iteration_ionic > max_iter_ion_mag_constraint ) then
+ mag_constraint_is_over = .true.
+ mag_constraint_lambda = 0.0d0;
+ endif
+ if ( iteration_unit_cell > max_iter_cell_mag_constraint ) then
mag_constraint_is_over = .true.
mag_constraint_lambda = 0.0d0;
- return
endif
- if ( First ) then
- lambda_org = mag_constraint_lambda;
- lambda_old = mag_constraint_lambda
- istep = 1
- First = .false.
+ if ( mag_constraint_is_over ) then
+ if ( sw_fix_charge_after_constraint == ON ) then
+ sw_update_charge_total = OFF
+ endif
+ return
endif
lambda_is_changed = .false.
@@ -346,17 +377,28 @@ contains
endif
case (ABRUPT)
- if ( iteration_electronic > max_iterations_mag_constraint ) then
+ if ( iteration_electronic > max_iter_elec_mag_constraint ) then
mag_constraint_lambda = 0.0d0
lambda_is_changed = .true.
mag_constraint_is_over = .true.
endif
+ c1 = abs( edeltab_per_atom )
+
+ if ( c1 < edelta_change_lambda_last ) then
+ count = count + 1
+ if ( count == succession ) then
+ mag_constraint_lambda = 0.0d0
+ mag_constraint_is_over = .true.
+ lambda_is_changed = .true.
+ endif
+ endif
+
case (LINEAR)
- ratio = dble( iteration_electronic ) / dble(max_iterations_mag_constraint)
+ ratio = dble( iteration_electronic ) / dble(max_iter_elec_mag_constraint)
ratio = 1.0D0 -ratio
- if ( iteration_electronic <= max_iterations_mag_constraint ) then
+ if ( iteration_electronic <= max_iter_elec_mag_constraint ) then
mag_constraint_lambda = lambda_org *ratio
lambda_is_changed = .true.
else
@@ -364,6 +406,14 @@ contains
mag_constraint_is_over = .true.
endif
+ c1 = abs( edeltab_per_atom )
+ if ( c1 < edelta_change_lambda_first ) then
+ count = count + 1
+ if ( count == succession ) then
+ mag_constraint_is_over = .true.
+ lambda_is_changed = .true.
+ endif
+ endif
end select
if ( lambda_is_changed ) then
@@ -373,7 +423,7 @@ contains
endif
lambda_old = mag_constraint_lambda
-
+!
end subroutine update_lambda_mag_constraint
! === KT_add === 13.0U3
diff -uprN phase0_2015.01/src_phase_3d/Renewal_of_pPotential.f90 phase0_2015.01.01/src_phase_3d/Renewal_of_pPotential.f90
--- phase0_2015.01/src_phase_3d/Renewal_of_pPotential.f90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Renewal_of_pPotential.f90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! SUBROUINE: Renewal_of_pPotential
!
diff -uprN phase0_2015.01/src_phase_3d/Renewal_of_pWaveFunctions.F90 phase0_2015.01.01/src_phase_3d/Renewal_of_pWaveFunctions.F90
--- phase0_2015.01/src_phase_3d/Renewal_of_pWaveFunctions.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/Renewal_of_pWaveFunctions.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! SUBROUINE: Renewal_of_pWaveFunctions
!
diff -uprN phase0_2015.01/src_phase_3d/b_PseudoPotential_EXX.F90 phase0_2015.01.01/src_phase_3d/b_PseudoPotential_EXX.F90
--- phase0_2015.01/src_phase_3d/b_PseudoPotential_EXX.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/b_PseudoPotential_EXX.F90 2016-07-12 12:51:53.000000000 +0900
@@ -2,19 +2,20 @@ subroutine alloc_qitg_exx()
use m_PseudoPotential, only : nqitg
use m_PlaneWaveBasisSet, only : kgp
use m_ES_ExactExchange, only : nqmk, qitg_exx
- use m_Control_Parameters, only : nmax_G_hyb
- use m_Parallelization, only : ista_kngp, iend_kngp
+ use m_Const_Parameters, only : ON
+ use m_Parallelization, only : ista_kngp, iend_kngp, ista_kngp_exx,iend_kngp_exx
implicit none
- if(.not.allocated(qitg_exx)) allocate(qitg_exx(ista_kngp:iend_kngp,nqitg,nqmk))
+ if(.not.allocated(qitg_exx)) then
+ allocate(qitg_exx(kgp,nqitg,nqmk))
+ endif
end subroutine alloc_qitg_exx
subroutine qitgft_qmk(it,nmm_il3,mm_il3,qrsps_mm,lcmax,h)
- use m_Const_Parameters, only : DP, PAI4, DELTA
- use m_Control_Parameters, only : nmax_G_hyb
+ use m_Const_Parameters, only : DP, PAI4, DELTA, ON
use m_Crystal_Structure, only : rltv
use m_PlaneWaveBasisSet, only : ngabc_kngp_l,kgp
use m_PseudoPotential, only : mmesh,nmesh,rmax,radr,wos,nqitg_sp
- use m_Parallelization, only : mpi_comm_group,ista_kngp,iend_kngp,npes,ierr
+ use m_Parallelization, only : mpi_comm_group,ista_kngp,iend_kngp,npes,ierr,ista_kngp_exx,iend_kngp_exx
use m_ES_ExactExchange, only : nqmk, qmk, qitg_exx
use m_Timing, only : tstatc0_begin, tstatc0_end
use m_Parallelization, only : mpi_ke_world
@@ -51,7 +52,7 @@ subroutine qitgft_qmk(it,nmm_il3,mm_il3,
mm0 = mm0 + nqitg_sp(i)
end do
iend_kngp0 = iend_kngp
- if(iend_kngp0.gt.nmax_G_hyb) iend_kngp0 = nmax_G_hyb
+
do ik=1,nqmk
do i = ista_kngp, iend_kngp0
kg(1:3) = qmk(ik,1:3) + ngabc_kngp_l(i,1:3)
@@ -86,11 +87,12 @@ subroutine qitgft_qmk(it,nmm_il3,mm_il3,
end do
end do
end do
- do iq=1,nqitg_sp(it)
- do i=ista_kngp,iend_kngp
- qitg_exx(i,mm0+iq,ik) = qitg_exx_l(i,iq)
- end do
+ do iq=1,nqitg_sp(it)
+ do i=ista_kngp,iend_kngp
+ qitg_exx(i,mm0+iq,ik) = qitg_exx_l(i,iq)
end do
+ end do
+
end do ! ik
deallocate(qitg_exx_l)
diff -uprN phase0_2015.01/src_phase_3d/configure phase0_2015.01.01/src_phase_3d/configure
--- phase0_2015.01/src_phase_3d/configure 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/configure 2016-07-12 12:51:53.000000000 +0900
@@ -343,6 +343,7 @@ fi
bllib_netlib="Netlib BLAS/LAPACK"
bllib_acml="AMD Core Math Library (ACML)"
bllib_mkl="Intel Math Kernel Library (MKL)"
+bllib_mkl_sys="System-installed MKL"
bllib_sunperf="Sun Performance Library"
bllib_scsl="SGI Cray Scientific Library (SCSL)"
bllib_essl="IBM Engineering and Scientific Subroutine Library (ESSL)"
@@ -357,6 +358,7 @@ add_option "${bllib_netlib}"
case ${sel_comp} in
"${gnu_compiler}"|"${g95_compiler}"|"${intel_compiler}")
add_option "${bllib_mkl}"
+add_option "${bllib_mkl_sys}"
;;
esac
;;
@@ -477,6 +479,20 @@ esac
;;
esac
;;
+"${bllib_mkl_sys}")
+case ${sel_plat} in
+"${gnu_linux_ia32}")
+bldir=""
+bllib="-Wl,--start-group -lmkl_scalapack_core -lmkl_blacs_intelmpi -lmkl_intel -lmkl_sequential -lmkl_core -Wl,--end-group -Bdynamic"
+use_pthread="yes"
+ ;;
+"${gnu_linux_amd64}")
+bldir=""
+bllib="-Wl,--start-group -lmkl_scalapack_lp64 -lmkl_blacs_intelmpi_lp64 -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -Bdynamic"
+use_pthread="yes"
+ ;;
+esac
+ ;;
"${bllib_mkl}")
case ${sel_plat} in
"${gnu_linux_ia32}")
@@ -609,6 +625,7 @@ esac
# FFT library selection
fftlib_jrcat="Built-in FFT subroutnes"
fftlib_fftw3="FFTW3 library"
+fftlib_fftw3_sys="System-installed FFTW3 library"
fftlib_mkl_fftw3="Intel MKL with FFTW3 interface"
#fftlib_mkl_fftw3_gnu="Intel MKL with FFTW3 interface library built by gcc"
fftlib_acml="AMD Core Math Library (ACML)"
@@ -624,10 +641,11 @@ unset list
case ${sel_plat} in
"${gnu_linux_ia32}"|"${gnu_linux_amd64}"|"${windows_mingw_ia32}"|"${windows_mingw_amd64}"|"${windows_sua_ia32}"|"${windows_sua_amd64}")
add_option "${fftlib_fftw3}"
+add_option "${fftlib_fftw3_sys}"
#add_option "${fftlib_acml}"
case ${sel_comp} in
"${gnu_compiler}"|"${g95_compiler}"|"${intel_compiler}")
-if [ "${sel_bllib}" = "${bllib_mkl}" ];then
+if [ "${sel_bllib}" = "${bllib_mkl}" -o "${sel_bllib}" = "${bllib_mkl_sys}" ];then
add_option "${fftlib_mkl_fftw3}"
#add_option "${fftlib_mkl_fftw3_gnu}"
fi
@@ -678,127 +696,132 @@ fftdir="/usr/local/lib"
;;
"${fftlib_acml}")
fftlib="-lacml"
-case ${sel_comp} in
-"${gnu_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/gfortran32/lib"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/gfortran64/lib"
- ;;
-esac
- ;;
-"${intel_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/ifort32/lib"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/ifort64/lib"
- ;;
-"${windows_mingw_ia32}")
-fftlib="libacml_dll.lib"
-fftdir="/c/progra~1/AMD/acml5.3.0/ifort32/lib"
- ;;
-"${windows_mingw_amd64}")
-fftlib="libacml_dll.lib"
-fftdir="/c/acml5.3.0/ifort64/lib"
- ;;
-esac
- ;;
-"${pgi_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/pgi32/lib"
;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/pgi64/lib"
- ;;
-"${windows_mingw_ia32}")
-fftlib="libacml_dll.lib"
-fftdir="/c/progra~1/AMD/acml5.3.0/pgi32/lib"
- ;;
-"${windows_mingw_amd64}")
-fftlib="libacml_dll.lib"
-fftdir="/c/acml5.3.0/win64/lib"
- ;;
-esac
- ;;
-"${pathscale_compiler}")
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/acml5.3.0/pathscale32/lib"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/acml5.3.0/pathscale64/lib"
- ;;
-esac
- ;;
-"${sun_studio}")
-case ${sel_plat} in
-"${sun_solaris_ia32}")
-fftdir="/opt/acml5.3.0/sun32/lib"
- ;;
-"${sun_solaris_amd64}")
-fftdir="/opt/acml5.3.0/sun64/lib"
- ;;
-esac
- ;;
-esac
- ;;
-"${fftlib_mkl}")
-fftlib=""
-fftdir="/opt/intel/mkl/interfaces/fftw3xf"
-case ${sel_plat} in
-"${gnu_linux_ia32}")
-fftdir="/opt/intel/mkl/9.1/lib/32"
-fftlib="${fftlib} -lmkl_ia32 -lguide"
-use_pthread="yes"
- ;;
-"${gnu_linux_amd64}")
-fftdir="/opt/intel/mkl/9.1/lib/em64t"
-fftlib="${fftlib} -lmkl_em64t -lguide"
-use_pthread="yes"
- ;;
-"${gnu_linux_ipf}")
-fftdir="/opt/intel/mkl/9.1/lib/64"
-fftlib="${fftlib} -lmkl_ipf -lguide"
-use_pthread="yes"
- ;;
-"${intel_mac_32bit}")
-fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/32"
-fftlib="${fftlib} -lmkl_ia32"
- ;;
-"${intel_mac_64bit}")
-fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/em64t"
-fftlib="${fftlib} -lmkl_em64t"
- ;;
-"${windows_mingw_ia32}")
-fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/ia32/lib"
-fftlib="fftw3xf_ms.lib mkl_c_dll.lib"
- ;;
-"${windows_mingw_amd64}")
-fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/em64t/lib"
-fftlib="fftw3xf_ms.lib mkl_dll.lib"
- ;;
-esac
- ;;
-"${fftlib_scsl}")
-fftdir=""
-fftlib="-lscs"
- ;;
-"${fftlib_matrix}")
-fftdir=""
-fftlib="-lmatmpp_sc"
- ;;
-"${fftlib_ssl2}")
-fftdir=""
-fftlib="-lssl2vp"
- ;;
-"${fftlib_asl}")
+"${fftlib_fftw3_sys}")
+fftlib="-lfftw3"
fftdir=""
-fftlib="-lasl"
+
+#case ${sel_comp} in
+#"${gnu_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/gfortran32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/gfortran64/lib"
+# ;;
+#esac
+# ;;
+#"${intel_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/ifort32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/ifort64/lib"
+# ;;
+#"${windows_mingw_ia32}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/progra~1/AMD/acml5.3.0/ifort32/lib"
+# ;;
+#"${windows_mingw_amd64}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/acml5.3.0/ifort64/lib"
+# ;;
+#esac
+# ;;
+#"${pgi_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/pgi32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/pgi64/lib"
+# ;;
+#"${windows_mingw_ia32}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/progra~1/AMD/acml5.3.0/pgi32/lib"
+# ;;
+#"${windows_mingw_amd64}")
+#fftlib="libacml_dll.lib"
+#fftdir="/c/acml5.3.0/win64/lib"
+# ;;
+#esac
+# ;;
+#"${pathscale_compiler}")
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/acml5.3.0/pathscale32/lib"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/acml5.3.0/pathscale64/lib"
+# ;;
+#esac
+# ;;
+#"${sun_studio}")
+#case ${sel_plat} in
+#"${sun_solaris_ia32}")
+#fftdir="/opt/acml5.3.0/sun32/lib"
+# ;;
+#"${sun_solaris_amd64}")
+#fftdir="/opt/acml5.3.0/sun64/lib"
+# ;;
+#esac
+# ;;
+#esac
+# ;;
+#"${fftlib_mkl}")
+#fftlib=""
+#fftdir="/opt/intel/mkl/interfaces/fftw3xf"
+#case ${sel_plat} in
+#"${gnu_linux_ia32}")
+#fftdir="/opt/intel/mkl/9.1/lib/32"
+#fftlib="${fftlib} -lmkl_ia32 -lguide"
+#use_pthread="yes"
+# ;;
+#"${gnu_linux_amd64}")
+#fftdir="/opt/intel/mkl/9.1/lib/em64t"
+#fftlib="${fftlib} -lmkl_em64t -lguide"
+#use_pthread="yes"
+# ;;
+#"${gnu_linux_ipf}")
+#fftdir="/opt/intel/mkl/9.1/lib/64"
+#fftlib="${fftlib} -lmkl_ipf -lguide"
+#use_pthread="yes"
+# ;;
+#"${intel_mac_32bit}")
+#fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/32"
+#fftlib="${fftlib} -lmkl_ia32"
+# ;;
+#"${intel_mac_64bit}")
+#fftdir="/Library/Frameworks/Intel_MKL.framework/Versions/9.1/lib_serial/em64t"
+#fftlib="${fftlib} -lmkl_em64t"
+# ;;
+#"${windows_mingw_ia32}")
+#fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/ia32/lib"
+#fftlib="fftw3xf_ms.lib mkl_c_dll.lib"
+# ;;
+#"${windows_mingw_amd64}")
+#fftdir="/c/progra~1/Intel/MKL/9.1/lib_serial/em64t/lib"
+#fftlib="fftw3xf_ms.lib mkl_dll.lib"
+# ;;
+#esac
+# ;;
+#"${fftlib_scsl}")
+#fftdir=""
+#fftlib="-lscs"
+# ;;
+#"${fftlib_matrix}")
+#fftdir=""
+#fftlib="-lmatmpp_sc"
+# ;;
+#"${fftlib_ssl2}")
+#fftdir=""
+#fftlib="-lssl2vp"
+# ;;
+#"${fftlib_asl}")
+#fftdir=""
+#fftlib="-lasl"
;;
esac
@@ -867,7 +890,7 @@ use_dgemm="yes"
#ESM
use_esm=""
-if [ "${sel_fftlib}" = "${fftlib_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" ];then
+if [ "${sel_fftlib}" = "${fftlib_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3}" -o "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" -o "${sel_fftlib}" = "${fftlib_fftw3_sys}" ];then
echo "Do you want to enable the ESM feature? (yes/no) [yes]"
read use_esm
#echo "${use_esm}" >> config
@@ -1172,7 +1195,7 @@ cppflags="$cppflags -DJRCATFFT_WS -DCD_J
;;
esac
;;
-"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}")
+"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}"|"${fftlib_fftw3_sys}")
cppflags="$cppflags -DFFTW3"
esm="YES"
;;
@@ -1225,7 +1248,7 @@ cppflags="$cppflags -DDISABLE_VDWDF"
fi
# flags applied to all cases
-cppflags="$cppflags -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D"
+cppflags="$cppflags -D_USE_DATE_AND_TIME_ -D_POT_SMOOTHING_ -DTRANSPOSE -DGGA_ATOMIC_WITH_NEW_GNCPP -DREMOVE_PC_FROM_FORCE -D_USE_LAPACK_ -D_USE_SCALAPACK_ -D_POSITRON_ -D_FAST_WAY_ -DUSE_NONBLK_COMM -Dforsafe -D_HEAP_SORT_ -DFFT_ALLTOALL -DPOST3D -DPAW3D"
# append "-WF," to cpp options.
if [ "${sel_comp}" = "${ibm_xl}" ]; then
@@ -1455,17 +1478,20 @@ esac
########################################
case ${sel_fftlib} in
-"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}")
+"${fftlib_fftw3}"|"${fftlib_mkl_fftw3}"|"${fftlib_mkl_fftw3_gnu}"|"${fftlib_fftw3_sys}")
libs="-L./ \${LESM} ${libs}"
esac
-if [ "${sel_fftlib}" = "${fftlib_fftw3}" ];then
-fftincludedir="${fftdir}/../include"
-fi
-if [ "${sel_fftlib}" = "${fftlib_mkl_fftw3}" ];then
-fftincludedir="${bldir}/../../include/fftw"
-elif [ "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" ];then
-fftincludedir="${bldir}/../../include/fftw"
+fftincludedir="INCLUDE="
+if [ "${sel_fftlib}" = "${fftlib_fftw3}" ] && [ -n "${fftdir}" ];then
+fftincludedir="INCLUDE=-I${fftdir}/../include"
+fi
+if [ "${sel_fftlib}" = "${fftlib_mkl_fftw3}" ] && [ -n "${bldir}" ];then
+fftincludedir="INCLUDE=-I${bldir}/../../include/fftw"
+elif [ "${sel_fftlib}" = "${fftlib_mkl_fftw3_gnu}" ] && [ -n "${bldir}" ];then
+fftincludedir="INCLUDE=-I${bldir}/../../include/fftw"
+elif [ "${sel_fftlib}" = "${fftlib_fftw3_sys}" ];then
+fftincludedir="INCLUDE="
fi
cat <<here > Makefile
@@ -1502,7 +1528,7 @@ LFLAGS = ${lflags}
F90FLAGS_FIXED = ${f90flags_fixed}
F90FLAGS_FREE = ${f90flags_free}
MKLHOME=${bldir}
-INCLUDE=-I${fftincludedir}
+${fftincludedir}
LIBS = ${libs}
###########################################################################
###<< PLEASE CHANGE THE VARIABLES ABOVE ACCORDING TO YOUR ENVIRONMENT >>###
diff -uprN phase0_2015.01/src_phase_3d/constraint_main.F90 phase0_2015.01.01/src_phase_3d/constraint_main.F90
--- phase0_2015.01/src_phase_3d/constraint_main.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/constraint_main.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 494 $)
!
! SUBROUINE: constrained_dynamics
!
@@ -45,6 +45,11 @@ subroutine constrained_dynamics()
use m_Control_Parameters, only : printable, icond, icond_org
use m_Files, only : nfout
use m_Parallelization, only : nrank_conf, mype_conf, conf_para
+#ifdef PAW3D
+ use m_PseudoPotential, only : mmesh
+ use m_Ionic_System, only : natm
+ use m_Parallelization, only : m_Parallel_init_mpi_paw_3D
+#endif
implicit none
diff -uprN phase0_2015.01/src_phase_3d/input_interface.F90 phase0_2015.01.01/src_phase_3d/input_interface.F90
--- phase0_2015.01/src_phase_3d/input_interface.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/input_interface.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 475 $)
!
! FUNCTION: getUnitId, setUnit, updateUnits, clearUnitFlag, setDefaultUnits,
! realConvByUnit, f_openInputFile, f_closeInputFile, f_selectTop,
@@ -17,7 +17,7 @@
!
!
!=======================================================================
-! $Id: input_interface.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: input_interface.F90 475 2016-02-23 05:22:18Z jkoga $
!
!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!$! interface functions
@@ -376,7 +376,8 @@ integer function f_selectBlock( blocktag
if( iret < 0 ) then
f_selectBlock = iret
iret = f_selectParentBlock()
- print '( "A unit with the same dimension as [", a, "] has been already given in the block [", a, "]." )', trim(unit), trim(blocktag)
+ print '( "A unit with the same dimension as [", a, "] has been already given in the block [", a, "]." )'&
+ & , trim(unit), trim(blocktag)
return
end if
end do
diff -uprN phase0_2015.01/src_phase_3d/m_CD_Mag_Moment.f90 phase0_2015.01.01/src_phase_3d/m_CD_Mag_Moment.f90
--- phase0_2015.01/src_phase_3d/m_CD_Mag_Moment.f90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_CD_Mag_Moment.f90 2016-07-12 12:51:53.000000000 +0900
@@ -1,5 +1,5 @@
module m_CD_Mag_Moment
-! $Id: m_CD_Mag_Moment.f90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_CD_Mag_Moment.f90 476 2016-03-10 08:30:50Z yamasaki $
use m_Control_Parameters, only : noncol, ndim_magmom, kimg, iprimagmom, ON, OFF
use m_Const_Parameters, only : DP, PAI4, Bohr
@@ -514,7 +514,7 @@ contains
ik = ista_k
call new_radr_and_wos(ik,it) ! --> radr, wos
- rcut = rad_cov_default( iatomn(it) )
+ rcut = rad_cov_default( nint(iatomn(it) )) ! Revised according to a report from ASMS Co.ltd, 10 March 2016.
Do il1=1, lpsmax(it)
! if ( il1 == iloc(it) ) cycle
diff -uprN phase0_2015.01/src_phase_3d/m_CD_mixing.F90 phase0_2015.01.01/src_phase_3d/m_CD_mixing.F90
--- phase0_2015.01/src_phase_3d/m_CD_mixing.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_CD_mixing.F90 2016-07-12 12:51:53.000000000 +0900
@@ -62,7 +62,7 @@
#endif
module m_CD_mixing
-! $Id: m_CD_mixing.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_CD_mixing.F90 492 2016-05-31 03:06:04Z jkoga $
use m_Const_Parameters, only : BUCS, DP, OFF &
& , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
& , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
@@ -95,8 +95,10 @@ module m_CD_mixing
! ==============================================================================
! === Added by tkato 2011/11/09 ================================================
use m_Control_Parameters, only : sw_mix_bothspins_sametime &
- , sw_recomposing_hsr, sw_force_simple_mixing_hsr
- use m_Ionic_System, only : ityp, natm
+ , sw_recomposing_hsr, sw_force_simple_mixing_hsr &
+ , num_proj_elems, proj_group, proj_attribute, num_projectors &
+ , max_projs
+ use m_Ionic_System, only : ityp, natm,iproj_group
use m_PseudoPotential, only : ilmt, nlmt
use m_Charge_Density, only : hsr, hsro
!===============================================================================
@@ -116,6 +118,8 @@ module m_CD_mixing
use m_Control_Parameters, only : sw_mix_charge_hardpart, sw_mix_charge_with_ekindens
! =============== 2014/09/16
+ use m_Orbital_Population, only : om,omold,ommix
+
implicit none
! --> T. Yamasaki 03 Aug. 2009
real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
@@ -186,7 +190,10 @@ module m_CD_mixing
! ========================== adde by K. Tagami ========================== 5.0
integer :: nsize_rho_hsr
+ integer :: nsize_rho_hsr0
+ integer :: nsize_rho_om
integer, private, allocatable :: imap_hsr(:) ! d(nsize_rho_hsr)
+ integer, private, allocatable :: imap_om(:) ! d(nsize_rho_hsr)
real(kind=DP),private,allocatable, dimension(:,:) :: rho_hsr, rhoo_hsr
! d(nsize_rho_hsr,nspin)
@@ -199,6 +206,7 @@ module m_CD_mixing
real(DP),private,allocatable,target,dimension(:,:,:,:) :: urec_hsr
real(DP),private,allocatable,dimension(:,:,:) :: d0_hsr_h
+ logical,allocatable,dimension(:) :: diag_elem
logical, save :: first = .true.
@@ -246,6 +254,16 @@ module m_CD_mixing
real(kind=DP), pointer :: ekinq_l(:,:,:), ekinqo_l(:,:,:)
! ============== 2014/09/19
+ integer, public, allocatable :: i2lp(:) ! d(num_projectors)
+
+! ================================ modified by K. Tagami ================ 11.0
+! integer, private :: max2lp ! max. of i2lp
+ integer, public :: max2lp ! max. of i2lp
+! ======================================================================= 11.0
+
+ integer, private :: l1max ! max. of l1
+ integer, private :: nyymax
+
! --- contained subroutines ---
! 7. m_CD_prepare_precon <-(ChargeDensity_Mixing)
! 10. m_CD_simple_mixing <-(ChargeDensity_Mixing)
@@ -2523,9 +2541,10 @@ contains
end subroutine m_CD_mix_broyden2
! ===================== added by K. Tagami ============================== 5.0
- subroutine m_CD_mix_broyden2_with_hsr(nfout,rmx)
+ subroutine m_CD_mix_broyden2_with_hsr(nfout,rmx,mixocc)
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
+ logical, intent(in) :: mixocc
integer :: iter,j,mxiter,icr,jcr
!!$ real(DP) :: v_dF(nspin),vF(nspin)
@@ -2539,9 +2558,10 @@ contains
if (previous_waymix /= BROYD2.or.force_dealloc) then
force_dealloc = .false.
if ( first ) then
- call create_map_func(.true.)
- call alloc_rho_hsr
- call create_map_func(.false.)
+ if(mixocc) call set_i2lp_max2lp()
+ call create_map_func(.true.,mixocc)
+ call alloc_rho_hsr(mixocc)
+ call create_map_func(.false.,mixocc)
first = .false.
endif
call mix_dealloc_previous()
@@ -2560,6 +2580,10 @@ contains
else
call map_hsr_to_rho( hsr, rho_hsr )
call map_hsr_to_rho( hsro,rhoo_hsr )
+ if(mixocc)then
+ call map_om_to_rho( om, rho_hsr )
+ call map_om_to_rho( omold,rhoo_hsr )
+ endif
endif
! ========================================================================= 11.0
@@ -2649,7 +2673,6 @@ contains
call mix_broyden_dealloc2 !-(m_CD)
call mix_broyden_dealloc2_hsr
-
endif
! ============================== modified by K. Tagami ================= 11.0
@@ -2677,6 +2700,7 @@ contains
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
else
call map_rho_to_hsr( hsr, rho_hsr )
+ if(mixocc) call map_rho_to_om( om, rho_hsr )
endif
deallocate(rmxtrc)
@@ -3639,10 +3663,11 @@ contains
end subroutine m_CD_mix_pulay
!!$ 11.07 AS Pulay version of 'sw_mix_charge_hardpart'
- subroutine m_CD_mix_pulay_with_hsr(nfout,rmx)
+ subroutine m_CD_mix_pulay_with_hsr(nfout,rmx,mixocc)
integer, parameter :: iRho = 1, iResid = 2
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
+ logical, intent(in) :: mixocc
integer :: iter, mxiter
real(DP),pointer,dimension(:) :: e_wk, f_wk, ww1, finv
integer, pointer,dimension(:) :: ip
@@ -3656,9 +3681,10 @@ contains
if(previous_waymix /= PULAY.or.force_dealloc) then
force_dealloc = .false.
if ( first ) then
- call create_map_func(.true.)
- call alloc_rho_hsr
- call create_map_func(.false.)
+ if(mixocc) call set_i2lp_max2lp()
+ call create_map_func(.true.,mixocc)
+ call alloc_rho_hsr(mixocc)
+ call create_map_func(.false.,mixocc)
first = .false.
endif
call mix_dealloc_previous()
@@ -3677,6 +3703,10 @@ contains
else
call map_hsr_to_rho( hsr, rho_hsr )
call map_hsr_to_rho( hsro,rhoo_hsr )
+ if(mixocc)then
+ call map_om_to_rho( om, rho_hsr )
+ call map_om_to_rho( omold,rhoo_hsr )
+ endif
endif
! ========================================================================= 11.0
@@ -3791,6 +3821,7 @@ contains
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
else
call map_rho_to_hsr( hsr, rho_hsr )
+ if(mixocc) call map_rho_to_om( om, rho_hsr )
endif
deallocate(rmxtrc)
@@ -4208,10 +4239,11 @@ contains
!!$ 11.07 AS Pulay version of 'sw_mix_charge_hardpart'
! ========================= added by K. Tagami ===================== 5.0
- subroutine create_map_func(paramset)
- logical :: paramset
+ subroutine create_map_func(paramset,mixocc)
+ logical :: paramset,mixocc
integer :: n, ia, it
integer :: lmt1, lmt2
+ integer :: ig,m2,m1,i,ip
n=0
do ia=1,natm
@@ -4221,13 +4253,36 @@ contains
do lmt2 = lmt1, ilmt(it)
n=n+1
- if(.not.paramset) &
- & imap_hsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
+ if(.not.paramset) then
+ imap_hsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
+ diag_elem(n) = lmt1.eq.lmt2
+ endif
end do
end do
end do
- nsize_rho_hsr = n
+ nsize_rho_hsr0 = n
+ nsize_rho_hsr = nsize_rho_hsr0
! ================================ added by K. Tagami ============ 11.0
+ if(mixocc)then
+ n=0
+ do ia=1,natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+ do i=1,num_proj_elems(ig)
+ ip=proj_group(i,ig)
+ it = proj_attribute(ip)%ityp
+ do m2=1,i2lp(ip)
+ do m1=m2,i2lp(ip)
+ n=n+1
+ if(.not.paramset) &
+ & imap_om(n) = m1 + max2lp*(m2-1 + max2lp*( i-1 + max_projs*( ia-1 ) ) )
+ end do
+ end do
+ end do
+ enddo
+ nsize_rho_om = n
+ nsize_rho_hsr = nsize_rho_hsr0+nsize_rho_om
+ endif
if ( noncol ) then
nsize_rho_hsr_realpart = n
@@ -4248,20 +4303,69 @@ contains
! ================================================================= 11.0
end subroutine create_map_func
- subroutine alloc_rho_hsr
+ subroutine alloc_rho_hsr(mixocc)
+ logical, intent(in) :: mixocc
+ if ( noncol ) then
+ nspin_m = ndim_magmom
+ else
+ nspin_m = nspin/(af+1)
+ endif
+ if ( noncol ) then
+ nspin_m = ndim_magmom
+ allocate( rho_hsr( nsize_rho_hsr,ndim_magmom)); rho_hsr = 0.0d0
+ allocate( rhoo_hsr(nsize_rho_hsr,ndim_magmom));rhoo_hsr = 0.0d0
+ else
+ nspin_m = nspin/(af+1)
+ allocate( rho_hsr( nsize_rho_hsr,nspin_m)); rho_hsr = 0.0d0
+ allocate( rhoo_hsr(nsize_rho_hsr,nspin_m));rhoo_hsr = 0.0d0
+ endif
! ================================ modified by K. Tagami ============== 11.0
! allocate( rho_hsr( nsize_rho_hsr,nspin)); rho_hsr = 0.0d0
! allocate( rhoo_hsr(nsize_rho_hsr,nspin));rhoo_hsr = 0.0d0
- allocate( rho_hsr( nsize_rho_hsr,ndim_magmom)); rho_hsr = 0.0d0
- allocate( rhoo_hsr(nsize_rho_hsr,ndim_magmom));rhoo_hsr = 0.0d0
! ====================================================================== 11.0
- allocate( imap_hsr(nsize_rho_hsr) ); imap_hsr = 0
+ allocate( imap_hsr(nsize_rho_hsr0) ); imap_hsr = 0
+ allocate(diag_elem(nsize_rho_hsr0));diag_elem=.false.
+ if(mixocc)then
+ allocate( imap_om(nsize_rho_om) ); imap_om = 0
+ endif
end subroutine alloc_rho_hsr
+ subroutine set_i2lp_max2lp()
+ integer :: it,ip
+ integer, parameter :: ntau0=2
+
+! =========================== added by K. Tagami ====================== 11.0
+ integer :: nsize
+! ===================================================================== 11.0
+
+ allocate(i2lp(num_projectors))
+ do ip=1,num_projectors
+ i2lp(ip) = 2*proj_attribute(ip)%l+1
+ end do
+ max2lp = 0
+ do ip=1,num_projectors
+ if(i2lp(ip) > max2lp) then
+ max2lp = i2lp(ip)
+ l1max = proj_attribute(ip)%l+1
+ end if
+ end do
+
+! =========================== modified by K. Tagami ====================== 11.0
+!!
+!! nyymax = ntau0*l1max**2*(l1max**2+1)/2
+!
+ nsize = ntau0*( 2*( l1max -1 )+1 )
+ nyymax = nsize *( nsize +1 ) /2
+
+ end subroutine set_i2lp_max2lp
+
subroutine dealloc_rho_hsr
deallocate(rho_hsr)
deallocate(rhoo_hsr)
deallocate(imap_hsr)
+ deallocate(diag_elem)
+ if(allocated(imap_om)) deallocate(imap_om)
+ if(allocated(i2lp)) deallocate(i2lp)
end subroutine dealloc_rho_hsr
subroutine map_hsr_to_rho( hsr,rho )
@@ -4272,7 +4376,7 @@ contains
do is=1,nspin,(af+1)
rho(:,is)=0.d0
- do i=1,nsize_rho_hsr
+ do i=1,nsize_rho_hsr0
rho(i,is) = hsr( imap_hsr(i),is )
end do
end do
@@ -4300,6 +4404,55 @@ contains
end subroutine map_hsr_to_rho_noncl
! ===================================================================== 11.0
+ subroutine map_om_to_rho(om,rho)
+ real(kind=DP), intent(in) :: om(max2lp*max2lp*max_projs*natm,nspin)
+ real(kind=DP), intent(out) :: rho(nsize_rho_hsr,nspin)
+
+ integer :: i,is
+
+ do is=1,nspin,(af+1)
+ do i=nsize_rho_hsr0+1,nsize_rho_hsr
+ rho(i,is) = om(imap_om(i-nsize_rho_hsr0),is)
+ end do
+ end do
+ end subroutine map_om_to_rho
+
+ subroutine map_rho_to_om(om,rho)
+ real(kind=DP), intent(out) :: om(max2lp*max2lp*max_projs*natm,nspin)
+ real(kind=DP), intent(in) :: rho(nsize_rho_hsr,nspin)
+ integer :: i,is,ia,ig,ip,it,m1,m2
+
+ do is=1,nspin,(af+1)
+ do i=nsize_rho_hsr0+1,nsize_rho_hsr
+ om(imap_om(i-nsize_rho_hsr0),is) = rho(i,is)
+ end do
+ end do
+ call symmetrize(om)
+
+ contains
+
+ subroutine symmetrize(om)
+ real(kind=DP), intent(inout) :: om(max2lp,max2lp,max_projs,natm,nspin)
+
+ do is=1,nspin,(af+1)
+ do ia=1,natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+ do i=1,num_proj_elems(ig)
+ ip=proj_group(i,ig)
+ it = proj_attribute(ip)%ityp
+ do m2=1,i2lp(ip)
+ do m1=m2,i2lp(ip)
+ if(m1/=m2) om(m2,m1,i,ia,is) = om(m1,m2,i,ia,is)
+ end do
+ end do
+ end do
+ end do
+ end do
+ end subroutine symmetrize
+
+ end subroutine map_rho_to_om
+
subroutine map_rho_to_hsr( hsr,rho )
real(kind=DP), intent(out) :: hsr( natm *nlmt *nlmt, nspin )
real(kind=DP), intent(in) :: rho( nsize_rho_hsr,nspin )
@@ -4308,8 +4461,8 @@ contains
do is=1,nspin,(af+1)
- hsr(1:nsize_rho_hsr,is) = 0.0d0
- do i=1,nsize_rho_hsr
+ hsr(1:nsize_rho_hsr0,is) = 0.0d0
+ do i=1,nsize_rho_hsr0
hsr(imap_hsr(i),is) = rho(i,is)
end do
end do
@@ -4517,4 +4670,27 @@ contains
__TIMER_SUB_STOP(1144)
end subroutine m_CD_simple_mixing_hsr
+ subroutine m_CD_hsr_diff(nfout)
+ integer, intent(in) :: nfout
+ integer :: i,j,ndiag,nnondiag
+ real(kind=DP) :: sumhsr_diag,sumhsr_nondiag
+ sumhsr_diag = 0.d0
+ sumhsr_nondiag = 0.d0
+ ndiag = 0
+ nnondiag = 0
+ do i=1,nspin_m
+ do j=1,nsize_rho_hsr
+ if(diag_elem(j))then
+ sumhsr_diag = sumhsr_diag+abs(rhoo_hsr(j,i)-rho_hsr(j,i))
+ ndiag = ndiag+1
+ else
+ sumhsr_nondiag = sumhsr_nondiag+abs(rhoo_hsr(j,i)-rho_hsr(j,i))
+ nnondiag = nnondiag+1
+ endif
+ enddo
+ enddo
+ if(printable) write(nfout,'(a,f15.10)') '!** dhsr_diag ',sumhsr_diag/dble(ndiag)
+ if(printable) write(nfout,'(a,f15.10)') '!** dhsr_nondiag',sumhsr_nondiag/dble(nnondiag)
+ end subroutine m_CD_hsr_diff
+
end module m_CD_mixing
diff -uprN phase0_2015.01/src_phase_3d/m_CS_Magnetic.F90 phase0_2015.01.01/src_phase_3d/m_CS_Magnetic.F90
--- phase0_2015.01/src_phase_3d/m_CS_Magnetic.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_CS_Magnetic.F90 2016-07-12 12:51:53.000000000 +0900
@@ -21,7 +21,7 @@ module m_CS_Magnetic
! ============= 2014/08/14
! == KT_add === 2014/08/26
- use m_Control_Parameters, only : SpinOrbit_mode, noncol
+ use m_Control_Parameters, only : SpinOrbit_mode, noncol, iprisym
use m_Const_Parameters, only : Neglected
use m_Ionic_System, only : mag_moment0_atoms, ionic_charge_atoms, &
& mag_moment0_atoms_is_defined
@@ -46,6 +46,8 @@ module m_CS_Magnetic
integer, allocatable :: magmom_dir_inversion_opr_flag(:)
! ============= 2014/08/14
+ complex(kind=CMPLDP), allocatable :: op_spinor(:,:,:)
+
contains
! ------------------------------------------------------------------------
@@ -1082,4 +1084,104 @@ contains
end subroutine m_CS_set_inverse_operation
+ subroutine m_CS_set_op_spinor
+ integer :: i, j
+ real(kind=DP) :: k1, k2, k3, ux, uy, uz, c1, c2, c3
+ real(kind=DP) :: sinth, costh, theta, s1, determinant
+!
+ real(kind=DP), parameter :: delta = 1.0D-4
+ complex(kind=CMPLDP), parameter :: zi = ( 0.0d0, 1.0d0 )
+!
+ real(kind=DP), allocatable :: op_work(:,:,:)
+!
+ allocate( op_work(3,3,nopr) ); op_work = op
+ if ( .not. allocated( op_spinor ) ) allocate( op_spinor(2,2,nopr) )
+
+ Do i=1, nopr
+ call calc_determinant( op(:,:,i), determinant )
+ if ( determinant < 0 ) then
+ op_work(1,1,i) = -op_work(1,1,i)
+ op_work(2,2,i) = -op_work(2,2,i)
+ op_work(3,3,i) = -op_work(3,3,i)
+ endif
+
+ costh = ( op_work(1,1,i) +op_work(2,2,i) +op_work(3,3,i) -1.0d0 ) /2.0d0
+ sinth = sqrt( 1.0d0 -costh**2 )
+
+ theta = acos( costh )
+!
+ if ( sinth > delta ) then
+ k1 = ( op_work(3,2,i) -op_work(2,3,i) ) /2.0d0
+ k2 = ( op_work(1,3,i) -op_work(3,1,i) ) /2.0d0
+ k3 = ( op_work(2,1,i) -op_work(1,2,i) ) /2.0d0
+
+ ux = k1 /sinth; uy = k2 /sinth; uz = k3 /sinth
+ else
+ if ( costh > 1.0 -delta ) then
+ ux = 0.0d0; uy = 0.0d0; uz = 1.0d0
+ theta = 0.0d0
+ else if ( costh < -1.0 +delta ) then
+ k1 = ( op_work(1,1,i) + 1.d0 )/2.0d0
+ k2 = ( op_work(2,2,i) + 1.d0 )/2.0d0
+ k3 = ( op_work(3,3,i) + 1.d0 )/2.0d0
+
+ ux = sqrt(k1); uy = sqrt(k2); uz = sqrt(k3)
+
+ if ( uz > delta ) then
+ if ( op_work(1,3,i) < 0 ) ux = -ux
+ if ( op_work(2,3,i) < 0 ) uy = -uy
+ else
+ if ( op_work(1,2,i) < 0 ) uy = -uy
+ endif
+
+ endif
+ endif
+
+#if 0
+ write(*,*) "i = ", i, "costh = ", costh, "sinth = ", sinth
+ write(*,'(4(A,F10.2))') "Axis: ux = ", ux, ", uy = ", uy, ", uz = ", uz, &
+ & ", Angle = ", theta /PAI *180.0d0
+ write(*,*)
+#endif
+
+ c1 = cos( theta /2.0d0 ); s1 = sin( theta /2.0d0 );
+
+ op_spinor(1,1,i) = c1 -zi *uz *s1
+ op_spinor(1,2,i) = ( -zi *ux -uy ) *s1
+ op_spinor(2,1,i) = ( -zi *ux +uy ) *s1
+ op_spinor(2,2,i) = c1 +zi *uz *s1
+!
+ if ( determinant < 0 ) op_spinor(:,:,i) = zi *op_spinor(:,:,i)
+ End Do
+!
+ if ( iprisym > 1 ) then
+ write(nfout,*) '*** symmetry operation for spinor ***'
+ Do i=1, nopr
+ write(nfout,*) ' #symmetry op. = ', i
+ write(nfout,'(A,F8.4,A,F8.4,2A,F8.4,A,F8.4,A)') &
+ & '( ', real(op_spinor(1,1,i)), ', ', &
+ & aimag(op_spinor(1,1,i)), ' I ) ', &
+ & '( ',real(op_spinor(1,2,i)), ', ', &
+ & aimag(op_spinor(1,2,i)), ' I )'
+ write(nfout,'(A,F8.4,A,F8.4,2A,F8.4,A,F8.4,A)') &
+ & '( ', real(op_spinor(2,1,i)), ', ', &
+ & aimag(op_spinor(2,1,i)), ' I ) ', &
+ & '( ',real(op_spinor(2,2,i)), ', ', &
+ & aimag(op_spinor(2,2,i)), ' I )'
+ End Do
+ endif
+ deallocate( op_work )
+
+ contains
+
+ subroutine calc_determinant( a, determinant )
+ real(kind=DP), intent(in) :: a(3,3)
+ real(kind=DP), intent(out) :: determinant
+ determinant = a(1,1)*( a(2,2)*a(3,3) -a(2,3)*a(3,2) ) &
+ & -a(1,2)*( a(2,1)*a(3,3) -a(2,3)*a(3,1) ) &
+ & +a(1,3)*( a(2,1)*a(3,2) -a(2,2)*a(3,1) )
+ end subroutine calc_determinant
+
+ end subroutine m_CS_set_op_spinor
+
end module m_CS_Magnetic
diff -uprN phase0_2015.01/src_phase_3d/m_Charge_Density.F90 phase0_2015.01.01/src_phase_3d/m_Charge_Density.F90
--- phase0_2015.01/src_phase_3d/m_Charge_Density.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Charge_Density.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 478 $)
!
! MODULE: m_Charge_Density
!
@@ -86,7 +86,7 @@
#endif
module m_Charge_Density
-! $Id: m_Charge_Density.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Charge_Density.F90 478 2016-03-12 12:28:48Z ktagami $
use m_Const_Parameters, only : BUCS, DP, PAI2, DIRECT,OFF,zi,SKIP &
& , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
& , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
@@ -3033,6 +3033,7 @@ contains
end subroutine m_CD_rd_chgq
+
subroutine m_CD_wd_chgq(nfchgt,F_CHGT_partitioned)
integer, intent(in) :: nfchgt
logical, intent(in) :: F_CHGT_partitioned
@@ -5002,6 +5003,27 @@ contains
! =================================================================== 11.0
+ subroutine m_CD_keep_retrieve_hsr(keep)
+ logical, intent(in) :: keep
+ real(kind=DP),allocatable,dimension(:,:,:,:),save :: hsr_tmp
+ real(kind=DP),allocatable,dimension(:,:,:,:),save :: hsi_tmp
+ if(keep)then
+ if ( noncol ) then
+ if (.not.allocated(hsr_tmp)) allocate(hsr_tmp(natm,nlmt,nlmt,ndim_magmom)); hsr_tmp = hsr
+ if (.not.allocated(hsi_tmp)) allocate(hsi_tmp(natm,nlmt,nlmt,ndim_magmom)); hsi_tmp = hsi_tmp
+ else
+ if(.not.allocated(hsr_tmp)) allocate(hsr_tmp(natm,nlmt,nlmt,nspin)); hsr_tmp = hsr
+ endif
+ else
+ hsr = hsr_tmp
+ deallocate(hsr_tmp)
+ if ( noncol ) then
+ hsi = hsi_tmp
+ deallocate(hsi_tmp)
+ endif
+ endif
+ end subroutine m_CD_keep_retrieve_hsr
+
subroutine m_CD_keep_chgq_l()
! =============================== modified y K. Tagami =============== 11.0
!! allocate(chgq_tmp(ista_kngp:iend_kngp,kimg,nspin)); chgq_tmp = 0.d0
diff -uprN phase0_2015.01/src_phase_3d/m_Const_Parameters.F90 phase0_2015.01.01/src_phase_3d/m_Const_Parameters.F90
--- phase0_2015.01/src_phase_3d/m_Const_Parameters.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Const_Parameters.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_Const_Parameters
!
@@ -32,7 +32,7 @@
!
!***************************************************************
module m_Const_Parameters
-! $Id: m_Const_Parameters.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Const_Parameters.F90 472 2015-11-28 09:01:17Z ktagami $
implicit none
integer, parameter :: DRIVER_GENERAL=0, DRIVER_CONSTRAINT=1, DRIVER_NEB=2, DRIVER_PHONON=3 &
@@ -363,6 +363,11 @@ end type unitlist
integer, parameter :: BULK = 1
integer, parameter :: DEFECT = 2
+integer, parameter :: Positron_CONV = 1 ! zero-density limit, non-scf
+ ! calc p- wfns once
+integer, parameter :: Positron_GGGC = 2 ! zero-density limit, scf
+ ! update e- and p- wfns successively
+integer, parameter :: Positron_PSN = 3 ! fully two-component scf
! ========================== KT_mod =================== 13.0B
!integer, parameter :: unit_list_size = 50
diff -uprN phase0_2015.01/src_phase_3d/m_Control_Parameters.F90 phase0_2015.01.01/src_phase_3d/m_Control_Parameters.F90
--- phase0_2015.01/src_phase_3d/m_Control_Parameters.F90 2015-09-14 15:38:12.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Control_Parameters.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 453 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 492 $)
!
! MODULE: m_Control_Parameters
!
@@ -49,7 +49,7 @@
!
module m_Control_Parameters
! (m_CtrlP)
-! $Id: m_Control_Parameters.F90 453 2015-09-01 05:22:55Z ktagami $
+! $Id: m_Control_Parameters.F90 492 2016-05-31 03:06:04Z jkoga $
!
! This module "m_Control_Parameters" holds parameters that give
! methods and calculational conditions in jobs.
@@ -96,8 +96,7 @@ module m_Control_Parameters
&, BARE, PE1, PE2 &
&, MASK_FUNCTION, PREFITTING
! ==============================================================================
- use m_Parallelization, only : mpi_comm_group,npes,mype,ierr,nrank_e
-
+ use m_Parallelization, only : mpi_comm_group,npes,mype,ierr,nrank_e,nrank_k
! ====================================added by K. Tagami =================5.0
use m_Const_Parameters, only : OccMat_type1, OccMat_Type2, &
& Ueff_From_First, Ueff_Gradually
@@ -109,13 +108,10 @@ module m_Control_Parameters
! ============================================================== 11.0
use m_ErrorMessages, only : INVALID_CHARGE_MIXING
-! ====== KT_add ========================================= 13.0E
- use m_Const_Parameters, only : FERMI_DIRAC, CONST_kB
-! ========= ============================================= 13.0E
-
-! ====== KT_add ========================================= 13.0U3
- use m_Const_Parameters, only : STEPWISE
-! ========= ============================================= 13.0U3
+! ====== KT_add ========================================= 13.0E, 13.0U3, positron
+ use m_Const_Parameters, only : FERMI_DIRAC, CONST_kB, STEPWISE, &
+ & Positron_CONV, Positron_GGGC, Positron_PSN
+! ======================================================= 13.0E, 13.0U3, positron
implicit none
include 'mpif.h'
@@ -195,6 +191,7 @@ module m_Control_Parameters
character(len("convergence_ek")),private, parameter :: tag_convergence_ek = "convergence_ek"
integer :: neg = 1 ! number of eigen values for each k-point
+ logical :: neg_is_given = .false.
integer :: neg_previous ! number of eigen values for each k-point in the previous job
integer :: neg_fixed = 0 ! number of eigen values that are fixed
integer :: num_extra_bands = 0 ! number of extra eigen values for each k-point.
@@ -230,6 +227,15 @@ module m_Control_Parameters
real(kind=DP) :: epsilon_ele
integer :: sw_positron_file = ON
integer :: positron_filetype = CUBE
+
+ integer :: positron_method = Positron_CONV
+
+ character(len("positron_method")),private,parameter :: &
+ & tag_positron_method = "positron_method"
+ character(len("conv")),private,parameter :: tag_conv = "conv"
+ character(len("gggc")),private,parameter :: tag_gggc = "gggc"
+ character(len("psn")),private,parameter :: tag_psn = "psn"
+
character(len=LEN_TITLE) :: positron_title(5)
data positron_title / &
& "positron density", "valence electron density", "e-p pair density" &
@@ -589,6 +595,7 @@ module m_Control_Parameters
#endif
! === KT_add === 13.1R
+ integer :: sw_raman = OFF
integer :: sw_phonon_with_epsilon = OFF
integer :: sw_calc_dielectric_tensor = OFF
! ============== 13.1R
@@ -676,6 +683,19 @@ module m_Control_Parameters
integer :: sw_neglect_stress_offdiagonal = OFF
! ==== 2014/11/22
+! ==== EXP_CELLOPT === 2015/09/24
+! -----------------------
+! read nfchgt.data of previous cell
+! -----------------------
+ character(len("sw_read_nfchgt_prev_cell")),private,parameter :: &
+ & tag_sw_read_nfchgt_prev_cell = "sw_read_nfchgt_prev_cell"
+ character(len("sw_read_nfzaj_prev_cell")),private,parameter :: &
+ & tag_sw_read_nfzaj_prev_cell = "sw_read_nfzaj_prev_cell"
+
+ integer :: sw_read_nfchgt_prev_cell = OFF
+ integer :: sw_read_nfzaj_prev_cell = OFF
+! ==================== 2015/09/24
+
! -------------------
! symmetry during optimization
! ------------------
@@ -889,6 +909,7 @@ module m_Control_Parameters
character(len("none")),private,parameter :: tag_none = "none"
character(len("0")),private,parameter :: tag_0 = "0"
character(len("unit_matrix")),private,parameter :: tag_unit_matrix = "unit_matrix"
+ character(len("spin_polarized")),private,parameter :: tag_spin_polarized = "spin_polarized"
! === For restart lm+MSD! by tkato 2012/02/16 ==================================
character(len("dtim_previous")), private, parameter :: tag_dtim_previous = "dtim_previous"
! ==============================================================================
@@ -1131,6 +1152,7 @@ module m_Control_Parameters
!!$ real(kind=DP),private :: edelta_change_to_rmm = 1.d-7
real(kind=DP),private :: edelta_change_to_rmm = 1.d-3
real(kind=DP),private :: edelta_change_to_rmm_md = 1.d-3
+ logical,private :: edelta_rmm_given = .false.
integer,public :: rmm_save_memory_mode = OFF
character(len("rmm")),private,parameter :: tag_rmm = "rmm"
character(len("imGSrmm")),private,parameter :: tag_imGSrmm = "imgsrmm"
@@ -1180,11 +1202,17 @@ module m_Control_Parameters
real(kind=DP) :: damp = 1.d0
integer :: submat_period = 1
real(kind=DP) :: submat_critical_ratio = 1.d-15
+#ifdef _USE_SCALAPACK_
+ integer :: sw_scalapack = ON
+#else
integer :: sw_scalapack = OFF
+#endif
#ifdef _DEFAULT_HOUSEHOLDER_
integer :: method_scalapack = HOUSEHOLDER
-#else
+#elif _DEFAULT_DIVIDEandCONQUER_
integer :: method_scalapack = DIVIDEandCONQUER
+#else
+ integer :: method_scalapack = HOUSEHOLDER
#endif
!finteger :: block_size = 64
integer :: block_size = 0
@@ -1475,12 +1503,16 @@ module m_Control_Parameters
& tag_sw_mix_charge_hardpart = "sw_mix_charge_hardpart"
character(len("sw_mix_bothspins_sametime")), private, parameter :: &
& tag_sw_mix_bothspins_sametime = "sw_mix_bothspins_sametime"
+ character(len("sw_mix_occ_matrix")),private,parameter :: &
+ & tag_sw_mix_occ_matrix = "sw_mix_occ_matrix"
!!$ integer :: sw_mix_charge_hardpart = OFF
!!$ integer :: sw_mix_bothspins_sametime = OFF
integer :: sw_mix_charge_hardpart = OFF
integer :: sw_mix_bothspins_sametime = ON
!
!
+ integer :: sw_mix_occ_matrix = OFF
+
character(len("sw_force_simple_mixing_hsr")), private, parameter :: &
& tag_sw_force_simplemix_hsr = "sw_force_simple_mixing_hsr"
character(len("sw_recomposing_hsr")), private, parameter :: &
@@ -1675,6 +1707,7 @@ module m_Control_Parameters
integer,public :: dos_method = Gauss_distrib_func
integer,public :: sw_dos_gaussdistrib = OFF
integer,public :: dos_subroutine = 5
+
real(kind=DP),public :: deltaE_dos = 1.d-4
real(kind=DP),public :: variance_dos_GaussD = 1.d-6
integer,public :: nwd_dos_window_width = 10
@@ -1793,7 +1826,17 @@ module m_Control_Parameters
character(len("ry")),private,parameter :: tag_ry = "ry"
character(len("rz")),private,parameter :: tag_rz = "rz"
-! ---- WaveFuction Squared
+! ---- WaveFunction Orb-projection
+ integer :: sw_print_wf_orb_projection = OFF
+ integer :: wf_orb_proj_print_format = 0
+ character(len("wf_orb_projection")),private,parameter :: &
+ & tag_wf_orb_projection = "wf_orb_projection"
+ character(len("sw_print_wf_orb_projection")),private,parameter :: &
+ & tag_sw_print_wf_orb_projection = "sw_print_wf_orb_projection"
+ character(len("wf_orb_proj_print_format")),private,parameter :: &
+ & tag_wf_orb_proj_print_format = "wf_orb_proj_print_format"
+
+! ---- WaveFunction Squared
integer :: sw_wf_squared_rspace = OFF
integer,public :: wf_squared_filetype = CUBE
integer,public :: ik_wf_squared = 1
@@ -1838,7 +1881,7 @@ module m_Control_Parameters
! --- approximate DFT+U : Hubbard model ---
integer :: sw_hubbard = OFF
integer :: sw_constraint = OFF
- integer :: initial_occmat = SPIN_POLARIZED
+ integer :: initial_occmat = OFF
real(kind=DP) :: initial_occmat_factor=1.d0
integer :: const_site = 0
real(kind=DP) :: const_alpha = 0.d0
@@ -2120,7 +2163,6 @@ module m_Control_Parameters
integer :: sw_remove_pcc_from_pawpot = off
! ================== 13.0Y
- integer :: sw_rspace_hyb = OFF
character(len("sw_eval_vexx")), private, parameter :: tag_sw_eval_vexx = "sw_eval_vexx"
character(len("sw_retard_eigval_evaluation")), private, parameter :: &
& tag_sw_retard_eigval_evaluation = "sw_retard_eigval_evaluation"
@@ -2355,6 +2397,13 @@ module m_Control_Parameters
integer :: lmax_rsb = 3
real(kind=DP) :: eps_rsb = 1.d-2
+! --- msb effect
+ character(len("msb")), private, parameter :: &
+ & tag_msb = "msb"
+ character(len("sw_calc_contact_density")), private, parameter :: &
+ & tag_sw_calc_contact_density = "sw_calc_contact_density"
+ integer :: sw_calc_contact_density = off
+
! ================= KT_add === 13.0S
!-- CoreLevels
!
@@ -2470,6 +2519,7 @@ module m_Control_Parameters
integer :: nr12=3000,nk=1500
real(kind=DP) :: maxk=10.d0,r12max=30.0d0
logical :: oneshot = .true.
+ logical :: sw_save_memory_vdw = .true.
logical :: force_exx_energy1=.false.
@@ -2568,6 +2618,19 @@ contains
if(mype == 0 .or. ipriparadeb /= 0) printable = .true.
end subroutine m_CtrlP_set_printable
+#ifdef _USE_SCALAPACK_
+ subroutine m_CtrlP_set_sw_scalapack(printable)
+ logical, intent(in) :: printable
+ if(nrank_k >=2) then
+ sw_scalapack = OFF
+ ! This is a tentative default setting until scalapack parallelization is completed for nrank_k>=2
+ if(printable) write(6,'(a)') ' default parameter of sw_scalapack is set off'
+ else
+ if(printable) write(6,'(a," : sw_scalapack = ",i3)') ' default parameter of sw_scalapack is not changed', sw_scalapack
+ end if
+ end subroutine m_CtrlP_set_sw_scalapack
+#endif
+
#ifndef _EMPIRICAL_
subroutine m_CtrlP_check_matm(nfout,natm)
integer, intent(in) :: nfout,natm
@@ -2576,6 +2639,10 @@ contains
if(printable) &
& write(nfout,'(" !** rmm_precal_phase_matm(redefined) = ",i10," <<m_CtrlP_check_matm>>")') rmm_precal_phase_matm
end if
+ if(.not.edelta_rmm_given)then
+ edelta_change_to_rmm = 1.d-3/dble(natm)
+ edelta_change_to_rmm_md = 1.d-3/dble(natm)
+ endif
end subroutine m_CtrlP_check_matm
subroutine alloc_w_solver(n)
@@ -3220,12 +3287,12 @@ contains
logical :: tf
call strncmp0(trim(rstr), tag_bulk, tf)
if(tf) then
- sw_positron = BULK
+ sw_positron = BULK; positron_method = Positron_CONV
goto 1001
end if
call strncmp0(trim(rstr), tag_defect, tf)
if(tf) then
- sw_positron = DEFECT
+ sw_positron = DEFECT; positron_method = Positron_GGGC
goto 1001
end if
1001 continue
@@ -3284,13 +3351,18 @@ contains
gmaxp = gmax*2.d0
end if
if(sw_positron /= OFF) call getgmax_positron()
- if( f_getIntValue( tag_num_bands, iret ) == 0) neg = iret
+ if( f_getIntValue( tag_num_bands, iret ) == 0) then
+ neg = iret
+ neg_is_given = .true.
+ end if
if( f_selectBlock( tag_smearing) == 0) then
if( f_getStringValue( tag_smearing_method, rstr,LOWER) == 0) then
call set_smearing_method(rstr) ! way_of_smearing
end if
- if( f_getRealValue( tag_smearing_width, dret, "hartree") == 0) width = dret
- if(way_of_smearing == TETRAHEDRON) width_tetra = width
+ if( f_getRealValue( tag_smearing_width, dret, "hartree") == 0) then
+ width = dret
+ if(way_of_smearing == TETRAHEDRON) width_tetra = width
+ endif
if( f_selectBlock( tag_tetrahedron) == 0) then
if( f_getIntValue( tag_dimension, iret ) == 0) idimtetra = iret
if( f_getIntValue( tag_sw_correction, iret ) == 0) sw_correction = iret
@@ -3416,12 +3488,33 @@ contains
if( f_getIntValue( tag_f3, iret ) == 0) reduction_factor_exx(3) = iret
iret = f_selectParentBlock()
end if
+ if(f_getStringValue(tag_functional_type,rstr,LOWER)==0)then
+ if(rstr.eq.tag_pbe0) then
+ write(nfout,'(a)') ' !** functional_type : PBE0'
+ alpha_exx = 0.25d0
+ sw_screened_exchange = OFF
+ sw_exchange_only = OFF
+ else if (rstr.eq.tag_hse06) then
+ write(nfout,'(a)') ' !** functional_type : HSE06'
+ alpha_exx = 0.25d0
+ omega_exx = 0.106d0
+ sw_screened_exchange = ON
+ sw_exchange_only = OFF
+ else if (rstr.eq.tag_hf) then
+ write(nfout,'(a)') ' !** functional_type : HF (Hartree-Fock)'
+ alpha_exx = 1.d0
+ sw_screened_exchange = OFF
+ sw_exchange_only = ON
+ else
+ write(nfout,'(a)') ' !** WARNING : invalid functional_type : '//trim(rstr)
+ endif
+ endif
+
if( f_getRealValue( tag_alpha, dret, "") == 0) alpha_exx = dret
if( f_getRealValue( tag_omega, dret, "") == 0) omega_exx = dret
if( f_getRealValue( tag_omega_hf, dret, "") == 0) omega_exx = dret
if( f_getRealValue( tag_omega_pbe, dret, "") == 0) omega_exx_pbe = dret
- if( f_getIntValue(tag_sw_rspace,iret)==0 ) sw_rspace_hyb = iret
if( f_getIntValue(tag_sw_eval_vexx,iret)==0 ) sw_eval_vexx = iret
if( f_getIntValue(tag_sw_retard_eigval_evaluation,iret)==0 ) sw_retard_eigval_evaluation = iret
if( f_getIntValue(tag_sw_precalculate,iret)==0 ) sw_precalculate = iret
@@ -3439,8 +3532,6 @@ contains
endif
endif
-! ============================= KT_Test ============================ 12.5Exp
-! ------
if( f_getIntValue( tag_truncate_vxw_updating, iret ) == 0 ) then
if(iret==ON) truncate_vxw_updating = .true.
endif
@@ -3455,9 +3546,6 @@ contains
hybrid_calc_is_active = .true.
gmax_exx = gmax; gmaxp_exx = gmaxp
- if(nmax_G_hyb==-1) gmaxp_exx = gmax*2.d0
- if(nmax_G_hyb==-2) gmaxp_exx = gmax*4.d0**(1.d0/3.d0)
- if(nmax_G_hyb==-3) gmaxp_exx = gmax
! -----
if ( f_getRealValue( tag_gmax_exx_ratio, dret, "") == 0 ) then
if( dret < 0.2D0 .or. dret > 1.0D0 ) then
@@ -3518,27 +3606,6 @@ contains
if(rstr.eq.tag_minimal) potential_update = 2
endif
- if(f_getStringValue(tag_functional_type,rstr,LOWER)==0)then
- if(rstr.eq.tag_pbe0) then
- write(nfout,'(a)') ' !** functional_type : PBE0'
- alpha_exx = 0.25d0
- sw_screened_exchange = OFF
- sw_exchange_only = OFF
- else if (rstr.eq.tag_hse06) then
- write(nfout,'(a)') ' !** functional_type : HSE06'
- alpha_exx = 0.25d0
- omega_exx = 0.106d0
- sw_screened_exchange = ON
- sw_exchange_only = OFF
- else if (rstr.eq.tag_hf) then
- write(nfout,'(a)') ' !** functional_type : HF (Hartree-Fock)'
- alpha_exx = 1.d0
- sw_screened_exchange = OFF
- sw_exchange_only = ON
- else
- write(nfout,'(a)') ' !** WARNING : invalid functional_type : '//trim(rstr)
- endif
- endif
if(ipriinputfile>=1) then
write(nfout,'(" <<< Hybrid functional method >>>")')
if(sw_exchange_only==ON) &
@@ -3919,6 +3986,20 @@ contains
end if
! ------- Positron start
+ iret = f_getStringValue(tag_positron_method,rstr,LOWER)
+ if( rstr == tag_CONV ) then
+ positron_method = Positron_CONV; sw_positron = BULK
+ else if( rstr == tag_GGGC ) then
+ positron_method = Positron_GGGC; sw_positron = DEFECT
+ else if( rstr == tag_PSN ) then
+ positron_method = Positron_PSN; sw_positron = DEFECT
+ stop "Positron-PSN : Not implemented"
+ end if
+ if ( sw_positron /= OFF ) then
+ write(nfout,*) "!** Positron_method is set to ", positron_method
+ if ( gmax_positron < 0.01 ) call getgmax_positron()
+ endif
+
if(sw_positron /= OFF) then
npeg = 1
num_extra_pev = 0
@@ -4541,6 +4622,7 @@ write(nfout,'(" !** sw_screening_correct
if(f_getRealValue(tag_a1,dret,'')==0) a1 = dret
if(f_getRealValue(tag_a2,dret,'')==0) a2 = dret
if(f_getIntValue(tag_eval_kernel_by_interpolation,iret)==0) eval_kernel_by_interpolation = iret == ON
+ if(f_getIntValue(tag_save_memory_mode,iret)==0) sw_save_memory_vdw = iret == ON
iret = f_selectParentBlock()
endif
@@ -4576,7 +4658,6 @@ write(nfout,'(" !** sw_screening_correct
subroutine set_initial_occmat(rstr)
character(len=FMAXVALLEN),intent(in) :: rstr
logical :: tf
- initial_occmat = SPIN_POLARIZED
call strncmp2(rstr, FMAXVALLEN, tag_off, len(tag_off), tf)
if(.not.tf) call strncmp0(trim(rstr),tag_off, tf)
if(.not.tf) call strncmp0(trim(rstr),tag_none,tf)
@@ -4592,6 +4673,12 @@ write(nfout,'(" !** sw_screening_correct
goto 1001
endif
+ call strncmp0(trim(rstr), tag_spin_polarized, tf)
+ if(tf) then
+ initial_occmat = SPIN_POLARIZED
+ goto 1001
+ endif
+
call strncmp0(trim(rstr), tag_initial_es, tf)
if(tf) then
sw_initial_es = ON
@@ -4795,8 +4882,8 @@ write(nfout,'(" !** sw_screening_correct
end subroutine m_CtrlP_rd_accuracy
#ifndef _EMPIRICAL_
- subroutine m_CtrlP_rd_wfsolver(nfout)
- integer, intent(in) :: nfout
+ subroutine m_CtrlP_rd_wfsolver(nfout,natm)
+ integer, intent(in) :: nfout,natm
integer :: f_selectBlock, f_getIntValue, f_getRealValue, f_getStringValue
integer :: f_selectParentBlock, f_selectTop
integer :: iret,i,ba
@@ -4821,10 +4908,8 @@ write(nfout,'(" !** sw_screening_correct
! determine the default value for the davidson-related variables
if(neg/nrank_e<4) then
- sw_divide_subspace=OFF
sw_divide_subspace_changed = .true.
sw_npartition_changed = .true.
- if(printable) write(nfout,'(" !** REMARK: sw_divide_subspace is set to OFF ")')
else
npartition_david = neg/(nblock*nrank_e)
if (npartition_david<1) npartition_david = 1
@@ -4834,7 +4919,7 @@ write(nfout,'(" !** sw_screening_correct
if(.not.explict_solver)then
tag_solver_of_WF_is_found = .true.
- call configure_wf_solver(solver_set)
+ call configure_wf_solver(solver_set,natm)
meg = neg
endif
@@ -4991,6 +5076,11 @@ write(nfout,'(" !** sw_screening_correct
end if
! ---- rmm ---
+ if( explict_solver )then
+ edelta_change_to_rmm = 1.e-3/dble(natm)
+ edelta_change_to_rmm_md = 1.e-3/dble(natm)
+ endif
+
if( f_selectBlock( tag_rmm) == 0) then
if(ipriinputfile >= 2 .and. printable) write(nfout,'(" !** -- tag_rmm is found --")')
if( f_getIntValue(tag_imGSrmm, iret) == 0) imGSrmm = iret
@@ -5001,9 +5091,11 @@ write(nfout,'(" !** sw_screening_correct
if( f_getRealValue(tag_edelta_change_to_rmm,dret,'hartree')==0) then
edelta_change_to_rmm = dret
edelta_change_to_rmm_md = dret
+ edelta_rmm_given = .true.
endif
if(f_getRealValue(tag_edelta_change_to_rmm_md,dret,'hartree')==0)then
edelta_change_to_rmm_md = dret
+ edelta_rmm_given = .true.
endif
if( f_getIntValue(tag_save_memory_mode, iret) == 0) rmm_save_memory_mode = iret
iret = f_selectParentBlock()
@@ -5073,6 +5165,11 @@ write(nfout,'(" !** sw_screening_correct
write(nfout,'(" !** before_renewal= OFF")')
end if
end if
+
+!!$!BRANCH_P 3D_Parallel
+!!$ if(nrank_k>=2) sw_scalapack = OFF
+!!$ ! This is a tentative default setting until scalapack parallelization is completed for nrank_k>=2
+!!$!BRANCH_P_END 3D_Parallel
if( f_selectBlock( tag_scalapack) == 0) then
if( f_getIntValue(tag_sw_scalapack, iret) == 0) sw_scalapack = iret
#ifndef _USE_SCALAPACK_
@@ -5202,8 +5299,11 @@ write(nfout,'(" !** sw_screening_correct
iret = f_selectParentBlock()
else
max_subspace_size = 4*neg ! default value
- if(ipriinputfile >= 2 .and. printable) &
- & write(nfout,'(" !* tag_davidson is not found")')
+!!$ if(ipriinputfile >= 2 .and. printable) &
+ if(ipriinputfile >= 1 .and. printable) then
+ write(nfout,'(" !* tag_davidson is not found")')
+ write(nfout,'(" !** max_subspace_size = ",i6)') max_subspace_size
+ end if
end if
! ---- Modified Davidson ---
@@ -5321,19 +5421,19 @@ write(nfout,'(" !** sw_screening_correct
1001 continue
end subroutine set_energy_evaluation
- subroutine configure_wf_solver(solver_set)
- integer, intent(in) :: solver_set
+ subroutine configure_wf_solver(solver_set,natm)
+ integer, intent(in) :: solver_set,natm
integer :: i
if(solver_set == LMM_RMM)then
call alloc_w_solver(2)
w_solver(1)%solver = lmMSD
w_solver(1)%subspace_rotation = ON
- w_solver(1)%till_n_iter = 2
+ w_solver(1)%till_n_iter = 5
w_solver(2)%solver = RMM3
w_solver(2)%till_n_iter = -1
w_solver(2)%subspace_rotation = ON
- edelta_change_to_rmm = 1.d-4
- edelta_change_to_rmm_md = 1.d-4
+ edelta_change_to_rmm = 1.d-4/dble(natm)
+ edelta_change_to_rmm_md = 1.d-4/dble(natm)
n_WF_solvers_before = 2
n_WF_solvers_after = 0
n_WF_solvers_all = n_WF_solvers_before + n_WF_solvers_after
@@ -5342,18 +5442,25 @@ write(nfout,'(" !** sw_screening_correct
call alloc_w_solver(4)
if(icond==INITIAL .or. icond==CONTINUATION .or. icond==AUTOMATIC)then
w_solver(1)%solver = MDDAVIDSON
+ w_solver(3)%solver = MDDAVIDSON
else
w_solver(1)%solver = MDKOSUGI
+ w_solver(3)%solver = MDKOSUGI
+ endif
+ if(sw_hubbard==ON) then
+ w_solver(1)%solver = MDKOSUGI
+ w_solver(3)%solver = MDKOSUGI
endif
- if(sw_hubbard==ON) w_solver(1)%solver = MDKOSUGI
-
! === KT_add === 2015/01/05
- if ( noncol ) w_solver(1)%solver = MDDAVIDSON
+ if ( noncol ) then
+ w_solver(1)%solver = MDDAVIDSON
+ w_solver(3)%solver = MDDAVIDSON
+ endif
! ============== 2015/01/05
! w_solver(1)%solver = MDKOSUGI
w_solver(1)%subspace_rotation = ON
- w_solver(1)%till_n_iter = 2
+ w_solver(1)%till_n_iter = 5
w_solver(1)%precon = ON
w_solver(1)%before_or_after_convergence = BEFORE
w_solver(2)%solver = RMM3
@@ -5361,9 +5468,9 @@ write(nfout,'(" !** sw_screening_correct
w_solver(2)%till_n_iter = -1
w_solver(2)%subspace_rotation = ON
w_solver(2)%before_or_after_convergence = BEFORE
- w_solver(3)%solver = MDDAVIDSON
+ !!w_solver(3)%solver = MDDAVIDSON
w_solver(3)%subspace_rotation = ON
- w_solver(3)%till_n_iter = 1
+ w_solver(3)%till_n_iter = 5
w_solver(3)%precon = ON
w_solver(3)%before_or_after_convergence = AFTER
w_solver(4)%solver = RMM3
@@ -5371,8 +5478,8 @@ write(nfout,'(" !** sw_screening_correct
w_solver(4)%till_n_iter = -1
w_solver(4)%subspace_rotation = ON
w_solver(4)%before_or_after_convergence = AFTER
- edelta_change_to_rmm = 1.d-3
- edelta_change_to_rmm_md = 1.d-3
+ edelta_change_to_rmm = 1.d-3/dble(natm)
+ edelta_change_to_rmm_md = 1.d-3/dble(natm)
n_WF_solvers_before = 2
n_WF_solvers_after = 2
n_WF_solvers_all = n_WF_solvers_before + n_WF_solvers_after
@@ -5416,15 +5523,15 @@ write(nfout,'(" !** sw_screening_correct
!!$if (sw_hubbard==ON.or.nspin>1) sw_divide_subspace=OFF
if (printable) write(nfout,'(" !** applied wavefunction solver set : davidson")')
endif
- if (n_WF_solvers_before>1)then
- if(intzaj == by_matrix_diagon)then
- do i=1,n_WF_solvers_before-1
- w_solver(i)%till_n_iter = i+1
- enddo
- else
- w_solver(1)%till_n_iter = 1
- endif
- endif
+ !if (n_WF_solvers_before>1)then
+ ! if(intzaj == by_matrix_diagon)then
+ ! do i=1,n_WF_solvers_before-1
+ ! w_solver(i)%till_n_iter = i+4
+ ! enddo
+ ! else
+ ! w_solver(1)%till_n_iter = 5
+ ! endif
+ !endif
end subroutine configure_wf_solver
subroutine set_wfsolvers(prealloc,msol,nbase,ba,iret)
@@ -5947,9 +6054,19 @@ write(nfout,'(" !** sw_screening_correct
write(nfout,*) '!** sw_neglect_stress_offdiagonal is ', iret
endif
! === 2014/11/22
-
! ======== 13.1AS
+! === EXP_CELLOPT === 2015/09/24
+ if ( f_getIntValue( tag_sw_read_nfchgt_prev_cell, iret ) ==0 ) then
+ sw_read_nfchgt_prev_cell = iret
+ write(nfout,*) '!** sw_read_nfchgt_prev_cell is ', iret
+ endif
+ if ( f_getIntValue( tag_sw_read_nfzaj_prev_cell, iret ) ==0 ) then
+ sw_read_nfzaj_prev_cell = iret
+ write(nfout,*) '!** sw_read_nfzaj_prev_cell is ', iret
+ endif
+! ================== 2015/09/24
+
iret = f_selectParentBlock()
endif
@@ -6179,6 +6296,8 @@ write(nfout,'(" !** sw_screening_correct
endif
! ======================================================================= 5.0
+ if(f_getIntValue(tag_sw_mix_occ_matrix,iret)==0) sw_mix_occ_matrix = iret
+
! ================================ added by K. Tagami ================== 11.0
if (f_getIntValue( tag_sw_mix_imaginary_hardpart,iret ) == 0 ) then
sw_mix_imaginary_hardpart = iret
@@ -7311,6 +7430,23 @@ write(nfout,'(" !** sw_screening_correct
iret = f_selectParentBlock()
end if
+ if ( f_selectBlock( tag_wf_orb_projection ) == 0 ) then
+ if ( f_getIntValue( tag_sw_print_wf_orb_projection, iret ) == 0 ) then
+ sw_print_wf_orb_projection = iret
+ endif
+ if ( f_getIntValue( tag_wf_orb_proj_print_format, iret ) == 0 ) then
+ if ( iret < 0 .or. iret > 1 ) iret = 0
+ wf_orb_proj_print_format = iret
+ endif
+ if (ipriinputfile >= 1) then
+ write(nfout,'(A,I6)') " !** sw_print_wf_orb_projection = ", &
+ & sw_print_wf_orb_projection
+ write(nfout,'(A,i6,A)') "!** wf_orb_proj_print_format = ", &
+ & wf_orb_proj_print_format, " ( 0: {l m t}, 1: {j l mj t} )"
+ endif
+ iret = f_selectParentBlock()
+ endif
+
if( f_selectBlock( tag_wf_squared ) == 0 ) then
if( f_getIntValue( tag_sw_wf_squared_rspace, iret) == 0) &
& sw_wf_squared_rspace = iret
@@ -7340,6 +7476,14 @@ write(nfout,'(" !** sw_screening_correct
iret = f_selectParentBlock()
endif
+ if( f_selectBlock( tag_msb ) == 0) then
+ if( f_getIntValue( tag_sw_calc_contact_density, iret) == 0) then
+ sw_calc_contact_density = iret
+ write(nfout,*) "!** sw_calc_contact_density is ", iret
+ endif
+ iret = f_selectParentBlock()
+ endif
+
if( f_selectBlock( tag_elf) == 0) then
if(ipriinputfile >= 2) write(nfout,'(" !* tag_elf")')
if( f_getIntValue( tag_sw_elf, iret) == 0) sw_elf = iret
@@ -8960,9 +9104,9 @@ write(nfout,'(" !** sw_screening_correct
if(printable) write(6,'(" iconvergence_previous_job is reset " &
& ,i2,", because neg_previous < neg")') iconvergence_previous_job
end if
- if(sw_optimize_lattice==ON)then
- iconvergence_previous_job = 0
- endif
+ !if(sw_optimize_lattice==ON)then
+ ! iconvergence_previous_job = 0
+ !endif
end subroutine m_CtrlP_rd_iconvergence
subroutine m_CtrlP_reset_iconvergence
@@ -10862,6 +11006,7 @@ write(nfout,'(" !** sw_screening_correct
else
neg = int(t*(1+t**p))
end if
+ neg_is_given = .true.
end subroutine m_CtrlP_set_neg_properly
subroutine m_CtrlP_flag_mpi_G_dot_R(nfout,nbmx)
diff -uprN phase0_2015.01/src_phase_3d/m_Crystal_Structure.F90 phase0_2015.01.01/src_phase_3d/m_Crystal_Structure.F90
--- phase0_2015.01/src_phase_3d/m_Crystal_Structure.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Crystal_Structure.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 464 $)
!
! MODULE: m_Crystal_Structure
!
@@ -33,7 +33,7 @@
!
module m_Crystal_Structure
! (m_CS)
-! $Id: m_Crystal_Structure.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Crystal_Structure.F90 464 2015-09-23 14:29:53Z ktagami $
!!$ use m_Files, only : nfout,nfopgr,nfmatbp &
use m_Timing, only : tstatc0_begin, tstatc0_end
use m_Control_Parameters, only : ipri, af, m_CtrlP_set_af, m_CtrlP_set_nspin_and_af &
@@ -272,8 +272,10 @@ module m_Crystal_Structure
character(len("level_of_projection_paw_charge")), private, parameter :: &
& tag_level_projection_paw_charge = "level_of_projection_paw_charge"
+! --- magnetic moment
character(len("axis")),private,parameter :: tag_axis = "axis"
character(len("direction")),private,parameter :: tag_direction = "direction"
+ character(len("moment")),private,parameter :: tag_moment = "moment"
character(len("magnetic_moment")),private,parameter :: tag_magnetic_moment &
& = "magnetic_moment"
@@ -384,18 +386,31 @@ module m_Crystal_Structure
character(len("edelta_change_lambda_last")), private, parameter :: &
& tag_edelta_change_lambda_last = "edelta_change_lambda_last"
!
- character(len("max_iterations_constraint")), private, parameter :: &
- & tag_max_iterations_constraint = "max_iterations_constraint"
+ character(len("max_iter_elec_mag_constraint")), private, parameter :: &
+ & tag_max_iter_elec_mag_constr = "max_iter_elec_mag_constraint"
+ character(len("max_iter_ion_mag_constraint")), private, parameter :: &
+ & tag_max_iter_ion_mag_constr = "max_iter_ion_mag_constraint"
+ character(len("max_iter_cell_mag_constraint")), private, parameter :: &
+ & tag_max_iter_cell_mag_constr = "max_iter_cell_mag_constraint"
!
+ character(len("sw_fix_charge_after_constraint")), private, parameter :: &
+ & tag_sw_fix_charge_after_constr = "sw_fix_charge_after_constraint"
+
integer, parameter :: nmax_intermid_lambda = 100
!
integer :: sw_magnetic_constraint = OFF
integer :: mag_constraint_type = 0
- integer :: damping_method_mag_constraint = 0
- integer :: num_intermid_lambda = 0
- integer :: max_iterations_mag_constraint = 0
+ integer :: damping_method_mag_constraint = ABRUPT
+ integer :: num_intermid_lambda = 2
+!
+ integer :: max_iter_elec_mag_constraint = 50
+ integer :: max_iter_ion_mag_constraint = 1
+! integer :: max_iter_cell_mag_constraint = 100
+ integer :: max_iter_cell_mag_constraint = 1
+
+ integer :: sw_fix_charge_after_constraint = OFF
!
- real(kind=DP) :: mag_constraint_lambda = 0.0d0
+ real(kind=DP) :: mag_constraint_lambda = 0.20d0
real(kind=DP) :: edelta_change_lambda_first = 1.0D-4 ! hartree
real(kind=DP) :: edelta_change_lambda_last = 1.0D-4 ! hartree
! ======================================================== 13.0U
@@ -1294,9 +1309,9 @@ contains
if ( damping_method_mag_constraint == ABRUPT .or. &
& damping_method_mag_constraint == LINEAR ) then
- if ( f_getIntValue( tag_max_iterations_constraint, iret ) == 0 ) then
- if ( iret < 0 ) max_iterations_mag_constraint = 0
- max_iterations_mag_constraint = iret
+ if ( f_getIntValue( tag_max_iter_elec_mag_constr, iret ) == 0 ) then
+ if ( iret < 0 ) max_iter_elec_mag_constraint = 0
+ max_iter_elec_mag_constraint = iret
endif
endif
@@ -1313,10 +1328,27 @@ contains
if ( damping_method_mag_constraint == ABRUPT .or. &
& damping_method_mag_constraint == LINEAR ) then
- write(nfout,*) '! max_iterations_mag_constraint is ', &
- & max_iterations_mag_constraint
+ write(nfout,*) '! max_iter_elec_mag_constraint is ', &
+ & max_iter_elec_mag_constraint
endif
+ if ( f_getIntValue( tag_max_iter_ion_mag_constr, iret ) == 0 ) then
+ if ( iret < 0 ) max_iter_ion_mag_constraint = 0
+ max_iter_ion_mag_constraint = iret
+ endif
+ if ( f_getIntValue( tag_max_iter_cell_mag_constr, iret ) == 0 ) then
+ if ( iret < 0 ) max_iter_cell_mag_constraint = 0
+ max_iter_cell_mag_constraint = iret
+ endif
+
+ if ( f_getIntValue( tag_sw_fix_charge_after_constr, iret ) == 0 ) then
+ sw_fix_charge_after_constraint = iret
+ write(nfout,*) '! sw_fix_charge_after_constraint is ', &
+ & sw_fix_charge_after_constraint
+ endif
+
+ write(nfout,*) '! max_iter_ion_mag_constraint is ', max_iter_ion_mag_constraint
+ write(nfout,*) '! max_iter_cell_mag_constraint is ', max_iter_cell_mag_constraint
write(nfout,*) '! *********************************************** '
@@ -1356,6 +1388,9 @@ contains
if ( f_getRealValue( tag_norm, dret, "" ) == 0 ) then
norm = dret
end if
+ if ( f_getRealValue( tag_moment, dret, "" ) == 0 ) then
+ norm = dret
+ end if
if ( f_getRealValue( tag_theta, dret, "" ) == 0 ) then
theta = dret
end if
@@ -1373,8 +1408,10 @@ contains
else
if ( f_getRealValue( tag_norm, dret, "" ) == 0 ) then
- norm = dret
- mag_moment0_global(1) = norm
+ norm = dret; mag_moment0_global(1) = norm
+ end if
+ if ( f_getRealValue( tag_moment, dret, "" ) == 0 ) then
+ norm = dret; mag_moment0_global(1) = norm
end if
endif
@@ -1410,7 +1447,8 @@ contains
mag_direc0_global(2) = 0.0d0
mag_direc0_global(3) = 1.0d0
- if ( f_selectBlock( tag_direction ) == 0 ) then
+ if ( f_selectBlock( tag_direction ) == 0 .or. &
+ & f_selectBlock( tag_magnetic_moment ) == 0 ) then
if( f_getRealValue( tag_mdx, dret, '') == 0 ) then
mdx = dret; Flag = 1
@@ -1421,6 +1459,16 @@ contains
if( f_getRealValue( tag_mdz, dret, '') == 0 ) then
mdz = dret; Flag = 1
endif
+
+ if( f_getRealValue( tag_mx, dret, '') == 0 ) then
+ mdx = dret; Flag = 1
+ endif
+ if( f_getRealValue( tag_my, dret, '') == 0 ) then
+ mdy = dret; Flag = 1
+ endif
+ if( f_getRealValue( tag_mz, dret, '') == 0 ) then
+ mdz = dret; Flag = 1
+ endif
cnorm = sqrt( mdx**2 + mdy**2 + mdz**2 )
if ( abs(cnorm) > 1.0E-4 ) then
diff -uprN phase0_2015.01/src_phase_3d/m_ES_ExactExchange.F90 phase0_2015.01.01/src_phase_3d/m_ES_ExactExchange.F90
--- phase0_2015.01/src_phase_3d/m_ES_ExactExchange.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_ExactExchange.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,7 +1,7 @@
#define HYBRID_DGEMM
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 485 $)
!
! MODULE: m_ES_ExactExchange
!
@@ -36,13 +36,14 @@ module m_ES_ExactExchange
use m_Electronic_Structure,only: totch,zaj_l,occup_l,neordr,eko_l,vnlph_l,fsr_l,fsi_l
use m_NonLocal_Potential, only : snl
use m_PlaneWaveBasisSet, only : ngabc,igf,kg1,kg,kgp,nbase,nbmx,iba,m_pwBS_kinetic_energies &
- & , nbase_gamma,igfp_l,ngpt_l,m_pwBS_sphrp_exx,kgp_exx, igfp_exx
+ & , nbase_gamma,igfp_l,ngpt_l,m_pwBS_sphrp_exx,kgp_exx, igfp_exx, n_rGpv
use m_Kpoints, only : kv3,vkxyz,kv3_ek,vkxyz_ek,k_symmetry,qwgt,qwgt_ek,mp_index &
& , m_Kp_sample_mesh, kshift
use m_FFT, only : nfft,fft_box_size_WF &
& , m_FFT_alloc_WF_work &
& , m_FFT_dealloc_WF_work &
& , m_FFT_WF, fft_box_size_CD, m_FFT_CD0 &
+ & , m_FFT_CD0_exx &
& , nfftp_exx_nonpara, fft_box_size_CD_exx
use m_Ionic_System, only : zeta1, qex, iatom, ntyp, natm, ityp, pos, iwei, napt
use m_PseudoPotential, only : qitg_l, iqitg, nqitg, m_PP_include_vanderbilt_pot &
@@ -50,14 +51,14 @@ module m_ES_ExactExchange
& , nlmta,lmta,lmtt,ltp,mtp,taup,nloc,m_PP_find_maximum_l &
& , m_PP_tell_lmtt_l_m_tau &
& , m_PP_set_index_arrays1,m_PP_set_index_arrays2 &
- & , radr,xh,rmax,nmesh,mmesh, qrspspw
+ & , radr,xh,rmax,nmesh,mmesh, qrspspw, nlmtt
use m_Files, only : nfout
use m_Timing, only : tstatc0_begin,tstatc0_end
use m_Control_Parameters, only : nspin,ipri,kimg,neg,printable,af,ekmode &
& , alpha_exx,omega_exx,sw_screened_exchange &
& , sw_singular_correction,reduction_factor_exx &
- & , way_ksample,m_CtrlP_cachesize,sw_rspace_hyb &
+ & , way_ksample,m_CtrlP_cachesize &
& , sw_precalculate,sw_rsb,potential_update
use m_Crystal_Structure, only : univol,altv,rltv,nopr,tau,op
! nopr : # of operations
@@ -70,6 +71,8 @@ module m_ES_ExactExchange
& , nrank_e,nrank_k,myrank_e,map_e,ista_e,iend_e,istep_e,idisp_e &
& , map_z,np_e,mpi_k_world,mpi_e_world,myrank_k,map_k,ista_k,iend_k &
& , ista_kg1_k, np_kg1_k, mp_kg1_k &
+! & , m_Parallel_mpi_nval,np_nval, mp_nval,ista_kngp_exx,iend_kngp_exx &
+ & , ista_kngp_exx,iend_kngp_exx &
#ifdef TRANSPOSE
& , ierr,mp_e,nis_e,nie_e,nel_e
#else
@@ -85,13 +88,17 @@ module m_ES_ExactExchange
, ista_fs, iend_fs, np_fs, nrank_g, nel_fft_x, nel_fft_y, nel_fft_z &
, xyz_fft_x, xyz_fft_y, xyz_fft_z, mp_g1k, kg1_ext, myrank_g, map_fft_x, map_fft_y &
& , fft_X_x_nel, fft_X_y_nel, fft_X_z_nel &
- , is_kngp, ie_kngp, mp_fft_x, nel_kngp, np_kngp
+ , is_kngp, ie_kngp, mp_fft_x, nel_kngp, np_kngp &
+ & , m_Parallel_init_mpi_nval &
+ & , ista_nval,iend_nval,np_nval,mp_nval,map_nval,map_z_nval,myrank_nval
use m_FFT, only : m_FFT_Inverse_3D, m_FFT_Direct_3D
! === FFT xzy ==================================================================
use m_FFT, only : m_FFT_Inverse_XYZ_3D, m_FFT_Direct_XYZ_3D
use m_Control_Parameters, only : sw_fft_xzy
! ==============================================================================
+ use m_Realspace, only : nmesh_rs_aug_max,nmesh_rs_aug,meshx_rs_aug,meshy_rs_aug,meshz_rs_aug,meshxyz_rs_aug &
+ & , qr_clm_ylm,dqr_clm_ylm,plmt1,plmt2,nlmtpair
implicit none
@@ -100,7 +107,7 @@ module m_ES_ExactExchange
integer :: nval_old
integer :: nfftwf
integer :: ntrs ! ntrs = 1, if TRS is used. Otherwise, ntrs=0
- integer, allocatable :: ngpt_exx(:,:,:) ! d(kgp,nopr,0:ntrs)
+ integer, allocatable :: ngpt_exx(:,:,:) ! d(kg,nopr,0:ntrs)
real(kind=DP), allocatable :: qitg_exx(:,:,:) ! d(kgp,nqitg,nqmk)
real(kind=DP), allocatable :: ylm_exx(:,:,:) ! d(kgp,maxylm,nqmk)
real(kind=DP), allocatable :: vc(:,:) ! d(kgp,nqmk)
@@ -195,6 +202,8 @@ module m_ES_ExactExchange
real(kind=DP), allocatable, dimension(:,:,:,:,:) :: fsrqm,fsiqm
real(kind=DP), allocatable, dimension(:,:,:,:) :: exx_potential
+ integer, save :: id_sname_cdfft = -1
+ integer, allocatable, dimension(:,:) :: ngabc_red
include 'mpif.h' ! MPI
contains
@@ -470,6 +479,7 @@ contains
end subroutine m_ES_EXX_move_k_into_fbz
subroutine m_ES_EXX_init0
+ integer :: ii,ie
if(potential_update>0) then
if(.not.allocated(exx_potential)) &
& allocate(exx_potential(maxval(np_g1k),np_e,ista_k:iend_k,kimg))
@@ -479,7 +489,7 @@ contains
subroutine m_ES_EXX_init
implicit none
- integer :: ik, ikbz, ii,ierr
+ integer :: ik, ikbz, ii,ierr,ie
real(kind=DP) :: dk(3)
integer,save :: id_sname = -1
call tstatc0_begin('m_ES_EXX_init ',id_sname,level=1)
@@ -636,10 +646,8 @@ contains
deallocate(occup_val)
deallocate(ngpt_exx)
if(modnrm == EXECUT) then
- if(sw_rspace_hyb==OFF) then
- deallocate(ylm_exx)
- deallocate(qitg_exx)
- endif
+ deallocate(ylm_exx)
+ deallocate(qitg_exx)
deallocate(fsr_exx)
deallocate(fsi_exx)
end if
@@ -658,11 +666,18 @@ contains
real(kind=DP), allocatable :: efsr_l(:,:) ! d(np_e,nlmta)
real(kind=DP), allocatable :: efsi_l(:,:) ! d(np_e,nlmta)
+ real(kind=DP), allocatable :: zaj_buf(:,:),zaj_buf2(:,:),wfvv(:,:,:,:)
+ integer :: ig,iadd
+ integer :: ip0,ip1
+
logical :: trans
+ integer, allocatable, dimension(:) :: ista
integer,save :: id_sname = -1
if(sw_update_wfv==OFF) return
+ allocate(ista(MPI_STATUS_SIZE))
+
trans = .true.
if(present(transform)) trans = transform
call tstatc0_begin('m_ES_EXX_gather_valence_states ',id_sname,level=1)
@@ -693,6 +708,7 @@ contains
nval = ibm
end if
+
if(allocated(wfv)) deallocate(wfv)
if(allocated(occup_val)) deallocate(occup_val)
allocate(wfv(maxval(np_g1k),nval,kv3,kimg))
@@ -729,41 +745,37 @@ contains
deallocate(efsi_l)
end if
- if(npes>1) then
- allocate(wfv_mpi(maxval(np_g1k),nval,kv3,kimg))
- allocate(occup_val_mpi(nval,kv3))
- call mpi_allreduce(wfv,wfv_mpi,maxval(np_g1k)*nval*kv3*kimg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
- wfv = wfv_mpi
- call mpi_allreduce(wfv,wfv_mpi,maxval(np_g1k)*nval*kv3*kimg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
- call mpi_allreduce(occup_val,occup_val_mpi,nval*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
- occup_val = occup_val_mpi
- call mpi_allreduce(occup_val,occup_val_mpi,nval*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
- wfv = wfv_mpi
- occup_val = occup_val_mpi
- deallocate(wfv_mpi)
- deallocate(occup_val_mpi)
- if(modnrm == EXECUT) then
- allocate(fsr_mpi(nval,nlmta,kv3))
- allocate(fsi_mpi(nval,nlmta,kv3))
- call mpi_allreduce(fsr_exx,fsr_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
- fsr_exx = fsr_mpi
- call mpi_allreduce(fsr_exx,fsr_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
- call mpi_allreduce(fsi_exx,fsi_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
- fsi_exx = fsi_mpi
- call mpi_allreduce(fsi_exx,fsi_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
- fsr_exx = fsr_mpi
- fsi_exx = fsi_mpi
- deallocate(fsr_mpi)
- deallocate(fsi_mpi)
- end if
+ allocate(occup_val_mpi(nval,kv3))
+ allocate(wfv_mpi(maxval(np_g1k),nval,kv3,kimg))
+ call mpi_allreduce(wfv,wfv_mpi,maxval(np_g1k)*nval*kv3*kimg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
+ wfv = wfv_mpi
+ call mpi_allreduce(wfv,wfv_mpi,maxval(np_g1k)*nval*kv3*kimg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
+ wfv = wfv_mpi
+ call mpi_allreduce(occup_val,occup_val_mpi,nval*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
+ occup_val = occup_val_mpi
+ call mpi_allreduce(occup_val,occup_val_mpi,nval*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
+ occup_val = occup_val_mpi
+ deallocate(wfv_mpi)
+ deallocate(occup_val_mpi)
+ if(modnrm == EXECUT) then
+ allocate(fsr_mpi(nval,nlmta,kv3))
+ allocate(fsi_mpi(nval,nlmta,kv3))
+ call mpi_allreduce(fsr_exx,fsr_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
+ fsr_exx = fsr_mpi
+ call mpi_allreduce(fsr_exx,fsr_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
+ call mpi_allreduce(fsi_exx,fsi_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_kg_world,ierr)
+ fsi_exx = fsi_mpi
+ call mpi_allreduce(fsi_exx,fsi_mpi,nval*nlmta*kv3,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
+ fsr_exx = fsr_mpi
+ fsi_exx = fsi_mpi
+ deallocate(fsr_mpi)
+ deallocate(fsi_mpi)
end if
-
-
+ deallocate(ista)
call tstatc0_end(id_sname)
end subroutine m_ES_EXX_gather_valence_states
-
subroutine m_ES_EXX_kernel(nfout)
implicit none
integer, intent(in) :: nfout
@@ -771,12 +783,14 @@ contains
integer :: ik,ikbz,ig,kgs
real(kind=DP) :: fac, wi, kg(3), vzero, g2
real(kind=DP), dimension(6) :: ttr
-
+ integer :: igs,ige
integer,save :: id_sname = -1
call tstatc0_begin('m_ES_EXX_kernel ',id_sname,level=1)
if(.not.allocated(vc)) allocate(vc(ista_kngp:iend_kngp,nqmk))
+ vc = 0.d0
+
call getttr(rltv,ttr)
fac = PAI4/univol
@@ -795,7 +809,9 @@ contains
kgs=2
if(ista_kngp == 1) vc(1,ik) = vzero
end if
- do ig=max(kgs,ista_kngp),iend_kngp
+ igs = max(kgs,ista_kngp);ige=iend_kngp
+ if(ige.gt.nmax_G_hyb) ige=nmax_G_hyb
+ do ig=igs,ige
kg(1:3) = qmk(ik,1:3) + ngabc_kngp_l(ig,1:3)
g2 = ttr(1)*kg(1)*kg(1) &
& + ttr(2)*kg(2)*kg(2) &
@@ -814,7 +830,9 @@ contains
kgs=2
if(ista_kngp == 1) vc(1,ik) = vzero
end if
- do ig=max(kgs,ista_kngp),iend_kngp
+ igs = max(kgs,ista_kngp);ige=iend_kngp
+ if(ige.gt.nmax_G_hyb) ige=nmax_G_hyb
+ do ig=igs,ige
kg(1:3) = qmk(ik,1:3) + ngabc_kngp_l(ig,1:3)
g2 = ttr(1)*kg(1)*kg(1) &
& + ttr(2)*kg(2)*kg(2) &
@@ -872,7 +890,7 @@ contains
real(kind=DP) :: chig
real(kind=DP), intent(in) :: gam
- integer :: ig, ikbz, kgs
+ integer :: ig, ikbz, kgs, igs, ige
real(kind=DP) :: sumg, sumgk
sumg = 0.d0
@@ -967,6 +985,8 @@ contains
real(kind=DP) :: ene
integer :: ig,iadd
logical :: store_p
+ real(kind=DP), allocatable, dimension(:) :: zajbuf_r,zajbuf_i
+ integer :: kgw,kgv
integer :: id_sname=-1
call tstatc0_begin('m_ES_EXX_potential ',id_sname,level=1)
store_p = .true.
@@ -979,7 +999,7 @@ contains
iup = 2
if(present(iupdate)) iup = iupdate
if(iup.lt.potential_update)then
- vxw(:,1:kimg) = exx_potential(:,ib,ik,:)
+ vxw(1:np_g1k(ik),1:kimg) = exx_potential(1:np_g1k(ik),ib,ik,1:kimg)
if(present(exx))then
exx=0.d0
if(kimg==1)then
@@ -1016,21 +1036,20 @@ contains
allocate(efsr_l(nlmta));efsr_l=0.d0
allocate(efsi_l(nlmta));efsi_l=0.d0
if(modnrm == EXECUT) call get_expkt_fs_b(ik,ib,fsr,fsi,efsr_l,efsi_l)
+ allocate(zajbuf_r(maxval(np_g1k)));zajbuf_r(1:np_g1k(ik))=zaj_l(1:np_g1k(ik),ib,ik,1)
+ allocate(zajbuf_i(maxval(np_g1k)));zajbuf_i(1:np_g1k(ik))=zaj_l(1:np_g1k(ik),ib,ik,kimg)
+ kgw = maxval(np_g1k);kgv=maxval(np_g1k)
+
if(present(exx))then
- if(kimg==1)then
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,1), efsr_l, efsr_l, vxw, ene, eo )
- else
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,2), efsr_l, efsi_l, vxw, ene, eo )
- endif
+ call apply_Vx_to_WF( ispin, ib, ik, kgw, kgv, zajbuf_r, zajbuf_i, efsr_l, efsi_l, vxw, ene, eo )
else
- if(kimg==1)then
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,1), efsr_l, efsr_l, vxw)
- else
- call apply_Vx_to_WF( ispin, ib, ik, zaj_l(1,ib,ik,1), zaj_l(1,ib,ik,2), efsr_l, efsi_l, vxw)
- endif
+ call apply_Vx_to_WF( ispin, ib, ik, kgw, kgv, zajbuf_r, zajbuf_i, efsr_l, efsi_l, vxw )
endif
+
deallocate(efsr_l)
deallocate(efsi_l)
+ deallocate(zajbuf_r)
+ deallocate(zajbuf_i)
if(present(exx)) exx = ene
if(.not.eo.and.potential_update>0.and.store_p) &
& exx_potential(1:np_g1k(ik),ib,ik,1:kimg) = vxw(1:np_g1k(ik),1:kimg)
@@ -1116,6 +1135,7 @@ contains
real(kind=DP), allocatable, dimension(:,:,:,:) :: vxdi_t
integer,save :: id_sname = -1
+
call tstatc0_begin('m_ES_EXX_Diagonal_part ',id_sname,level=1)
#ifdef FFT_3D_DIVISION
@@ -1281,12 +1301,12 @@ contains
end if
end subroutine m_ES_Vexx_add_vexx
- subroutine apply_Vx_to_WF(ispin,ib,ik,wfr,wfi,bdwr,bdwi,vxw,eexx,eonly,force_l,dbdwr,dbdwi)
+ subroutine apply_Vx_to_WF(ispin,ib,ik,kgw,kgv,wfr,wfi,bdwr,bdwi,vxw,eexx,eonly,force_l,dbdwr,dbdwi)
implicit none
- integer, intent(in) :: ispin, ib,ik
- real(kind=DP), intent(in), dimension(maxval(np_g1k)) :: wfr, wfi
+ integer, intent(in) :: ispin, ib,ik,kgw,kgv
+ real(kind=DP), intent(in), dimension(kgw) :: wfr, wfi
real(kind=DP), intent(in), dimension(nlmta) :: bdwr, bdwi
- real(kind=DP), intent(out), optional, dimension(maxval(np_g1k),kimg) :: vxw
+ real(kind=DP), intent(out), optional, dimension(kgv,kimg) :: vxw
real(kind=DP), intent(out), optional :: eexx
logical, intent(in), optional :: eonly
@@ -2176,6 +2196,70 @@ contains
end if
end subroutine map_RHOG_on_FFT_box
+ subroutine map_RHOG_on_FFT_box_hard(rhor,rhoi,afft)
+ implicit none
+ real(kind=DP), intent(in), dimension(nfftp_exx_nonpara/2) :: rhor, rhoi
+ real(kind=DP), intent(out), dimension(nfftp_exx_nonpara) :: afft
+
+ integer :: i,i1,i2
+
+! afft(:) = 0.d0
+ do i = 1, nfftp_exx_nonpara/2
+! i1 = (igfp_l(i)-1)*kimg+1
+ i1 = (i-1)*kimg+1
+ afft(i1) = rhor(i)
+ afft(i1+1) = rhoi(i)
+ end do
+ end subroutine map_RHOG_on_FFT_box_hard
+
+ subroutine map_RHOG_on_FFT_box_hard_inv(rhor,rhoi,afft)
+ implicit none
+ real(kind=DP), intent(in), dimension(nfftp_exx_nonpara/2) :: rhor, rhoi
+ real(kind=DP), intent(out), dimension(nfftp_exx_nonpara) :: afft
+ integer :: i,i1,i2
+
+ afft(:) = 0.d0
+
+ do i = 1, kgp_exx
+ i1 = (igfp_exx(i)-1)*kimg+1
+ afft(i1) = rhor(i)
+ afft(i1+1) = rhoi(i)
+ end do
+ end subroutine map_RHOG_on_FFT_box_hard_inv
+
+ subroutine map_FFT_box_on_RHOG_hard(rhor,rhoi,afft)
+ implicit none
+ real(kind=DP), intent(in), dimension(nfftp_exx_nonpara) :: afft
+ real(kind=DP), intent(out), dimension(nfftp_exx_nonpara/2) :: rhor, rhoi
+ real(kind=DP) :: rinplw
+ integer :: i,i1,i2
+
+ rinplw = 1.d0/product(fft_box_size_CD_exx(1:3,1))
+ rhor(:)=0.d0
+ rhoi(:)=0.d0
+ do i = 1, kgp_exx
+ i1 = (igfp_exx(i)-1)*kimg+1
+ rhor(i) = afft(i1)*rinplw
+ rhoi(i) = afft(i1+1)*rinplw
+ end do
+ end subroutine map_FFT_box_on_RHOG_hard
+
+ subroutine map_FFT_box_on_RHOG_hard_inv(rhor,rhoi,afft)
+ implicit none
+ real(kind=DP), intent(in), dimension(nfftp_exx_nonpara) :: afft
+ real(kind=DP), intent(out), dimension(nfftp_exx_nonpara/2) :: rhor, rhoi
+ real(kind=DP) :: rinplw
+ integer :: i,i1,i2
+
+ rinplw = 1.d0/product(fft_box_size_CD_exx(1:3,1))
+! rhor(:)=0.d0
+! rhoi(:)=0.d0
+ do i = 1, nfftp_exx_nonpara/2
+ i1 = (i-1)*kimg+1
+ rhor(i) = afft(i1)*rinplw
+ rhoi(i) = afft(i1+1)*rinplw
+ end do
+ end subroutine map_FFT_box_on_RHOG_hard_inv
subroutine m_ES_EXX_ngpt()
implicit none
@@ -2183,72 +2267,131 @@ contains
integer :: i,j,iopr,ii
integer :: ia,ib,ic
integer :: namin,namax,nbmin,nbmax,ncmin,ncmax
- integer, allocatable, dimension(:,:) :: ngpt_t
integer, allocatable, dimension(:,:,:) :: g_list
+ integer, allocatable, dimension(:) :: ngpt_exx_tmp, ngpt_exx0_tmp
integer,save :: id_sname = -1
call tstatc0_begin('m_ES_EXX_ngpt ',id_sname,level=1)
- allocate(ngpt_exx(kgp,nopr,0:ntrs)); ngpt_exx = 0
+!!$ allocate(ngpt_exx(kgp,nopr,0:ntrs)); ngpt_exx = 0
+ allocate(ngpt_exx(kg,nopr,0:ntrs)); ngpt_exx = 0
+
+ !! Time reversal symmetry
+
+ if(ntrs>0) then
+
+ namax = n_rGpv(1); nbmax = n_rGpv(2); ncmax = n_rGpv(3)
+ namin = -namax ; nbmin = -nbmax ; ncmin = -ncmax
+ allocate(g_list(namin:namax,nbmin:nbmax,ncmin:ncmax)); g_list = 0
+
+ do i = ista_kngp, iend_kngp
+ ia = ngabc_kngp_l(i,1)
+ ib = ngabc_kngp_l(i,2)
+ ic = ngabc_kngp_l(i,3)
+ g_list(ia,ib,ic) = i
+ end do
+ call mpi_allreduce(MPI_IN_PLACE, g_list,(namax-namin+1)*(nbmax-nbmin+1)*(ncmax-ncmin+1), &
+ & mpi_integer, mpi_sum,mpi_ke_world,ierr)
+
+ end if
if(npes > 1) then
- allocate(ngpt_t(kgp,nopr)); ngpt_t = 0
+ allocate(ngpt_exx0_tmp(kgp))
do iopr=1,nopr
+ ngpt_exx0_tmp = 0
do i = ista_kngp, iend_kngp
- ngpt_t(i,iopr) = ngpt_l(i,iopr)
+ ngpt_exx0_tmp(i) = ngpt_l(i,iopr)
end do
+ call mpi_allreduce(MPI_IN_PLACE,ngpt_exx0_tmp,kgp,mpi_integer,mpi_sum,mpi_ke_world,ierr)
+ ngpt_exx(1:kg,iopr,0) = ngpt_exx0_tmp(1:kg)
+
+ if(ntrs>0) then
+ allocate(ngpt_exx_tmp(kg))
+ ngpt_exx_tmp = 0
+ do i=1,kg
+ ii = ngpt_exx0_tmp(i)
+ if(ista_kngp<=ii .and. ii<=iend_kngp) then
+ ia = -ngabc_kngp_l(ii,1)
+ ib = -ngabc_kngp_l(ii,2)
+ ic = -ngabc_kngp_l(ii,3)
+ ngpt_exx_tmp(i) = g_list(ia,ib,ic)
+ end if
+ end do
+ call mpi_allreduce(MPI_IN_PLACE, ngpt_exx_tmp, kg, mpi_integer, mpi_sum,mpi_ke_world,ierr)
+ ngpt_exx(1:kg,iopr,1) = ngpt_exx_tmp(1:kg)
+ end if
end do
- call mpi_allreduce(ngpt_t,ngpt_exx,kgp*nopr,mpi_integer,mpi_sum,mpi_ke_world,ierr)
- deallocate(ngpt_t)
+ deallocate(ngpt_exx0_tmp)
else
do iopr=1,nopr
- do i = ista_kngp, iend_kngp
- ngpt_exx(i,iopr,0) = ngpt_l(i,iopr)
- end do
+ if(ntrs==0) then
+ do i = 1, kg
+ ngpt_exx(i,iopr,0) = ngpt_l(i,iopr)
+ end do
+ else
+ do i = 1, kg
+ ngpt_exx(i,iopr,0) = ngpt_l(i,iopr)
+ ii = ngpt_l(i,iopr)
+ ia = -ngabc_kngp_l(ii,1)
+ ib = -ngabc_kngp_l(ii,2)
+ ic = -ngabc_kngp_l(ii,3)
+ ngpt_exx(i,iopr,1) = g_list(ia,ib,ic)
+ end do
+ end if
end do
end if
- !! Time reversal symmetry
-
- if(ntrs>0) then
-
- namin = 0; namax = 0
- nbmin = 0; nbmax = 0
- ncmin = 0; ncmax = 0
- do i=1,kgp
- ia = ngabc(i,1)
- ib = ngabc(i,2)
- ic = ngabc(i,3)
- namin = min(ia,namin)
- namax = max(ia,namax)
- nbmin = min(ib,nbmin)
- nbmax = max(ib,nbmax)
- ncmin = min(ic,ncmin)
- ncmax = max(ic,ncmax)
- end do
- allocate(g_list(namin:namax,nbmin:nbmax,ncmin:ncmax))
- do i=1,kgp
- ia = ngabc(i,1)
- ib = ngabc(i,2)
- ic = ngabc(i,3)
- g_list(ia,ib,ic) = i
- end do
- do iopr=1,nopr
- do i=1,kgp
- ii = ngpt_exx(i,iopr,0)
- ia = -ngabc(ii,1)
- ib = -ngabc(ii,2)
- ic = -ngabc(ii,3)
- ngpt_exx(i,iopr,1) = g_list(ia,ib,ic)
+!!$ allocate(ngpt_exx_tmp(kgp))
+!!$ do iopr=1,nopr
+!!$ ngpt_exx_tmp = 0
+!!$ do i=1,kgp
+!!$ ii = ngpt_exx(i,iopr,0)
+!!$ if(ista_kngp<=ii .and. ii<=iend_kngp) then
+!!$ ia = -ngabc_kngp_l(ii,1)
+!!$ ib = -ngabc_kngp_l(ii,2)
+!!$ ic = -ngabc_kngp_l(ii,3)
+!!$ ngpt_exx_tmp(i) = g_list(ia,ib,ic)
+!!$ end if
+!!$ end do
+!!$ call mpi_allreduce(MPI_IN_PLACE, ngpt_exx_tmp, kgp, mpi_integer, mpi_sum,mpi_ke_world,ierr)
+!!$ ngpt_exx(:,iopr,1) = ngpt_exx_tmp(:)
+!!$ end do
+!!$ deallocate(ngpt_exx_tmp)
+!!$
+!!$ ia = -ngabc(ii,1)
+!!$ ib = -ngabc(ii,2)
+!!$ ic = -ngabc(ii,3)
+!!$ ngpt_exx(i,iopr,1) = g_list(ia,ib,ic)
+!!$ end do
+!!$ end do
+ if(ntrs>0) deallocate(g_list)
+
+ j = 0
+ do ii = 0, ntrs
+ do iopr = 1, nopr
+ do i = 1, kg
+ if(ngpt_exx(i,iopr,ii) <= 0) j = j + 1
+ end do
end do
end do
- deallocate(g_list)
- end if
+ if(j >= 1) then
+ write(nfout,'(" !! check of ngpt_exx")')
+ do ii = 0, ntrs
+ do iopr = 1, nopr
+ do i = 1, kg
+ if(ngpt_exx(i,iopr,ii) <= 0) write(nfout,'(" ngpt_exx(",i8,",",i8,",",i8,") = ",i20)') &
+ & i,iopr,ii, ngpt_exx(i,iopr,ii)
+ end do
+ end do
+ end do
+ write(nfout,'(" !! total number of negative values for ngpt_exx = ",i8)') j
+ write(nfout,'(" !! out of check of ngpt_exx")')
+ end if
! === Make FFT box index arrays. ===============================================
- call m_Parallel_wf_onto_fft_exx_3D(nfout,fft_box_size_WF,igf,nbase,nbase_gamma, &
+ call Parallelize_wf_onto_fft_exx_3D(nfout,fft_box_size_WF,igf,nbase,nbase_gamma, &
& k_symmetry,GAMMA,kg,kg_gamma,kv3)
- call m_Parallel_fft_onto_wf_rhog_3D(nfout,igf,kg,nfft)
- call m_Parallel_wf_onto_fft_rhog_3D(nfout,fft_box_size_WF,igf,kg)
+ call Parallelize_fft_onto_wf_rhog_3D(nfout,igf,kg,nfft)
+ call Parallelize_wf_onto_fft_rhog_3D(nfout,fft_box_size_WF,igf,kg)
! ==============================================================================
call tstatc0_end(id_sname)
!!!stop 'Check: G_list'
@@ -2281,10 +2424,14 @@ contains
occup_l(1:np_e,ista_k:iend_k) = 0.d0
do ik=1,kv3,af+1
if(map_k(ik) /= myrank_k) cycle ! MPI
- do ib=ista_e,iend_e,istep_e
- !!if(ib>nval) cycle
+ do ib = 1, neg
if(neordr(ib,ik)>nval) cycle
- occup_l(map_z(ib),ik) = kv3*qwgt(ik)
+ if(map_e(ib) == myrank_e) then
+!!$ do ib=ista_e,iend_e,istep_e
+!!$ !!if(ib>nval) cycle
+!!$ if(neordr(ib,ik)>nval) cycle
+ occup_l(map_z(ib),ik) = kv3*qwgt(ik)
+ end if
end do
end do
call tstatc0_end(id_sname)
@@ -2404,6 +2551,7 @@ contains
implicit none
integer :: i,n,ik,ig
+ real(kind=DP), allocatable, dimension(:) :: ylm_t ! d(kngp,n)
real(kind=DP), allocatable, dimension(:,:) :: gqmk ! d(ista_kngp:iend_kngp,3)
real(kind=DP), allocatable, dimension(:) :: gqmkr ! d(ista_kngp:iend_kngp)
@@ -2416,7 +2564,9 @@ contains
call m_PP_find_maximum_l(n) ! n-1: maximum l
n = (n-1) + (n-1) + 1
n = n*n
- if(.not.allocated(ylm_exx)) allocate(ylm_exx(ista_kngp:iend_kngp,n,nqmk))
+ if(.not.allocated(ylm_exx)) then
+ allocate(ylm_exx(ista_kngp:iend_kngp,n,nqmk))
+ endif
allocate(gqmk(ista_kngp:iend_kngp,3))
allocate(gqmkr(ista_kngp:iend_kngp))
@@ -2432,9 +2582,10 @@ contains
gqmk(ig,1:3) = kg(1:3)
gqmkr(ig) = sqrt(g2)
end do
- do i=1,n
- call m_pwBS_sphrp_exx(i,rltv,ista_kngp,iend_kngp,gqmk,gqmkr,ylm_exx(ista_kngp,i,ik))
- end do
+ do i=1,n
+ call m_pwBS_sphrp_exx(i,rltv,ista_kngp,iend_kngp,gqmk,gqmkr,ylm_exx(ista_kngp,i,ik))
+ end do
+
end do
!!stop 'm_ES_EXX_ylm'
deallocate(gqmk)
@@ -2445,16 +2596,19 @@ contains
subroutine check_qitg()
implicit none
- integer :: iq
+ integer :: iq, ips , ipe
+
+ ips = 1
+ ipe = nmax_G_hyb
+ ips = ista_kngp
+ ipe = iend_kngp
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"qitg_l=",f20.5,1x,"qitg_exx=",f20.5,1x)') &
- & iq, qitg_l(ista_kngp,iq), qitg_exx(ista_kngp,iq,1)/univol
+ write(nfout,'("iq=",i5,1x,"qitg_l=",f20.5,1x,"qitg_exx=",f20.5,1x)') iq, qitg_l(ips,iq), qitg_exx(ips,iq,1)/univol
end do
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"diff=",f20.5)') &
- & iq, sum(qitg_l(ista_kngp:iend_kngp,iq)-qitg_exx(ista_kngp:iend_kngp,iq,1)/univol)
+ write(nfout,'("iq=",i5,1x,"diff=",f20.5)') iq, sum(qitg_l(ips:ipe,iq)-qitg_exx(ips:ipe,iq,1)/univol)
end do
stop 'check_qitg'
@@ -2462,19 +2616,22 @@ contains
subroutine check_qitg_qmk()
implicit none
- integer :: iq, ik
+ integer :: iq, ik, ips, ipe
+
+ ips = 1
+ ipe = nmax_G_hyb
+ ips = ista_kngp
+ ipe = iend_kngp
do ik=1,nqmk
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"qitg_exx=",f20.5,1x)') &
- & iq, qitg_exx(ista_kngp,iq,ik)/univol
+ write(nfout,'("iq=",i5,1x,"qitg_exx=",f20.5,1x)') iq, qitg_exx(ips,iq,ik)/univol
end do
end do
do ik=1,nqmk
do iq=1,nqitg
- write(nfout,'("iq=",i5,1x,"sum=",f20.5)') &
- & iq, sum(qitg_exx(ista_kngp:iend_kngp,iq,ik)/univol)
+ write(nfout,'("iq=",i5,1x,"sum=",f20.5)') iq, sum(qitg_exx(ips:ipe,iq,ik)/univol)
end do
end do
@@ -2483,23 +2640,26 @@ contains
subroutine check_ylm_exx()
implicit none
- integer :: i, n, ik
+ integer :: i, n, ik, ips, ipe
call m_PP_find_maximum_l(n) ! n-1: maximum l
n = (n-1) + (n-1) + 1
n = n*n
+ ips = 1
+ ipe = nmax_G_hyb
+ ips = ista_kngp
+ ipe = iend_kngp
+
do ik=1,nqmk
do i=1,n
- write(nfout,'("i=",i5,1x,"ylm_exx=",f20.5,1x)') &
- & i, ylm_exx(ista_kngp,i,ik)
+ write(nfout,'("i=",i5,1x,"ylm_exx=",f20.5,1x)') i, ylm_exx(ips,i,ik)
end do
end do
do ik=1,nqmk
do i=1,n
- write(nfout,'("i=",i5,1x,"sum=",f20.5)') &
- & i, sum(qitg_exx(ista_kngp:iend_kngp,i,ik))
+ write(nfout,'("i=",i5,1x,"sum=",f20.5)') i, sum(qitg_exx(ips:ipe,i,ik))
end do
end do
@@ -2566,7 +2726,7 @@ contains
real(kind=DP), allocatable :: qitg_red(:,:),ylm_red(:,:)
real(kind=DP), allocatable :: rhogr_red(:),rhogi_red(:)
real(kind=DP) :: yr,yi
- integer :: ibl1,ibl2,iq,inn,ip,m
+ integer :: ibl1,ibl2,iq,inn,ip,m, ips, ipe
integer,save :: id_sname = -1
@@ -2584,13 +2744,15 @@ contains
allocate(rhogr_red(ibsize))
allocate(rhogi_red(ibsize))
! --
- do ibl1=ista_kngp,iend_kngp,ibsize
- rhogr_red=0.d0; rhogi_red=0.d0
+ ips = 1
+ ipe = nmax_G_hyb
+ ips = ista_kngp
+ ipe = iend_kngp
- ibl2=ibl1+ibsize-1
-
- if(ibl2.gt.iend_kngp) ibl2=iend_kngp
+ do ibl1=ips, ipe, ibsize
+ rhogr_red=0.d0; rhogi_red=0.d0
+ ibl2=min(ipe,ibl1+ibsize-1)
do iq=1,nqitg
do i=1,ibl2-ibl1+1
qitg_red(i,iq) = qitg_exx(i+ibl1-1,iq,iqmk)
@@ -2854,6 +3016,139 @@ contains
call tstatc0_end(id_sname)
end subroutine add_RHOG_hard_part_
#endif
+ subroutine add_RHOG_hard_part_rs2(iqmk,rhor,rhoi,qmfnr,qmfni,fmr,fmi)
+ integer, intent(in) :: iqmk
+ real(kind=DP), intent(out) :: rhor(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(out) :: rhoi(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(in) :: qmfnr(nmesh_rs_aug_max,nlmta)
+ real(kind=DP), intent(in) :: qmfni(nmesh_rs_aug_max,nlmta)
+ real(kind=DP), intent(in) :: fmr(nlmta)
+ real(kind=DP), intent(in) :: fmi(nlmta)
+ real(kind=DP), dimension(:), allocatable :: cosqmkr,sinqmkr
+ real(kind=DP), allocatable, dimension(:) :: rtmp,itmp
+ real(kind=DP) :: fr,fi,co,si,qmr,qmi,rr,ii
+ integer :: ia,it,lmt1,ilmta1,ind,imesh,nma
+ integer,save :: id_sname = -1
+ call tstatc0_begin('add_RHOG_hard_part_rs2 ',id_sname,1)
+ allocate(cosqmkr(nmesh_rs_aug_max));cosqmkr=0.d0
+ allocate(sinqmkr(nmesh_rs_aug_max));sinqmkr=0.d0
+ allocate(rtmp(nmesh_rs_aug_max));rtmp=0.d0
+ allocate(itmp(nmesh_rs_aug_max));itmp=0.d0
+ rhor(:) = 0.d0;rhoi(:) = 0.d0
+ do ia=1,natm
+ it = ityp(ia)
+ if( m_PP_include_vanderbilt_pot(it) == SKIP) cycle
+ call qmk_dot_r(iqmk,ia,cosqmkr,sinqmkr)
+ nma = nmesh_rs_aug(ia)
+ rtmp=0.d0;itmp=0.d0
+ do lmt1=1,ilmt(it)
+ ilmta1 = lmta(lmt1,ia)
+ fr = fmr(ilmta1)
+ fi = -fmi(ilmta1) ! c.c. of fsr
+ do imesh=1,nma
+ co = cosqmkr(imesh)
+ si = -sinqmkr(imesh) ! c.c. of exp(i(G+q-k))
+ qmr = qmfnr(imesh,ilmta1)
+ qmi = qmfni(imesh,ilmta1)
+ rr = co*qmr-si*qmi
+ ii = co*qmi+si*qmr
+ rtmp(imesh) = rtmp(imesh) + rr*fr-ii*fi
+ itmp(imesh) = itmp(imesh) + ii*fr+rr*fi
+ enddo
+ enddo
+ do imesh=1,nma
+ ind = meshxyz_rs_aug(imesh,ia)
+ rhor(ind) = rhor(ind) + rtmp(imesh)
+ rhoi(ind) = rhoi(ind) + itmp(imesh)
+ enddo
+ enddo
+ deallocate(cosqmkr)
+ deallocate(sinqmkr)
+ deallocate(rtmp)
+ deallocate(itmp)
+ call tstatc0_end(id_sname)
+ end subroutine add_RHOG_hard_part_rs2
+
+ subroutine add_RHOG_hard_part_rs(iqmk,rhor,rhoi,fnr,fni,fmr,fmi)
+ implicit none
+ integer, intent(in) :: iqmk
+ real(kind=DP), intent(out) :: rhor(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(out) :: rhoi(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(in) :: fnr(nlmta)
+ real(kind=DP), intent(in) :: fni(nlmta)
+ real(kind=DP), intent(in) :: fmr(nlmta)
+ real(kind=DP), intent(in) :: fmi(nlmta)
+ integer :: n,it,ia,imesh,lmt1,lmt2,il1,il2,tau1,tau2,ilmta1,ilmta2,lmtp
+ integer :: nma
+ real(kind=DP), dimension(:), allocatable :: cosqmkr,sinqmkr
+ real(kind=DP) :: rr,ii,si,co,qm,rr0,ii0
+ integer :: ind
+ real(kind=DP), allocatable, dimension(:) :: rtmp,itmp
+ real(kind=DP) :: fac
+ integer,save :: id_sname = -1
+ call tstatc0_begin('add_RHOG_hard_part_rs ',id_sname,1)
+ allocate(cosqmkr(nmesh_rs_aug_max));cosqmkr=0.d0
+ allocate(sinqmkr(nmesh_rs_aug_max));sinqmkr=0.d0
+ allocate(rtmp(nmesh_rs_aug_max));rtmp=0.d0
+ allocate(itmp(nmesh_rs_aug_max));itmp=0.d0
+ rhor(:) = 0.d0;rhoi(:) = 0.d0
+ do ia=1,natm
+ it = ityp(ia)
+ if( m_PP_include_vanderbilt_pot(it) == SKIP) cycle
+ call qmk_dot_r(iqmk,ia,cosqmkr,sinqmkr)
+ nma = nmesh_rs_aug(ia)
+ rtmp=0.d0;itmp=0.d0
+ do lmtp = 1,nlmtpair(ia)
+ lmt1 = plmt1(lmtp,ia)
+ lmt2 = plmt2(lmtp,ia)
+ ilmta1 = lmta(lmt1,ia)
+ ilmta2 = lmta(lmt2,ia)
+ rr = fnr(ilmta1)*fmr(ilmta2) + fni(ilmta1)*fmi(ilmta2)
+ ii = fnr(ilmta1)*fmi(ilmta2) - fni(ilmta1)*fmr(ilmta2)
+ if(lmt1.ne.lmt2)then
+ rr = rr+fnr(ilmta2)*fmr(ilmta1) + fni(ilmta2)*fmi(ilmta1)
+ ii = ii+fnr(ilmta2)*fmi(ilmta1) - fni(ilmta2)*fmr(ilmta1)
+ endif
+ do imesh=1,nma
+ co = cosqmkr(imesh)
+ si = sinqmkr(imesh)
+ qm = qr_clm_ylm(imesh,ia,lmtp)
+ rtmp(imesh) = rtmp(imesh) + qm*(rr*co+ii*si)
+ itmp(imesh) = itmp(imesh) + qm*(ii*co-rr*si)
+ enddo
+ enddo
+ do imesh=1,nma
+ ind = meshxyz_rs_aug(imesh,ia)
+ rhor(ind) = rhor(ind) + rtmp(imesh)
+ rhoi(ind) = rhoi(ind) + itmp(imesh)
+ enddo
+ enddo
+ deallocate(cosqmkr)
+ deallocate(sinqmkr)
+ deallocate(rtmp)
+ deallocate(itmp)
+ call tstatc0_end(id_sname)
+ end subroutine add_RHOG_hard_part_rs
+
+ subroutine qmk_dot_r(iqmk,ia,zc_ar,zs_ar)
+ integer, intent(in) :: iqmk,ia
+ real(kind=DP),dimension(nmesh_rs_aug_max),intent(out) :: zc_ar,zs_ar
+ integer :: i
+ real(kind=DP) :: inl,inm,inn
+ real(kind=DP) :: rx,ry,rz,kdr
+ integer :: id_sname = -1
+ inl = 1.d0/dble(fft_box_size_CD_exx(1,1))
+ inm = 1.d0/dble(fft_box_size_CD_exx(2,1))
+ inn = 1.d0/dble(fft_box_size_CD_exx(3,1))
+ do i=1,nmesh_rs_aug(ia)
+ rx = dble(meshx_rs_aug(i,ia))*inl
+ ry = dble(meshy_rs_aug(i,ia))*inm
+ rz = dble(meshz_rs_aug(i,ia))*inn
+ kdr = (rx*qmk(iqmk,1)+ry*qmk(iqmk,2)+rz*qmk(iqmk,3))*PAI2
+ zc_ar(i) = dcos(kdr)
+ zs_ar(i) = dsin(kdr)
+ enddo
+ end subroutine qmk_dot_r
! ================================== KT_Test ========================= 12.5Exp
subroutine integrate_QijVnm(iqmk,potr,poti,fmr,fmi,qvr,qvi,dfmr,dfmi,dqvr,dqvi,gqvr,gqvi)
@@ -2880,7 +3175,7 @@ contains
real(kind=DP), allocatable :: zsr(:), zsi(:)
real(kind=DP), allocatable :: qitg_red(:,:),ylm_red(:,:)
- integer :: ibl1,ibl2,iq,inn,ip,m
+ integer :: ibl1,ibl2,iq,inn,ip,m, ips, ipe
logical :: force_mode = .false.
real(kind=DP), allocatable :: gvec(:,:)
real(kind=DP) :: er(3), ei(3)
@@ -2901,9 +3196,14 @@ contains
allocate(qitg_red(ibsize,nqitg))
allocate(ylm_red(ibsize,n*n))
if(force_mode) allocate(gvec(ibsize,3))
- do ibl1=ista_kngp,iend_kngp,ibsize
- ibl2=ibl1+ibsize-1
- if(ibl2.gt.iend_kngp) ibl2=iend_kngp
+
+ ips = 1
+ ipe = nmax_G_hyb
+ ips = ista_kngp
+ ipe = iend_kngp
+
+ do ibl1=ips, ipe, ibsize
+ ibl2=min(ipe,ibl1+ibsize-1)
do iq=1,nqitg
do i=1,ibl2-ibl1+1
qitg_red(i,iq) = qitg_exx(i+ibl1-1,iq,iqmk)
@@ -3312,6 +3612,181 @@ contains
#endif
! ========================================================================= 125.Exp
+ subroutine integrate_QijVnm_rs2(iqmk,potr,poti,fmrq,fmiq,qvr,qvi)
+ integer, intent(in) :: iqmk
+ real(kind=DP), intent(in) :: potr(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(in) :: poti(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(in) :: fmrq(nmesh_rs_aug_max,nlmta)
+ real(kind=DP), intent(in) :: fmiq(nmesh_rs_aug_max,nlmta)
+ real(kind=DP), intent(out) :: qvr(nlmta)
+ real(kind=DP), intent(out) :: qvi(nlmta)
+ real(kind=DP), dimension(:), allocatable :: cosqmkr,sinqmkr
+ real(kind=DP), allocatable, dimension(:) :: rra,iia
+ integer :: ia,it,lmt1,ilmta1
+ integer :: imesh,nma,ind
+ real(kind=DP) :: co,si
+ real(kind=DP) :: qr,qi,qmr,qmi,rr,ii
+ integer :: id_sname=-1
+ call tstatc0_begin('integrate_QijVnm_rs2 ',id_sname,1)
+ allocate(cosqmkr(nmesh_rs_aug_max));cosqmkr=0.d0
+ allocate(sinqmkr(nmesh_rs_aug_max));sinqmkr=0.d0
+ allocate(rra(nmesh_rs_aug_max));rra=0.d0
+ allocate(iia(nmesh_rs_aug_max));iia=0.d0
+ qvr(:) = 0.d0
+ qvi(:) = 0.d0
+ do ia=1,natm
+ it = ityp(ia)
+ if( m_PP_include_vanderbilt_pot(it) == SKIP) cycle
+ call qmk_dot_r(iqmk,ia,cosqmkr,sinqmkr)
+ nma = nmesh_rs_aug(ia)
+ do imesh=1,nma
+ ind = meshxyz_rs_aug(imesh,ia)
+ co = cosqmkr(imesh)
+ si = -sinqmkr(imesh)
+ rra(imesh) = potr(ind)*co+poti(ind)*si
+ iia(imesh) = -poti(ind)*co+potr(ind)*si
+ enddo
+ do lmt1=1,ilmt(it)
+ ilmta1 = lmta(lmt1,ia)
+ qr=0.d0;qi=0.d0
+ do imesh=1,nma
+ qmr = fmrq(imesh,ilmta1)
+ qmi = fmiq(imesh,ilmta1)
+ rr = rra(imesh)
+ ii = iia(imesh)
+ qr = qr+qmr*rr-qmi*ii
+ qi = qi+qmr*ii+qmi*rr
+ enddo
+ qvr(ilmta1) = qr
+ qvi(ilmta1) = qi
+ enddo
+ enddo
+ deallocate(cosqmkr)
+ deallocate(sinqmkr)
+ deallocate(rra,iia)
+ call tstatc0_end(id_sname)
+ end subroutine integrate_QijVnm_rs2
+
+ subroutine integrate_QijVnm_rs(iqmk,potr,poti,fmr,fmi,qvr,qvi,dfmr,dfmi,dqvr,dqvi,gqvr,gqvi)
+ integer, intent(in) :: iqmk
+ real(kind=DP), intent(in) :: potr(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(in) :: poti(nfftp_exx_nonpara/2)
+ real(kind=DP), intent(in) :: fmr(nlmta)
+ real(kind=DP), intent(in) :: fmi(nlmta)
+ real(kind=DP), intent(out) :: qvr(nlmta)
+ real(kind=DP), intent(out) :: qvi(nlmta)
+ real(kind=DP), intent(in),optional :: dfmr(nlmta,3)
+ real(kind=DP), intent(in),optional :: dfmi(nlmta,3)
+ real(kind=DP), intent(out),optional :: dqvr(nlmta,3)
+ real(kind=DP), intent(out),optional :: dqvi(nlmta,3)
+ real(kind=DP), intent(out),optional :: gqvr(nlmta,3)
+ real(kind=DP), intent(out),optional :: gqvi(nlmta,3)
+ integer :: n,it,ia,imesh,lmt1,lmt2,il1,il2,tau1,tau2,ilmta1,ilmta2,lmtp
+ real(kind=DP), dimension(:), allocatable :: cosqmkr,sinqmkr
+ real(kind=DP) :: co,si,rr,ii,rrr,iii,qr,qi,qqr,qqi,qm,rr0,ii0
+ real(kind=DP), allocatable, dimension(:) :: rra,iia
+ integer :: nma,ind
+ real(kind=DP) :: er(3), ei(3),dqm(3),dqqr(3),dqqi(3),der(3),dei(3),drr(3),dii(3),drr0(3),dii0(3)
+ real(kind=DP) :: dqqr0(3),dqqi0(3),der0(3),dei0(3)
+ logical :: force_mode = .false.
+ integer :: id_sname=-1
+ call tstatc0_begin('integrate_QijVnm_rs ',id_sname,1)
+ force_mode = present(dfmr).and.present(dfmi).and. &
+ & present(dqvr).and.present(dqvi).and. &
+ & present(gqvr).and.present(gqvi)
+ allocate(cosqmkr(nmesh_rs_aug_max));cosqmkr=0.d0
+ allocate(sinqmkr(nmesh_rs_aug_max));sinqmkr=0.d0
+ allocate(rra(nmesh_rs_aug_max));rra=0.d0
+ allocate(iia(nmesh_rs_aug_max));iia=0.d0
+ qvr(:) = 0.d0
+ qvi(:) = 0.d0
+ if(force_mode)then
+ dqvr(1:nlmta,1:3) = 0.d0
+ dqvi(1:nlmta,1:3) = 0.d0
+ gqvr(1:nlmta,1:3) = 0.d0
+ gqvi(1:nlmta,1:3) = 0.d0
+ endif
+ do ia=1,natm
+ it = ityp(ia)
+ if( m_PP_include_vanderbilt_pot(it) == SKIP) cycle
+ call qmk_dot_r(iqmk,ia,cosqmkr,sinqmkr)
+ nma = nmesh_rs_aug(ia)
+ do imesh=1,nma
+ ind = meshxyz_rs_aug(imesh,ia)
+ co = cosqmkr(imesh)
+ si = -sinqmkr(imesh)
+ rra(imesh) = potr(ind)*co+poti(ind)*si
+ iia(imesh) = -poti(ind)*co+potr(ind)*si
+ enddo
+ do lmtp=1,nlmtpair(ia)
+ lmt1 = plmt1(lmtp,ia)
+ lmt2 = plmt2(lmtp,ia)
+ ilmta1 = lmta(lmt1,ia)
+ ilmta2 = lmta(lmt2,ia)
+ rr0 = fmr(ilmta1)
+ ii0 = fmi(ilmta1)
+ qqr=0.d0;qqi=0.d0
+ qr=0.d0;qi=0.d0
+ rr = fmr(ilmta2)
+ ii = fmi(ilmta2)
+ if(force_mode)then
+ dqqr=0.d0;dqqi=0.d0
+ dqqr0=0.d0;dqqi0=0.d0
+ der=0.d0;dei=0.d0
+ der0=0.d0;dei0=0.d0
+ drr(1:3) = dfmr(ilmta2,1:3)
+ dii(1:3) = dfmi(ilmta2,1:3)
+ er=0.d0;ei=0.d0
+ endif
+ do imesh=1,nma
+ qm = qr_clm_ylm(imesh,ia,lmtp)
+ qr = qr+qm*rra(imesh)
+ qi = qi+qm*iia(imesh)
+ enddo
+ if(force_mode)then
+ do imesh=1,nma
+ dqm(1:3) = dqr_clm_ylm(imesh,ia,lmtp,1:3)
+ er(1:3) = er(1:3)+dqm(1:3)*rra(imesh)
+ ei(1:3) = ei(1:3)+dqm(1:3)*iia(imesh)
+ enddo
+ endif
+ qqr = qr*rr-qi*ii
+ qqi = qr*ii+qi*rr
+ qvr(ilmta1) = qvr(ilmta1)+qqr
+ qvi(ilmta1) = qvi(ilmta1)+qqi
+ if(force_mode)then
+ dqqr(1:3) = qr*drr(1:3)-qi*dii(1:3)
+ dqqi(1:3) = qr*dii(1:3)+qi*drr(1:3)
+ der(1:3) = er(1:3)*rr-ei(1:3)*ii
+ dei(1:3) = er(1:3)*ii+ei(1:3)*rr
+ dqvr(ilmta1,1:3) = dqvr(ilmta1,1:3)+dqqr(1:3)
+ dqvi(ilmta1,1:3) = dqvi(ilmta1,1:3)+dqqi(1:3)
+ gqvr(ilmta1,1:3) = gqvr(ilmta1,1:3)+der(1:3)
+ gqvi(ilmta1,1:3) = gqvi(ilmta1,1:3)+dei(1:3)
+ endif
+ if(lmt1.ne.lmt2)then
+ qvr(ilmta2) = qvr(ilmta2)+(qr*rr0-qi*ii0)
+ qvi(ilmta2) = qvi(ilmta2)+(qr*ii0+qi*rr0)
+ endif
+ if(force_mode.and.lmt1.ne.lmt2)then
+ drr0(1:3) = dfmr(ilmta1,1:3)
+ dii0(1:3) = dfmi(ilmta1,1:3)
+ dqqr0(1:3) = qr*drr0(1:3)-qi*dii0(1:3)
+ dqqi0(1:3) = qr*dii0(1:3)+qi*drr0(1:3)
+ der0(1:3) = er(1:3)*rr0-ei(1:3)*ii0
+ dei0(1:3) = er(1:3)*ii0+ei(1:3)*rr0
+ dqvr(ilmta2,1:3) = dqvr(ilmta2,1:3)+dqqr0(1:3)
+ dqvi(ilmta2,1:3) = dqvi(ilmta2,1:3)+dqqi0(1:3)
+ gqvr(ilmta2,1:3) = gqvr(ilmta2,1:3)+der0(1:3)
+ gqvi(ilmta2,1:3) = gqvi(ilmta2,1:3)+dei0(1:3)
+ endif
+ enddo
+ enddo
+ deallocate(cosqmkr)
+ deallocate(sinqmkr)
+ deallocate(rra,iia)
+ call tstatc0_end(id_sname)
+ end subroutine integrate_QijVnm_rs
subroutine add_Vx_hard_part(ik,vxw,sumqvr,sumqvi)
!!subroutine add_Vx_hard_part(ik,vxw1,sumqvr,sumqvi)
@@ -3527,13 +4002,15 @@ contains
implicit none
real(kind=DP), intent(out) :: force(natm,3)
- integer :: ik,ib,ig,ispin,ia
+ integer :: ik,ib,ig,ispin,ia,iadd
real(kind=DP), allocatable :: force_l(:,:) ! d(natm,3)
real(kind=DP), allocatable :: force_mpi(:,:) ! d(natm,3)
real(kind=DP), allocatable :: efsr_l(:,:) ! d(np_e,nlmta)
real(kind=DP), allocatable :: efsi_l(:,:) ! d(np_e,nlmta)
real(kind=DP), allocatable :: defsr_l(:,:,:) ! d(np_e,nlmta,3)
real(kind=DP), allocatable :: defsi_l(:,:,:) ! d(np_e,nlmta,3)
+ real(kind=DP), allocatable, dimension(:) :: zajbuf_r,zajbuf_i
+ integer :: kgw,kgv
integer,save :: id_sname = -1
if(modnrm /= EXECUT) then
@@ -3567,16 +4044,22 @@ contains
do ib=1,np_e ! MPI
if(occup_l(ib,ik) < DELTA) cycle
force_l = 0.d0
+ allocate(zajbuf_r(maxval(np_g1k)));zajbuf_r(1:np_g1k(ik))=zaj_l(1:np_g1k(ik),ib,ik,1)
+ allocate(zajbuf_i(maxval(np_g1k)));zajbuf_i(1:np_g1k(ik))=zaj_l(1:np_g1k(ik),ib,ik,kimg)
+ kgw = maxval(np_g1k);kgv=maxval(np_g1k)
+
if(kimg==1) then
- call apply_Vx_to_WF(ispin,ib,ik,zaj_l(1,ib,ik,1),zaj_l(1,ib,ik,1) &
+ call apply_Vx_to_WF(ispin,ib,ik,kgw,kgv,zajbuf_r,zajbuf_r &
& ,efsr_l(ib,1:nlmta),efsr_l(ib,1:nlmta) &
& ,dbdwr=dfsr_l(ib,1:nlmta,ik,1:3),dbdwi=dfsr_l(ib,1:nlmta,ik,1:3),force_l=force_l)
else
- call apply_Vx_to_WF(ispin,ib,ik,zaj_l(1,ib,ik,1),zaj_l(1,ib,ik,2) &
+ call apply_Vx_to_WF(ispin,ib,ik,kgw,kgv,zajbuf_r,zajbuf_i &
& ,efsr_l(ib,1:nlmta),efsi_l(ib,1:nlmta) &
& ,dbdwr=dfsr_l(ib,1:nlmta,ik,1:3),dbdwi=dfsi_l(ib,1:nlmta,ik,1:3),force_l=force_l)
end if
force = force + occup_l(ib,ik) * force_l
+ deallocate(zajbuf_r)
+ deallocate(zajbuf_i)
end do
end do
end do
@@ -3782,7 +4265,7 @@ contains
! ==============================================================================
! === Make FFT box index arrays. ===============================================
! ==============================================================================
- subroutine m_Parallel_wf_onto_fft_exx_3D(nfout,fft_box_size_WF,igf,nbase,nbase_gamma, &
+ subroutine Parallelize_wf_onto_fft_exx_3D(nfout,fft_box_size_WF,igf,nbase,nbase_gamma, &
& k_symmetry,GAMMA,kg,kg_gamma,kv3)
integer, intent(in) :: nfout, kg, kg_gamma, kv3, GAMMA
integer, intent(in) :: fft_box_size_WF(1:3,0:1)
@@ -3813,7 +4296,7 @@ contains
call mpi_irecv(xyz(1,1,i), 6, mpi_integer, &
& i, itag, mpi_ke_world, req_r(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_irecv error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_irecv error'
call flush(nfout)
call mpi_abort(mpi_comm_world,170,ierr)
endif
@@ -3822,20 +4305,20 @@ contains
call mpi_isend(xyz_fft_x, 6, mpi_integer, &
& i, itag, mpi_ke_world, req_s(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_isend error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_isend error'
call flush(nfout)
call mpi_abort(mpi_comm_world,171,ierr)
endif
enddo
call mpi_waitall(nrank_g, req_r, sta_r, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,172,ierr)
endif
call mpi_waitall(nrank_g, req_s, sta_s, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,173,ierr)
endif
@@ -3844,7 +4327,7 @@ contains
call MPI_ALLGATHER(xyz_fft_x, 6, mpi_integer, &
& rbuf,6, mpi_integer, mpi_ke_world, ierr )
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_allgather error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_allgather error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 174, ierr)
endif
@@ -3958,6 +4441,9 @@ contains
enddo B_3
enddo B_1
else
+!!$ write(nfout,'(" ista_g1k, iend_g1k for " ,i8," = ",2i8)') ik, ista_g1k(ik), iend_g1k(ik)
+!!$ write(nfout,'(" iopr, itrs = ",2i8)') iopr, itrs
+ call flush(6)
B_11 : do j = ista_g1k(ik), iend_g1k(ik)
iadd = j-ista_g1k(ik)+1
i1 = igf(ngpt_exx(nbase(j,ik),iopr,itrs))
@@ -4000,7 +4486,7 @@ contains
call mpi_irecv(wf_fft_recv_exx(1,1,i,iopr,itrs), max_mp_g1k*len*klen, mpi_integer, &
& i, itag, mpi_ke_world, req_r(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_irecv error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_irecv error'
call flush(nfout)
call mpi_abort(mpi_comm_world,174,ierr)
endif
@@ -4009,20 +4495,20 @@ contains
call mpi_isend(wf_fft_send_exx(1,1,i,iopr,itrs), max_mp_g1k*len*klen, mpi_integer, &
& i, itag, mpi_ke_world, req_s(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_isend error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_isend error'
call flush(nfout)
call mpi_abort(mpi_comm_world,175,ierr)
endif
enddo
call mpi_waitall(nrank_g, req_r, sta_r, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,176,ierr)
endif
call mpi_waitall(nrank_g, req_s, sta_s, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,177,ierr)
endif
@@ -4031,7 +4517,7 @@ contains
& wf_fft_recv_exx(1,1,0,iopr,itrs), max_mp_g1k*len*klen, mpi_integer, &
& mpi_ke_world, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_exx_3D : mpi_alltoall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_exx_3D : mpi_alltoall error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 178, ierr)
endif
@@ -4093,7 +4579,7 @@ contains
deallocate(work)
deallocate(wf_fft_send_exx)
- end subroutine m_Parallel_wf_onto_fft_exx_3D
+ end subroutine Parallelize_wf_onto_fft_exx_3D
subroutine m_Parallel_wf_onto_fft_dealloc_exx_3D
deallocate(wf_fft_rcnt_exx)
@@ -4105,7 +4591,7 @@ contains
deallocate(wf_fft_maxsend_exx)
end subroutine m_Parallel_wf_onto_fft_dealloc_exx_3D
- subroutine m_Parallel_fft_onto_wf_rhog_3D(nfout,igf,kg,nfft)
+ subroutine Parallelize_fft_onto_wf_rhog_3D(nfout,igf,kg,nfft)
integer, intent(in) :: nfout, kg, nfft
integer, intent(in) :: igf(kg)
integer, dimension(0:nrank_g-1) ::req_r,req_s
@@ -4127,7 +4613,7 @@ contains
allocate(fft_wf_dist_rhog(fft_l_size), stat=ierr)
allocate(fft_wf_index_rhog(fft_l_size), stat=ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : Not allocate '
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : Not allocate '
call flush(nfout)
call mpi_abort(mpi_comm_world, 204, ierr)
endif
@@ -4140,7 +4626,7 @@ contains
allocate(fftigf(nfft,2), stat=ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : Not allocate '
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : Not allocate '
call flush(nfout)
call mpi_abort(mpi_comm_world, 206, ierr)
endif
@@ -4175,7 +4661,7 @@ contains
call mpi_irecv(fft_wf_recv_rhog(1,lrank), isrsize, mpi_integer, &
& lrank, itag, mpi_ke_world, req_r(lrank), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : mpi_irecv error'
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : mpi_irecv error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 207, ierr)
endif
@@ -4188,7 +4674,7 @@ contains
call mpi_isend(fft_wf_send_rhog(1,lrank), isrsize, mpi_integer, &
& lrank, itag, mpi_ke_world, req_s(lrank), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : mpi_isend error'
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : mpi_isend error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 208, ierr)
endif
@@ -4196,13 +4682,13 @@ contains
call mpi_waitall(nrank_g, req_r, sta_r, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 209, ierr)
endif
call mpi_waitall(nrank_g, req_s, sta_s, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 210, ierr)
endif
@@ -4211,7 +4697,7 @@ contains
& fft_wf_recv_rhog, isrsize, mpi_integer, &
& mpi_ke_world, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_fft_onto_wf_rhog_3D : mpi_alltoall error'
+ write(nfout,*)' Parallelize_fft_onto_wf_rhog_3D : mpi_alltoall error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 211, ierr)
endif
@@ -4244,7 +4730,7 @@ contains
end do
deallocate(work)
deallocate(fft_wf_send_rhog)
- end subroutine m_Parallel_fft_onto_wf_rhog_3D
+ end subroutine Parallelize_fft_onto_wf_rhog_3D
subroutine m_Parallel_fft_onto_wf_dealloc_rhog_3D
deallocate(fft_wf_rcnt_rhog)
@@ -4254,7 +4740,7 @@ contains
deallocate(fft_wf_dist_rhog)
end subroutine m_Parallel_fft_onto_wf_dealloc_rhog_3D
- subroutine m_Parallel_wf_onto_fft_rhog_3D(nfout,fft_box_size_WF,igf,kg)
+ subroutine Parallelize_wf_onto_fft_rhog_3D(nfout,fft_box_size_WF,igf,kg)
integer, intent(in) :: nfout, kg
integer, intent(in) :: fft_box_size_WF(1:3,0:1)
integer, intent(in) :: igf(kg)
@@ -4280,7 +4766,7 @@ contains
call mpi_irecv(xyz(1,1,i), 6, mpi_integer, &
& i, itag, mpi_ke_world, req_r(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_irecv error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_irecv error'
call flush(nfout)
call mpi_abort(mpi_comm_world,170,ierr)
endif
@@ -4289,20 +4775,20 @@ contains
call mpi_isend(xyz_fft_x, 6, mpi_integer, &
& i, itag, mpi_ke_world, req_s(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_isend error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_isend error'
call flush(nfout)
call mpi_abort(mpi_comm_world,171,ierr)
endif
enddo
call mpi_waitall(nrank_g, req_r, sta_r, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,172,ierr)
endif
call mpi_waitall(nrank_g, req_s, sta_s, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,173,ierr)
endif
@@ -4311,7 +4797,7 @@ contains
call MPI_ALLGATHER(xyz_fft_x, 6, mpi_integer, &
& rbuf, 6, mpi_integer, mpi_ke_world, ierr )
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_allgather error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_allgather error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 174, ierr)
endif
@@ -4375,7 +4861,7 @@ B_11 : do j = ista_kngp, min(kg,iend_kng
call mpi_irecv(wf_fft_recv_rhog(1,i), max_mp_g1k*len, mpi_integer, &
& i, itag, mpi_ke_world, req_r(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_irecv error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_irecv error'
call flush(nfout)
call mpi_abort(mpi_comm_world,174,ierr)
endif
@@ -4384,20 +4870,20 @@ B_11 : do j = ista_kngp, min(kg,iend_kng
call mpi_isend(wf_fft_send_rhog(1,i), max_mp_g1k*len, mpi_integer, &
& i, itag, mpi_ke_world, req_s(i), ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_isend error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_isend error'
call flush(nfout)
call mpi_abort(mpi_comm_world,175,ierr)
endif
enddo
call mpi_waitall(nrank_g, req_r, sta_r, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,176,ierr)
endif
call mpi_waitall(nrank_g, req_s, sta_s, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_waitall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_waitall error'
call flush(nfout)
call mpi_abort(mpi_comm_world,177,ierr)
endif
@@ -4406,7 +4892,7 @@ B_11 : do j = ista_kngp, min(kg,iend_kng
& wf_fft_recv_rhog, max_mp_g1k*len, mpi_integer, &
& mpi_ke_world, ierr)
if(ierr /= 0) then
- write(nfout,*)' m_Parallel_wf_onto_fft_rhog_3D : mpi_alltoall error'
+ write(nfout,*)' Parallelize_wf_onto_fft_rhog_3D : mpi_alltoall error'
call flush(nfout)
call mpi_abort(mpi_comm_world, 178, ierr)
endif
@@ -4440,7 +4926,7 @@ B_11 : do j = ista_kngp, min(kg,iend_kng
deallocate(work)
deallocate(wf_fft_send_rhog)
- end subroutine m_Parallel_wf_onto_fft_rhog_3D
+ end subroutine Parallelize_wf_onto_fft_rhog_3D
subroutine m_Parallel_wf_onto_fft_dealloc_rhog_3D
deallocate(wf_fft_rcnt_rhog)
diff -uprN phase0_2015.01/src_phase_3d/m_ES_IO.F90 phase0_2015.01.01/src_phase_3d/m_ES_IO.F90
--- phase0_2015.01/src_phase_3d/m_ES_IO.F90 2015-09-14 15:38:24.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_IO.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 459 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 487 $)
!
! MODULE: m_ES_IO
!
@@ -58,7 +58,7 @@
!
module m_ES_IO
-! $Id: m_ES_IO.F90 459 2015-09-10 08:50:04Z yamasaki $
+! $Id: m_ES_IO.F90 487 2016-05-17 05:20:42Z ktagami $
use m_Electronic_Structure, only : zaj_l,neordr,nrvf_ordr,eko_l,occup_l,efermi,efermi_spin,totch&
& ,vnlph_l,vlhxc_l,eko_ek
use m_PlaneWaveBasisSet, only : kgp,kg1,ngabc,nbase,iba
@@ -96,19 +96,35 @@ module m_ES_IO
use m_Control_Parameters, only : ndim_magmom, ik_wf_squared, &
& ib1_wf_squared, ib2_wf_squared, &
- & wf_squared_filetype
+ & wf_squared_filetype, max_projs, proj_attribute, &
+ & ndim_chgpot, SpinOrbit_Mode, &
+ & wf_orb_proj_print_format, proj_group, num_proj_elems
+ use m_Const_parameters, only : Neglected
use m_Files, only : nfwfk_sq, m_Files_open_nfwfksq_noncl, &
& nfwfk_integ_mom, &
& m_Files_open_nfwfk_integ_mom, &
- & m_Files_close_nfwfk_integ_mom
- use m_PseudoPotential, only : nlmt, ilmt, lmta, q
+ & m_Files_close_nfwfk_integ_mom, &
+ & m_Files_open_nfwfk_orb_proj, &
+ & m_Files_close_nfwfk_orb_proj, &
+ & nfwfk_orb_proj
+ use m_PseudoPotential, only : nlmt, ilmt, lmta, q, &
+ & nlmta_phi, nlmtt_phi, qorb, m_PP_tell_iorb_lmt, &
+ & m_PP_tell_iorb_ia_l_m_tau, ilmt_phi, &
+ & mtp_phi, lmta_phi, ltp_phi, taup_phi
+ use m_Nonlocal_Potential, only : norm_phig
use m_Charge_Density, only : chgq_l, hsr, hsi, &
& m_CD_alloc_rspace_charge, &
& m_CD_dealloc_rspace_charge, &
& m_CD_rspace_charge_noncl
- use m_Ionic_System, only : ityp
- use m_Electronic_Structure, only : fsr_l, fsi_l
+ use m_Ionic_System, only : ityp, iproj_group
+ use m_Electronic_Structure, only : fsr_l, fsi_l, compr_l, compi_l
use m_ES_Noncollinear, only : m_ES_set_Pauli_Matrix
+ use m_SpinOrbit_Potential, only : MatU_ylm_RC_L0, MatU_ylm_RC_L1, MatU_ylm_RC_L2, &
+ & MatU_ylm_RC_L3
+
+! ==== EXP_CELLOPT ==== 2015/09/24
+ use m_PlaneWaveBasisSet, only : kg1_prev
+! ===================== 2015/09/24
implicit none
include 'mpif.h'
@@ -731,13 +747,15 @@ contains
if(mode == EIGEN_VALUES) then
write(nf,'(" ik = ",i4," ",8f12.6)') ik, (e_mpi(nb,ik),nb=ie1,ie2)
else if(mode == OCCUPATIONS) then
- write(nf,'(" ik = ",i4," ",8f12.6)') ik, (o_mpi(nb,ik)/(qwgt(ik)*kv3),nb=ie1,ie2)
+ write(nf,'(" ik = ",i4," ",8f12.6)') ik, &
+ & (o_mpi(nb,ik)/(qwgt(ik)*kv3/ndim_spinor),nb=ie1,ie2)
end if
else
if(mode == EIGEN_VALUES) then
write(nf,'(12x,8f12.6)') (e_mpi(nb,ik),nb=ie1,ie2)
else if(mode == OCCUPATIONS) then
- write(nf,'(12x,8f12.6)') (o_mpi(nb,ik)/(qwgt(ik)*kv3),nb=ie1,ie2)
+ write(nf,'(12x,8f12.6)') &
+ & (o_mpi(nb,ik)/(qwgt(ik)*kv3/ndim_spinor),nb=ie1,ie2)
end if
end if
end do
diff -uprN phase0_2015.01/src_phase_3d/m_ES_LHXC.F90 phase0_2015.01.01/src_phase_3d/m_ES_LHXC.F90
--- phase0_2015.01/src_phase_3d/m_ES_LHXC.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_LHXC.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 494 $)
!
! MODULE: m_ES_LHXC
!
@@ -47,7 +47,7 @@
#endif
module m_ES_LHXC
-! $Id: m_ES_LHXC.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_ES_LHXC.F90 494 2016-06-02 00:54:16Z jkoga $
use m_Electronic_Structure, only : vlhxc_l, vloc_esm
use m_PlaneWaveBasisSet, only : kg,kgp,gr_l
use m_PseudoPotential, only : psc_l, ival
@@ -62,7 +62,7 @@ module m_ES_LHXC
, sw_screening_correction, sw_external_potential
#endif
use m_Const_Parameters, only : DP, PAI4, UP, DOWN, ON, OFF, CMPLDP
- use m_Parallelization, only : ista_kngp, iend_kngp, mype, myrank_g, mpi_comm_group
+ use m_Parallelization, only : ista_kngp, iend_kngp, mype, myrank_g, mpi_ke_world
use m_Crystal_Structure, only : univol
use m_Dipole, only : vdip_l, vext_l
use m_Screening, only : screening
@@ -77,7 +77,13 @@ module m_ES_LHXC
use m_FFT, only : fft_box_size_CD
use m_PlaneWaveBasisSet, only : igfp_l
-implicit none
+! === POSITRON SCF === 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : positron_GGGC
+ use m_Positron_Wave_Functions, only : pchg_l
+! ==================== 2015/11/28
+
+ implicit none
include 'mpif.h'
! 61. m_ESlhxc_potential
contains
@@ -110,16 +116,19 @@ contains
if(sw_esm==ON) then
nfftcd = fft_box_size_CD(1,0)*fft_box_size_CD(2,0)*fft_box_size_CD(3,0)
allocate(vhar(nfftcd));vhar=(0.d0,0.d0)
- allocate(chgc(iend_kngp-ista_kngp+1,nspin));chgc=(0.d0,0.d0)
+ allocate(chgc(kgp,nspin));chgc=(0.d0,0.d0)
if(kimg==1)then
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),0.d0)
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),0.d0)
+ chgc(ig,1:nspin) = dcmplx(chg(ig,1,1:nspin),0.d0)
enddo
else
do ig=ista_kngp,iend_kngp
- chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),chg(ig,2,1:nspin))
+! chgc(ig-ista_kngp+1,1:nspin) = dcmplx(chg(ig,1,1:nspin),chg(ig,2,1:nspin))
+ chgc(ig,1:nspin) = dcmplx(chg(ig,1,1:nspin),chg(ig,2,1:nspin))
enddo
endif
+ call mpi_allreduce(mpi_in_place,chgc,kgp*nspin,mpi_double_complex,mpi_sum,mpi_ke_world,ierr)
call esm_hartree(chgc,ehar,vhar)
vhar(:) = 0.5d0*vhar(:) !Ry -> Ha
deallocate(chgc)
diff -uprN phase0_2015.01/src_phase_3d/m_ES_Mag_Constraint.f90 phase0_2015.01.01/src_phase_3d/m_ES_Mag_Constraint.f90
--- phase0_2015.01/src_phase_3d/m_ES_Mag_Constraint.f90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_Mag_Constraint.f90 2016-07-12 12:51:53.000000000 +0900
@@ -1,5 +1,5 @@
module m_ES_Mag_Constraint
-! $Id: m_ES_Mag_Constraint.f90 409 2014-10-27 09:24:52Z jkoga $
+! $Id: m_ES_Mag_Constraint.f90 469 2015-09-30 03:06:13Z ktagami $
use m_Parallelization, only : ista_kngp, iend_kngp, ierr, npes, mype, &
& mpi_comm_group
@@ -242,8 +242,152 @@ contains
end subroutine case_constraint_moment_local
- subroutine case_constraint_direc_local ! only for noncol
- stop "Not supported"
+ subroutine case_constraint_direc_local
+ real(kind=DP) :: MagMom(3), cfactor(3), MagDirec(3)
+ real(kind=DP) :: rad1, fac1r, fac1i, fac2
+ real(kind=DP) :: VecG(3), normG, normG3, gr, d1
+ real(kind=DP) :: c1, c2, c3, cnorm, cnorm2, cnorm4
+
+ real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10
+! real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-4
+
+ real(kind=DP), allocatable :: zfcos(:), zfsin(:)
+ real(kind=DP), allocatable :: RhoMag_on_atom_mpi(:,:)
+
+ integer :: i, j, ia, it, is, ixyz, ixyz_max, ist
+
+ allocate(zfcos(ista_kngp:iend_kngp)); zfcos = 0.d0
+ allocate(zfsin(ista_kngp:iend_kngp)); zfsin = 0.d0
+
+ if ( noncol ) then
+ ixyz_max = 3
+ else
+ ixyz_max = 1
+ endif
+
+ if ( allocated( MagField_constrain_local ) ) then
+ deallocate( MagField_constrain_local )
+ endif
+
+ allocate( MagField_constrain_local(ista_kngp:iend_kngp, kimg, ixyz_max ))
+ MagField_constrain_local = 0.0d0
+!
+ Do ia=1, natm
+ it = ityp(ia)
+ rad1 = rad_cov(ia)
+
+ MagMom = 0.0d0
+ Do ixyz=1, ixyz_max
+ if ( noncol ) then
+ MagMom( ixyz ) = RhoMag_on_atom( ia, ixyz +1 )
+ else
+ MagMom( ixyz ) = RhoMag_on_atom( ia, 1 ) -RhoMag_on_atom( ia, 2 )
+ endif
+ End do
+
+ cnorm2 = 0.0d0
+ Do ixyz=1, ixyz_max
+ cnorm2 = cnorm2 + MagMom(ixyz)**2
+ End do
+ cnorm = sqrt( cnorm2 )
+
+ if ( cnorm < cnorm_lower_limit ) cycle
+
+ MagDirec = MagMom / cnorm
+!
+
+ cnorm4 = 0.0d0
+ Do ixyz=1, ixyz_max
+ cnorm4 = cnorm4 +mag_moment0_atomtyp(it,ixyz)**2
+ End do
+ cnorm4 = sqrt( cnorm4 )
+!
+ Do ixyz=1, ixyz_max
+ if ( noncol ) then
+ c1 = cnorm2 - MagMom(ixyz)**2; c2 = cnorm**3
+ if ( cnorm4 > 0.0 ) then
+ c3 = mag_constraint_lambda /univol *c1 /c2 &
+ & *( MagDirec(ixyz) -mag_direction0_atomtyp(it,ixyz) )
+ else
+ c3 = 0.0d0
+ endif
+ cfactor( ixyz ) = c3
+ else
+ if ( cnorm4 > 0.0 ) then
+ if ( mag_moment0_atomtyp(it,ixyz) > 0.0 ) then
+ c3 = 1.0d0
+ else
+ c3 = -1.0d0
+ endif
+ cfactor( ixyz ) = mag_constraint_lambda /univol &
+ & *( MagDirec(ixyz) -c3 )
+ else
+ cfactor( ixyz ) = 0.0d0
+ endif
+ endif
+
+! write(2000+mype,*) "ia cfac = ", ia, cfactor(ixyz), MagDirec(1), c3
+! write(2100+mype,*) "ia = ", ia, MagMom(ixyz), cnorm, cnorm2
+
+ call calc_phase2( natm, pos, ia, kgp, ngabc, ista_kngp, iend_kngp, &
+ & zfcos, zfsin )
+
+ if ( ista_kngp == 1 ) then
+ ist = 2
+ else
+ ist = ista_kngp
+ endif
+
+ Do i=ist, iend_kngp
+ VecG(1) = rltv(1,1)*ngabc(i,1) +rltv(1,2)*ngabc(i,2) +rltv(1,3)*ngabc(i,3)
+ VecG(2) = rltv(2,1)*ngabc(i,1) +rltv(2,2)*ngabc(i,2) +rltv(2,3)*ngabc(i,3)
+ VecG(3) = rltv(3,1)*ngabc(i,1) +rltv(3,2)*ngabc(i,2) +rltv(3,3)*ngabc(i,3)
+
+ normG = sqrt( VecG(1)**2 +VecG(2)**2 +VecG(3)**2 )
+ normG3 = normG**3
+
+ fac1r = zfcos(i); fac1i = zfsin(i)
+!
+ gr = normG *rad1
+ fac2 = -gr *cos(gr) + sin(gr)
+ fac2 = fac2 *PAI4 /normG3
+!
+ MagField_constrain_local( i, 1, ixyz ) &
+ & = MagField_constrain_local( i, 1, ixyz ) &
+ & +fac1r *fac2 *cfactor( ixyz )
+ if ( kimg == 2 ) then
+ MagField_constrain_local( i, 2, ixyz ) &
+ & = MagField_constrain_local( i, 2, ixyz ) &
+ & -fac1i *fac2 *cfactor( ixyz )
+ endif
+ End Do
+
+ if ( mype == 0 ) then
+ fac2 = PAI4 /3.0d0 *rad1**3
+
+ MagField_constrain_local( 1, 1, ixyz ) &
+ & = MagField_constrain_local( 1, 1, ixyz ) &
+ & +fac2 *cfactor( ixyz )
+ end if
+ End Do
+ End Do
+!
+ if ( noncol ) then
+ Do i=ista_kngp, iend_kngp
+ Do is=2, ndim_magmom
+ vlhxc_l(i,1,is) = vlhxc_l(i,1,is) +MagField_constrain_local(i,1,is-1)
+ vlhxc_l(i,2,is) = vlhxc_l(i,2,is) +MagField_constrain_local(i,2,is-1)
+ End do
+ End Do
+ else
+ Do i=ista_kngp, iend_kngp
+ Do j=1, kimg
+ vlhxc_l(i,j,1) = vlhxc_l(i,j,1) +MagField_constrain_local(i,j,1)
+ vlhxc_l(i,j,2) = vlhxc_l(i,j,2) -MagField_constrain_local(i,j,1)
+ End Do
+ End Do
+ endif
+
end subroutine case_constraint_direc_local
end subroutine m_ES_add_MagConstraintPot_chgql
@@ -518,11 +662,100 @@ contains
end subroutine case_constraint_direc_global
subroutine case_constraint_direc_local
- stop "kt: Not supported"
+ real(kind=DP) :: MagMom(3), MagDirec(3), c1, c2, c3
+ integer :: i, j, ia, it, is, ixyz
+
+ real(kind=DP) :: cnorm, cnorm2, cnorm4
+ real(kind=DP) :: csum1, csum2
+
+ real(kind=DP), parameter :: cnorm_lower_limit = 1.0D-10
+
+ csum1 = 0.0d0; csum2 = 0.0d0
+
+ if ( noncol ) then
+ Do i=ista_kngp, iend_kngp
+ Do j=1, kimg
+ Do ixyz=1, 3
+ csum1 = csum1 + MagField_constrain_local(i,j,ixyz)*chgq_l(i,j,ixyz+1)
+ End Do
+ End Do
+ End Do
+
+ Do ia=1, natm
+ it = ityp(ia)
+ Do ixyz=1, 3
+ MagMom(ixyz) = RhoMag_on_Atom( ia,ixyz+1 )
+ End do
+
+ cnorm2 = 0.0d0
+ Do ixyz=1, 3
+ cnorm2 = cnorm2 + MagMom(ixyz)**2
+ End do
+ cnorm = sqrt( cnorm2 )
+
+ cnorm4 = 0.0d0
+ Do ixyz=1, 3
+ cnorm4 = cnorm4 +mag_moment0_atomtyp(it,ixyz)**2
+ End do
+ cnorm4 = sqrt( cnorm4 )
+
+ if ( cnorm4 > 0.0 .and. cnorm > cnorm_lower_limit ) then
+ MagDirec = MagMom / cnorm
+ Do ixyz=1, 3
+ csum2 = csum2 + ( MagDirec(ixyz) -mag_direction0_atomtyp(it,ixyz) )**2
+ End Do
+ endif
+ End do
+
+ else
+ Do i=ista_kngp, iend_kngp
+ Do j=1, kimg
+ csum1 = csum1 + MagField_constrain_local(i,j,1) &
+ & *( chgq_l(i,j,1) -chgq_l(i,j,2) )
+ End Do
+ End Do
+
+ Do ia=1, natm
+ it = ityp(ia)
+ MagMom(1) = RhoMag_on_Atom( ia,1 ) -RhoMag_on_Atom( ia,2 )
+
+ cnorm2 = 0.0d0
+ Do ixyz=1, 1
+ cnorm2 = cnorm2 + MagMom(ixyz)**2
+ End do
+ cnorm = sqrt( cnorm2 )
+
+ cnorm4 = 0.0d0
+ Do ixyz=1, 1
+ cnorm4 = cnorm4 +mag_moment0_atomtyp(it,ixyz)**2
+ End do
+ cnorm4 = sqrt( cnorm4 )
+
+ if ( cnorm4 > 0.0 .and. cnorm > cnorm_lower_limit ) then
+ MagDirec = MagMom / cnorm
+ if ( mag_moment0_atomtyp(it,1) > 0.0 ) then
+ c3 = 1.0d0
+ else
+ c3 = -1.0d0
+ endif
+ csum2 = csum2 +( MagDirec(1) -c3 )**2
+ endif
+ End do
+ endif
+
+ if ( npes > 1 ) then
+ call mpi_allreduce( csum1, c1, 1, mpi_double_precision, &
+ & mpi_sum, mpi_comm_group, ierr )
+ csum1 = c1
+ endif
+
+ ene_double_counting = csum1 *univol
+ ene_mag_constraint = csum2 *mag_constraint_lambda/ 2.0d0
+
end subroutine case_constraint_direc_local
subroutine case_constraint_moment_local
- real(kind=DP) :: MagMom(3), MagDirec(3), c1, c2
+ real(kind=DP) :: MagMom(3), c1, c2
integer :: i, j, ia, it, is, ixyz
real(kind=DP) :: csum1, csum2
@@ -542,8 +775,8 @@ contains
it = ityp(ia)
Do ixyz=1, 3
MagMom(ixyz) = RhoMag_on_Atom( ia,ixyz+1 )
+ csum2 = csum2 + ( MagMom(ixyz) -mag_moment0_atomtyp(it,ixyz) )**2
End do
- csum2 = csum2 + ( MagMom(ixyz) -mag_moment0_atomtyp(it,ixyz) )**2
End do
else
@@ -557,7 +790,7 @@ contains
Do ia=1, natm
it = ityp(ia)
MagMom(1) = RhoMag_on_Atom( ia,1 ) -RhoMag_on_Atom( ia,2 )
- csum2 = ( MagMom(1) -mag_moment0_atomtyp(it,1) )**2
+ csum2 = csum2 +( MagMom(1) -mag_moment0_atomtyp(it,1) )**2
End do
endif
diff -uprN phase0_2015.01/src_phase_3d/m_ES_NonCollinear.f90 phase0_2015.01.01/src_phase_3d/m_ES_NonCollinear.f90
--- phase0_2015.01/src_phase_3d/m_ES_NonCollinear.f90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_NonCollinear.f90 2016-07-12 12:51:53.000000000 +0900
@@ -1,5 +1,5 @@
module m_ES_NonCollinear
-! $Id: m_ES_NonCollinear.f90 409 2014-10-27 09:24:52Z jkoga $
+! $Id: m_ES_NonCollinear.f90 487 2016-05-17 05:20:42Z ktagami $
use m_Const_Parameters, only : DP, CMPLDP, zi, yes, PAI, &
& BuiltIn, ByProjector, ByPawPot, ZeffApprox, &
& BUCS, CARTS, CRDTYP, DELTA10, ReadFromPP
diff -uprN phase0_2015.01/src_phase_3d/m_ES_WF_by_RMM.F90 phase0_2015.01.01/src_phase_3d/m_ES_WF_by_RMM.F90
--- phase0_2015.01/src_phase_3d/m_ES_WF_by_RMM.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_WF_by_RMM.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1986,10 +1986,12 @@ STOP_TIMER(1620)
end if
end do
- do iap = 1, n_ialist0
- ia = n_ialist0*(lmt1-1) + iap
- bWr_lmt(ia,:) = bWr_tmp(iap,:)
- bWi_lmt(ia,:) = bWi_tmp(iap,:)
+ do ib = 1, np_e
+ do iap = 1, n_ialist0
+ ia = n_ialist0*(lmt1-1) + iap
+ bWr_lmt(ia,ib) = bWr_tmp(iap,ib)
+ bWi_lmt(ia,ib) = bWi_tmp(iap,ib)
+ end do
end do
do iap = 1, n_ialist0
diff -uprN phase0_2015.01/src_phase_3d/m_ES_WF_by_submat.F90 phase0_2015.01.01/src_phase_3d/m_ES_WF_by_submat.F90
--- phase0_2015.01/src_phase_3d/m_ES_WF_by_submat.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_WF_by_submat.F90 2016-07-12 12:51:53.000000000 +0900
@@ -841,6 +841,7 @@ contains
! (make matrix elements )
#ifdef _USE_SCALAPACK_
+ if(iprisubmat>=2) write(nfout,'(" sw_scalapack = ",i3," <<evolve_WFs_in_subspace>>")') sw_scalapack
if(sw_scalapack == ON) then
if(submat_uncalled) then
if(iprisubmat >= 2) write(nfout,'("first nprow,npcol=",2i5)') nprow,npcol
diff -uprN phase0_2015.01/src_phase_3d/m_ES_dos.F90 phase0_2015.01.01/src_phase_3d/m_ES_dos.F90
--- phase0_2015.01/src_phase_3d/m_ES_dos.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ES_dos.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 492 $)
!
! MODULE: m_ES_dos
!
@@ -34,14 +34,14 @@
!
module m_ES_dos
! (m_ESdos)
-! $Id: m_ES_dos.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_ES_dos.F90 492 2016-05-31 03:06:04Z jkoga $
!
! This module was originally coded by T. Yamasaki (FUJITSU Laboratories) in 2001.
! And this is transferred as match to PHASE by T. Yamasaki, 18th May. 2003.
!
use m_Kpoints, only : kv3, kv3_ek, qwgt,vkxyz_ek &
& , np0,np2,ip20,iwt,ip2cub,nxyz_tetra,trmat &
- & , m_Kp_sample_mesh
+ & , m_Kp_sample_mesh, qwgt_ek
use m_Files, only : nfout
!!$ use m_Files, only : nfdos, nfout
use m_Timing, only : tstatc0_begin, tstatc0_end
@@ -54,7 +54,8 @@ module m_ES_dos
& ,ipriinputfile, printable
use m_Const_Parameters, only : DP,Hartree,BUCS,EK,SCF, ALDOS, LAYERDOS, ON, OFF, TOTAL, PAI2
use m_Parallelization, only : mpi_comm_group,map_ek,mype,map_e,map_k,myrank_e,myrank_k &
- & ,ierr,np_e,map_z,ista_e,npes,mpi_kg_world,mpi_ge_world
+ & ,ierr,np_e,map_z,ista_e,npes,mpi_kg_world &
+ & , mpi_ge_world, nrank_e
use m_PseudoPotential, only : nlmta_phi,nlmtt_phi &
& ,m_PP_tell_iorb_ia_l_m_tau,qorb &
& ,m_PP_tell_iorb_lmt
@@ -570,6 +571,7 @@ contains
& mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
call mpi_allreduce( norm_phig_mpi, norm_phig_mpi2, nlmtt_phi*kv/ndim_spinor, &
& mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
+ norm_phig_mpi2 = norm_phig_mpi2 / dble(nrank_e)
end if
eko = eko_mpi
@@ -751,14 +753,15 @@ contains
subroutine dealloc_dos()
deallocate(dos)
deallocate(sumdos)
-!!$ if(sw_pdos == ON) then
-!!$ if(allocated(pdos)) deallocate(pdos)
-!!$ if(allocated(sumpdos)) deallocate(sumpdos)
-!!$ end if
+ if(sw_pdos == ON) then
+ if(allocated(pdos)) deallocate(pdos)
+ if(allocated(sumpdos)) deallocate(sumpdos)
+ end if
end subroutine dealloc_dos
- subroutine make_dos_with_GaussianDistrib(kv,iwsc)
- integer, intent(in) :: kv,iwsc
+ subroutine make_dos_with_GaussianDistrib( kv, iwsc, kpt_weight )
+ integer, intent(in) :: kv, iwsc
+ real(kind=DP), intent(in) :: kpt_weight( kv )
integer :: i, ik, is, ie, id, ispin, iorb, iopr, lmt, iksnl
real(kind=DP) :: Es, e, El, Eu, tl, tu, w, DeltaE
@@ -802,41 +805,42 @@ contains
tu = (Eu - eko(i,ik))*sqrtdVI
! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
dos(id+1,ispin) = dos(id+1,ispin) &
- & + w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
+ & + w *2 *(derf(tu) - derf(tl)) *0.5d0 /DeltaE *kpt_weight(ik)
end do
if(iwsc == TOTAL .and. sw_pdos == ON) then
do iorb = 1,nlmta_phi
- call m_PP_tell_iorb_lmt(iorb,lmt)
- porb = 0.d0
+ call m_PP_tell_iorb_lmt(iorb,lmt)
+ porb = 0.d0
!!$ASASASASAS
!!$ do iopr=1,nopr
!!$ porb = porb + (compr(i,iorb,iopr,ik)**2 &
!!$ & + compi(i,iorb,iopr,ik)**2) &
!!$ & *(1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl))
!!$ end do
- if ( k_symmetry(ik) == GAMMA ) then
- do iopr=1,nopr
- porb = porb + compr(i,iorb,iopr,ik)**2 /2.0 &
- & *(1.d0+qorb(iorb)/(norm_phig_mpi(lmt,iksnl)*2.) )
- end do
- else
- do iopr=1,nopr
- porb = porb + (compr(i,iorb,iopr,ik)**2 &
- & + compi(i,iorb,iopr,ik)**2) &
- & *(1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl))
- end do
- endif
+ if ( k_symmetry(ik) == GAMMA ) then
+ do iopr=1,nopr
+ porb = porb + compr(i,iorb,iopr,ik)**2 /2.0 &
+ & *(1.d0+qorb(iorb)/(norm_phig_mpi(lmt,iksnl)*2.) )
+ end do
+ else
+ do iopr=1,nopr
+ porb = porb + (compr(i,iorb,iopr,ik)**2 &
+ & + compi(i,iorb,iopr,ik)**2) &
+ & *(1.d0+qorb(iorb)/norm_phig_mpi(lmt,iksnl))
+ end do
+ endif
!!$ASASASASAS
- porb = porb/dble(nopr)
- do id = is, ie
- El = Es + id*DeltaE
- Eu = El + DeltaE
- tl = (El - eko(i,ik))*sqrtdVI
- tu = (Eu - eko(i,ik))*sqrtdVI
- ! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
- pdos(id+1,iorb,ispin) = pdos(id+1,iorb,ispin) &
- & + porb * w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
- end do
+ porb = porb/dble(nopr)
+ do id = is, ie
+ El = Es + id*DeltaE
+ Eu = El + DeltaE
+ tl = (El - eko(i,ik))*sqrtdVI
+ tu = (Eu - eko(i,ik))*sqrtdVI
+ ! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
+ pdos(id+1,iorb,ispin) = pdos(id+1,iorb,ispin) &
+ & + porb *w *2 *(derf(tu) - derf(tl)) *0.5d0 /DeltaE &
+ & *kpt_weight(ik)
+ end do
end do
end if
end do
@@ -857,8 +861,9 @@ contains
end subroutine make_dos_with_GaussianDistrib
! ==================================== added by K. Tagami ============== 11.0
- subroutine mkdos_with_GaussDistrib_noncl(kv,iwsc)
- integer, intent(in) :: kv,iwsc
+ subroutine mkdos_with_GaussDistrib_noncl( kv, iwsc, kpt_weight )
+ integer, intent(in) :: kv, iwsc
+ real(kind=DP), intent(in) :: kpt_weight( kv )
integer :: i, ik, is, ie, id, ispin, iorb, iopr, lmt, iksnl
integer :: is1, is2, istmp, ismax
@@ -916,7 +921,7 @@ contains
tu = (Eu - eko(i,iksnl))*sqrtdVI
! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
dos(id+1,istmp) = dos(id+1,istmp) &
- & + w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
+ & + w *(derf(tu) - derf(tl)) *0.5d0 /DeltaE *kpt_weight(ik)
end do
End do
@@ -962,7 +967,8 @@ contains
tu = (Eu - eko(i,iksnl))*sqrtdVI
! d = (derf(tl) - derf(tu))*0.5d0/(DeltaE*kv)
pdos(id+1,iorb,:) = pdos(id+1,iorb,:) &
- & + porb(iorb,:) * w * 2*(derf(tu) - derf(tl))*0.5d0/(DeltaE*kv)
+ & + porb(iorb,:) *w *(derf(tu) - derf(tl)) &
+ & *0.5d0 /DeltaE *kpt_weight(ik)
end do
End do
@@ -989,8 +995,9 @@ contains
! =================================================================== 11.0
! ====================== KT_add ======================= 13.0E
- subroutine make_dos_with_FDiracDistrib(kv,iwsc)
- integer, intent(in) :: kv,iwsc
+ subroutine make_dos_with_FDiracDistrib( kv, iwsc, kpt_weight )
+ integer, intent(in) :: kv, iwsc
+ real(kind=DP), intent(in) :: kpt_weight( kv )
integer :: i, ik, is, ie, id, ispin, iorb, iopr, lmt, iksnl
real(kind=DP) :: Es, e, Ene1, c1, c2, w, DeltaE
@@ -1031,7 +1038,8 @@ contains
do id = is, ie
ene1 = Es +id*DeltaE
call width_fermi_dirac( ene1, eko(i,ik), smearing_width_fdirac, c1, c2 )
- dos(id+1,ispin) = dos(id+1,ispin) + w *c1 *2.0d0 /dble(kv)
+!!! dos(id+1,ispin) = dos(id+1,ispin) + w *c1 *2.0d0 /dble(kv)
+ dos(id+1,ispin) = dos(id+1,ispin) + w *c1 *2.0d0 *kpt_weight(ik)
end do
if(iwsc == TOTAL .and. sw_pdos == ON) then
do iorb = 1,nlmta_phi
@@ -1062,7 +1070,8 @@ contains
call width_fermi_dirac( ene1, eko(i,ik), &
& smearing_width_fdirac, c1, c2 )
pdos(id+1,iorb,ispin) = pdos(id+1,iorb,ispin) &
- & + porb *w *c1 *2.0d0 /dble(kv)
+!!! & + porb *w *c1 *2.0d0 /dble(kv)
+ & + porb *w *c1 *2.0d0 *kpt_weight(ik)
end do
end do
end if
@@ -1404,7 +1413,7 @@ contains
if ( iproj_group(ia)== 0 ) return
! ---
- write(nf,'("PDOS: ia=",i0," l=",i3," m=",i3," t=",i3)') ia,il-1,im,tau
+ write(nf,'("PDOS: ia= ",i0," l=",i3," m=",i3," t=",i3)') ia,il-1,im,tau
write(nf,'(2x,A,5x,A,4x,A)') "No. E(eV)",&
& " dos_chg(eV) dos_mx(eV) dos_my(eV) dos_mz(eV)", &
@@ -1437,7 +1446,7 @@ contains
call alloc_eko_and_substitution(kv3) ! eko_l -> eko
call find_Erange(eko,neg,kv3)
call alloc_dos(1,icomponent)
- call make_dos_with_GaussianDistrib(kv3,icomponent)
+ call make_dos_with_GaussianDistrib( kv3, icomponent, qwgt )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) call write_dos(nfdos)
!!$ call write_dos(nfout)
@@ -1456,7 +1465,7 @@ contains
call find_Erange( eko, neg, kv3/ndim_spinor )
call alloc_dos(1,icomponent)
- call mkdos_with_GaussDistrib_noncl(kv3,icomponent)
+ call mkdos_with_GaussDistrib_noncl( kv3, icomponent, qwgt )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) then
@@ -1482,7 +1491,7 @@ contains
call alloc_eko_and_substitution_ek(kv3_ek) ! eko_ek -> eko
call find_Erange(eko,neg,kv3_ek)
call alloc_dos(1,icomponent)
- call make_dos_with_GaussianDistrib(kv3_ek,icomponent)
+ call make_dos_with_GaussianDistrib( kv3_ek, icomponent, qwgt_ek )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) call write_dos(nfdos)
call dealloc_eko()
@@ -1497,7 +1506,7 @@ contains
call find_Erange(eko,neg,kv3_ek/ndim_spinor)
call alloc_dos(1,icomponent)
- call mkdos_with_GaussDistrib_noncl(kv3_ek,icomponent)
+ call mkdos_with_GaussDistrib_noncl( kv3_ek, icomponent, qwgt_ek )
if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(mype == 0) then
@@ -1521,7 +1530,7 @@ contains
call find_Erange_fermidirac(eko,neg,kv3)
call alloc_dos(1,icomponent)
- call make_dos_with_FDiracDistrib(kv3,icomponent)
+ call make_dos_with_FDiracDistrib( kv3, icomponent, qwgt )
!!! if(icomponent == TOTAL) call get_VBM(totch,DeltaDVBM)
if(icomponent == TOTAL) then
@@ -1544,7 +1553,7 @@ contains
call find_Erange_fermidirac(eko,neg,kv3_ek)
call alloc_dos(1,icomponent)
- call make_dos_with_FDiracDistrib(kv3_ek,icomponent)
+ call make_dos_with_FDiracDistrib( kv3_ek, icomponent, qwgt_ek )
if(icomponent == TOTAL) then
ValenceBandMaximum = efermi
@@ -2190,7 +2199,7 @@ contains
& mpi_double_precision, mpi_sum, mpi_comm_group, ierr )
compr = compr_mpi; compi = compi_mpi
- norm_phig_mpi = norm_phig_mpi2
+ norm_phig_mpi = norm_phig_mpi2 / dble(nrank_e)
deallocate(compr_mpi,compi_mpi,norm_phig_mpi2)
end if
diff -uprN phase0_2015.01/src_phase_3d/m_Electronic_Structure.F90 phase0_2015.01.01/src_phase_3d/m_Electronic_Structure.F90
--- phase0_2015.01/src_phase_3d/m_Electronic_Structure.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Electronic_Structure.F90 2016-07-12 12:51:53.000000000 +0900
@@ -4533,7 +4533,7 @@ contains
else
#endif
__TIMER_SUB_START(304)
- call tstatc0_begin('m_ES_WF_in_Rspace_3D(1) ',id_sname)
+ call tstatc0_begin('m_ES_WF_in_Rspace_3D(1) ',id_sname,1)
if(ipri>=2 .and. ik==1 .and. ib1==1) write(nfout,'(" !### zaj_l --(FFT)--> bfft")')
diff -uprN phase0_2015.01/src_phase_3d/m_Epsilon_ek.F90 phase0_2015.01.01/src_phase_3d/m_Epsilon_ek.F90
--- phase0_2015.01/src_phase_3d/m_Epsilon_ek.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Epsilon_ek.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,7 +1,7 @@
#define NEC_TUNE
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 447 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 470 $)
!
! MODULE: m_Epsilon
!
@@ -32,7 +32,7 @@
! ================================================================
module m_Epsilon_ek
-! $Id: m_Epsilon_ek.F90 447 2015-08-05 02:38:25Z jkoga $
+! $Id: m_Epsilon_ek.F90 470 2015-10-05 03:15:15Z ktagami $
!
! Universal Virtual Spectroscope for Optoelectronics Research (UVSOR) ver 3.00
! UVSOR module for electronic dielectric function calculation
@@ -6994,14 +6994,23 @@ ppc_data(ntyp)
! set omega
if(nbi==nbj) then
omega = deg_omega ! -> intra_band case
+
+ else if(abs(omega) < 1.d-14) then ! -> degenerate case
+ if(omega >= 0.d0) then
+ omega = 1.d-14
+ else
+ omega = -1.d-14
+ end if
+! ====
else
- if(abs(omega) < 1.d-14) then ! -> degenerate case
- if(omega >= 0.d0) then
- omega = 1.d-14
+ if ( sw_scissor_renormalization == ON ) then
+ if ( omega > 0.0 ) then
+ omega = omega + scissor
else
- omega = -1.d-14
- end if
+ omega = omega - scissor
+ endif
end if
+! ====
end if
! add correction term
@@ -13046,6 +13055,16 @@ ppc_data(ntyp)
else
e21 = -delta_omega
end if
+! ==
+ else
+ if ( sw_scissor_renormalization == ON ) then
+ if ( e21 > 0.0 ) then
+ e21 = e21 + scissor
+ else
+ e21 = e21 - scissor
+ endif
+ endif
+! ==
end if
! ========================== 13.0R
end if
diff -uprN phase0_2015.01/src_phase_3d/m_Excitation.F90 phase0_2015.01.01/src_phase_3d/m_Excitation.F90
--- phase0_2015.01/src_phase_3d/m_Excitation.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Excitation.F90 2016-07-12 12:51:53.000000000 +0900
@@ -2439,7 +2439,7 @@ contains
deallocate( zrho_work ); deallocate( ztrm2 )
deallocate( eko_wk ); deallocate( occ_wk )
- SpectrFn_vv = SpectrFn_vv /dble(kv3_fbz) /univol
+ SpectrFn_vv = SpectrFn_vv /dble(kv3_fbz/nspin) /univol
if ( nspin == 1 ) SpectrFn_vv = SpectrFn_vv *2.0d0
#if 0
@@ -2653,7 +2653,7 @@ contains
endif
End Do
- SpectrTensor_vv = SpectrTensor_vv /dble(kv3_fbz) /univol
+ SpectrTensor_vv = SpectrTensor_vv /dble(kv3_fbz/nspin) /univol
if ( nspin == 1 ) SpectrTensor_vv = SpectrTensor_vv *2.0d0
#if 0
@@ -2821,7 +2821,7 @@ contains
deallocate( work )
endif
- SpectrFn_vc = SpectrFn_vc /dble(kv3_fbz) /univol
+ SpectrFn_vc = SpectrFn_vc /dble(kv3_fbz/nspin) /univol
if ( nspin == 1 ) SpectrFn_vc = SpectrFn_vc *2.0d0
#if 0
diff -uprN phase0_2015.01/src_phase_3d/m_FFT.F90 phase0_2015.01.01/src_phase_3d/m_FFT.F90
--- phase0_2015.01/src_phase_3d/m_FFT.F90 2015-09-14 15:39:20.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_FFT.F90 2016-07-12 12:51:53.000000000 +0900
@@ -3,7 +3,7 @@
! ==============================================================================
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 449 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 481 $)
!
! MODULE: m_FFT
!
@@ -39,7 +39,7 @@
!
module m_FFT
-! $Id: m_FFT.F90 449 2015-08-06 04:37:59Z jkoga $
+! $Id: m_FFT.F90 481 2016-03-25 02:51:57Z jkoga $
!
use m_Timing, only : tstatc0_begin, tstatc0_end
use m_Files, only : nfout
@@ -925,6 +925,226 @@ include "m_FFT_type9_ffte.F90"
if(mod(nfft_pstrn,2) == 1) bfft(nfft_pstrn) = afft(nfft_pstrn)*bfft(nfft_pstrn)
end subroutine m_FFT_Vlocal_pW
+! === EXP_CELLOPT ==== 2015/09/24
+ subroutine m_FFT_coef_CD_integration_kt(ista,iend,f2or1)
+ ! from m_XC_Potential.F90, for electron ?
+ integer, intent(in) :: ista, iend
+ real(kind=DP),intent(out) :: f2or1( ista:iend )
+
+ integer :: idp,nlp,nmp,nnp,nd2p,nd3p,ip, idph, nlph
+
+ nlp = fft_box_size_CD(1,1)
+ nmp = fft_box_size_CD(2,1)
+ nnp = fft_box_size_CD(3,1)
+#ifdef _MPIFFT_
+ idp = fft_box_size_CD_c(1,0)
+ nd2p = fft_box_size_CD_c(2,0)
+ nd3p = fft_box_size_CD_c(3,0)
+#else
+ idp = fft_box_size_CD(1,0)
+ nd2p = fft_box_size_CD(2,0)
+ nd3p = fft_box_size_CD(3,0)
+#endif
+
+ call set_f2or1( npes, ista, iend, f2or1 )
+
+ contains
+
+ subroutine set_f2or1(npes,ista,iend,f2or1)
+ integer, intent(in) :: npes,ista, iend
+ real(kind=DP), intent(out), dimension(ista:iend) :: f2or1
+ integer :: idph,nlph,ip,i,j,k
+
+ if(kimg == 1) then
+ idph = idp/2
+ nlph = nlp/2
+#ifdef _MPIFFT_
+
+ f2or1 = 0.d0
+!!$ do j = 1, min(nz_d,nnp-nz_d*myrank_cdfft)*nmp
+!!$ do j = 1, min(nz_d,nnp-nz_d*myrank_cdfft)*nd2p
+ do k = 1, min(nz_d, nnp-nz_d*myrank_cdfft)
+ do j = 1, nmp
+ do i = 1, nlph
+!!$ ip = i + idph*(j-1) + idph*ly*lz_d*myrank_cdfft
+ ip = i + idph*(j-1) + idph*ly*(k-1) + idph*ly*lz_d*myrank_cdfft
+ f2or1(ip) = 2.d0
+ end do
+ ip = 1 + idph*(j-1) + idph*ly*(k-1) + idph*ly*lz_d*myrank_cdfft
+ f2or1(ip) = 1.d0
+ ip = nlph+1 + idph*(j-1) + idph*ly*(k-1) + idph*ly*lz_d*myrank_cdfft
+ f2or1(ip) = 1.d0
+ end do
+ end do
+!!$ ip = idph*(j-1) + 1 + idph*ly*lz_d*myrank_cdfft
+!!$ f2or1(ip) = 1.d0
+!!$ ip = idph*(j-1)+ nlph + 1 + idph*ly*lz_d*myrank_cdfft
+!!$ f2or1(ip) = 1.d0
+!!$ end do
+#else
+ f2or1 = 2.d0
+ if(npes >= 2) then
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + 1
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 1.d0
+ end do
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + nlph + 1
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 1.d0
+ end do
+ do j = nlph+2, idph
+ do i = 1,nd2p*nnp
+ ip = idph*(i-1)+j
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ do j = nmp+1, nd2p
+ do k = 1, nnp
+ do i = 1, nlph
+ ip = i + idph*(j-1) + idph*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p
+ do i = 1, idph*nd2p
+ ip = i + idph*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ else
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + 1
+ f2or1(ip) = 1.d0
+ end do
+ do i = 1, nd2p*nnp
+ ip = idph*(i-1) + nlph + 1
+ f2or1(ip) = 1.d0
+ end do
+ do j = nlph+2, idph
+ do i = 1,nd2p*nnp
+ ip = idph*(i-1)+j
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ do j = nmp+1, nd2p
+ do k = 1, nnp
+ do i = 1, nlph
+ ip = i + idph*(j-1) + idph*nd2p*(k-1)
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p
+ do i = 1, idph*nd2p
+ ip = i + idph*nd2p*(k-1)
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ end if
+!!$ do i = ista, iend
+!!$ if(mod(i*2,idp) == 2 .or. mod(i*2,idp) == 0) f2or1(i) = 1.d0
+!!$ end do
+#endif
+ else
+#ifdef _MPIFFT_
+!!$ f2or1 = 0.d0 ! f2or1 works to the fft data in Rspace.
+!!$ do k = 1, min(nz_d,nnp-nz_d*myrank_cdfft)
+!!$ do j = 1, nmp ! nmp = fft_box_size_CD(2,1)
+!!$ do i = 1, nlp ! nlp = fft_box_size_CD(1,1)
+!!$ ip = i+(j-1)*idp+(k-1)*idp*nd2p+idp*nd2p*lz_d*myrank_cdfft
+!!$ f2or1(ip) = 1.d0
+!!$ end do
+!!$ end do
+!!$ end do
+! if(iprixc >= 2 ) write(nfout,'(" ix kimg = 2 <<set_f2or1>>")')
+ f2or1 = 1.d0
+ do j = nlp+1, idp ! x
+ do i = 1, ly*nz_d
+ ip = idp*(i-1)+j+ista-1
+ f2or1(ip) = 0.d0
+ end do
+ end do
+! if(iprixc >= 2 ) write(nfout,'(" iy kimg = 2 <<set_f2or1>>")')
+ do j = nmp+1,ly ! y
+ do k = 1, nz_d
+ do i = 1, nlp
+ ip = i + idp*(j-1) + idp*ly*(k-1) + ista-1
+ f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! if(iprixc >= 2 ) write(nfout,'(" iz kimg = 2 <<set_f2or1>>")')
+ do k = nz_d+1, lz_d ! z
+ do i = 1, idp*ly
+ ip = i + idp*ly*(k-1) + ista-1
+ f2or1(ip) = 0.d0
+ end do
+ end do
+#else
+ f2or1 = 1.d0
+ if(npes >= 2) then
+ do j = nlp+1, idp ! x
+ do i = 1, nd2p*nnp
+ ip = idp*(i-1)+j
+ if(ip>= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ do j = nmp+1, nd2p ! y
+ do k = 1, nnp
+ do i = 1, nlp
+ ip = i + idp*(j-1) + idp*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p ! z
+ do i = 1, idp*nd2p
+ ip = i + idp*nd2p*(k-1)
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+ end do
+ end do
+ else
+ do j = nlp+1, idp ! x
+ do i = 1, nd2p*nnp
+ ip = idp*(i-1)+j
+! ================================ modifed by K. Tagami ====( uncertain )== 11.0
+! f2or1(ip) = 0.d0
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+! ===================================================================== 11.0
+ end do
+ end do
+ do j = nmp+1, nd2p ! y
+ do k = 1, nnp
+ do i = 1, nlp
+ ip = i + idp*(j-1) + idp*nd2p*(k-1)
+! ================================ modifed by K. Tagami ====( uncertain )== 11.0
+! f2or1(ip) = 0.d0
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+! ===================================================================== 11.0
+ end do
+ end do
+ end do
+! for SX6 ASL 20040817
+ do k = nnp+1, nd3p ! z
+ do i = 1, idp*nd2p
+ ip = i + idp*nd2p*(k-1)
+! ================================ modifed by K. Tagami ====( uncertain )== 11.0
+! f2or1(ip) = 0.d0
+ if(ip >= ista .and. ip <= iend) f2or1(ip) = 0.d0
+! ===================================================================== 11.0
+ end do
+ end do
+ end if
+#endif
+ end if
+ end subroutine set_f2or1
+ end subroutine m_FFT_coef_CD_integration_kt
+! ==================== 2015/09/24
+
subroutine m_FFT_coef_CD_integration(f2or1)
real(kind=DP),intent(out), dimension(ista_sfftph:iend_sfftph) :: f2or1
integer :: idp, nlp, nmp, nnp, nd2p, idph, nlph, ip, i, j, k
@@ -1182,6 +1402,31 @@ include "m_FFT_type9_ffte.F90"
call tstatc0_end(id_sname)
end subroutine m_FFT_CD0
+ subroutine m_FFT_CD0_exx(nfout,afftp,inverse_or_direct) ! R space --> G space
+ integer, intent(in) :: nfout, inverse_or_direct
+ real(kind=DP), intent(inout) :: afftp(nfftp_exx_nonpara)
+ integer :: id_sname = -1
+ integer, dimension(2) :: flag_mklfft = (/-1, 1/)
+#if defined(JRCATFFT_WS) || defined(FFTW3)
+ if(ipri >= 2) write(nfout,'(" <<m_FFT_CD0_exx>>")')
+ call tstatc0_begin('m_FFT_CD0_exx ', id_sname, 1)
+ if(CD_setup_is_done_exx == NO) then
+#ifdef _INCLUDE_EXX_
+ if(ipri >= 1) write(nfout,'(" <<CDFFT_setup_exx>>")')
+ call CDFFT_setup_exx()
+#endif
+ end if
+ if(inverse_or_direct == DIRECT) then
+ call fft_CD_direct_core_exx(afftp)
+ else if(inverse_or_direct == INVERSE) then
+ call fft_CD_inverse_core_exx(afftp)
+ end if
+
+ call tstatc0_end(id_sname)
+#else
+ stop 'EXX in rspace can only be used with JRCAT FFT or FFTW3'
+#endif
+ end subroutine m_FFT_CD0_exx
diff -uprN phase0_2015.01/src_phase_3d/m_Files.F90 phase0_2015.01.01/src_phase_3d/m_Files.F90
--- phase0_2015.01/src_phase_3d/m_Files.F90 2015-09-14 15:39:27.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Files.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! SOFTWARE NAME : PHASE ($Revision: 454 $)
+! SOFTWARE NAME : PHASE ($Revision: 483 $)
!
! MODULE: m_Files
!
@@ -36,7 +36,7 @@
!
!
module m_Files
-! $Id: m_Files.F90 454 2015-09-07 07:58:39Z yamasaki $
+! $Id: m_Files.F90 483 2016-04-27 04:02:48Z ktagami $
!
! Operations concerning to files as "open", and "close",
! should be done in this module.
@@ -103,7 +103,9 @@ module m_Files
! ===================================== 13.0S
&, nfdynm_cif & ! CIF output
&, nfwfk_sq & ! squared wf
- &, nfwfk_integ_mom ! moment of wf ( integerated over space )
+ &, nfwfk_integ_mom & ! moment of wf ( integerated over space )
+ &, nfwfk_orb_proj & ! orbital-projection of wf
+ &, nfband_spectr_wght ! spectral weight for band unfolding
data &
& nfinp,nfpot & ! 31,(37,38,39,40,45,46,11-19,36)
@@ -140,6 +142,8 @@ module m_Files
& ,nfdynm_cif &
& ,nfwfk_sq &
& ,nfwfk_integ_mom &
+ & ,nfwfk_orb_proj &
+ & ,nfband_spectr_wght &
& /31,37,38,39,40,45,46 &
& ,11,12,13,14,15,16,17,18,19,36 &
@@ -169,9 +173,11 @@ module m_Files
! ================================== 13.0S
&, 500 &
&, 350 &
- &, 351 /
+ &, 351 &
+ &, 352 &
+ &, 345 /
- integer,private,parameter :: number_of_all_files = 76 + MAXNSP
+ integer,private,parameter :: number_of_all_files = 78 + MAXNSP
integer,private, dimension(number_of_all_files) :: n_file
data n_file &
@@ -202,7 +208,7 @@ module m_Files
! ================= KT_add ======== 13.0S
& ,370, 371, 372 &
! ================================= 13.0S
- & ,500, 350, 351 /
+ & ,500, 350, 351, 352, 345 /
integer,private,parameter :: stringlength_of_filenames = 260
character(len=stringlength_of_filenames) :: &
@@ -238,7 +244,8 @@ module m_Files
! ================= KT_add ====== 13.0S
&, F_CORE_ENERGY_OUT, F_CORE_ENERGY_INITIAL, F_CORE_ENERGY_FINAL &
! =============================== 13.0S
- &, F_DYNM_CIF, F_WFk_Squared, F_WFk_IntegMoment
+ &, F_DYNM_CIF, F_WFk_Squared, F_WFk_IntegMoment &
+ &, F_WFK_ORB_PROJ, F_BAND_SPECTR_WGHT
namelist/fnames/ &
& F_INP, F_POT, F_PKB, F_PD, F_PPC, F_STOP, F_OPGR &
@@ -272,7 +279,8 @@ module m_Files
! ================= KT_add ====== 13.0S
&, F_CORE_ENERGY_OUT, F_CORE_ENERGY_INITIAL, F_CORE_ENERGY_FINAL &
! =============================== 13.0S
- &, F_DYNM_CIF, F_WFk_Squared, F_Wfk_IntegMoment
+ &, F_DYNM_CIF, F_WFk_Squared, F_Wfk_IntegMoment &
+ &, F_WFK_ORB_PROJ, F_BAND_SPECTR_WGHT
logical :: F_ZAJ_partitioned = .false.
@@ -594,6 +602,12 @@ contains
if(mype==0) close(nfcntn_berry)
end subroutine m_Files_close_nfcntn_berry
+ logical function m_Files_nfcntn_bin_paw_exists()
+ logical :: ex
+ inquire(file=F_CNTN_BIN_PAW,exist=ex)
+ m_Files_nfcntn_bin_paw_exists = ex
+ end function m_Files_nfcntn_bin_paw_exists
+
subroutine m_Files_open_nfcntn_bin_paw
logical open
inquire(unit = nfcntn_bin_paw, opened = open)
@@ -890,6 +904,9 @@ contains
F_WFk_Squared = "./wfnsq.cube"
F_WFk_IntegMoment = "./wfn_integ_moment.data"
+ F_WFK_ORB_PROJ = "./wfn_orb_proj.data"
+
+ F_BAND_SPECTR_WGHT = "./nfband_spectr_wght.data"
end subroutine m_Files_set_default_filenames
@@ -1582,6 +1599,76 @@ contains
end if
end subroutine m_Files_close_nfeng
+! ===
+ subroutine m_Files_open_nfwfk_orb_proj(icond)
+ integer, intent(in) :: icond
+ logical :: open
+
+ if (mype==0) then
+ inquire(unit = nfwfk_orb_proj, opened = open)
+
+ if (open) close(nfwfk_orb_proj)
+
+ if (icond == FIXED_CHARGE .or. &
+ & (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ALL_AT_ONCE)) then
+ call open0( nfwfk_orb_proj, F_WFK_ORB_PROJ, 'F_WFK_ORB_PROJ',&
+ & unknown, formatted, check_file_name_on )
+ else if (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ONE_BY_ONE) then
+ call open1( nfwfk_orb_proj, F_WFK_ORB_PROJ, 'F_WFK_ORB_PROJ', &
+ & unknown,formatted, check_file_name_on )
+ else
+ call open1( nfwfk_orb_proj, F_WFK_ORB_PROJ, 'F_WFK_ORB_PROJ', &
+ & unknown,formatted, check_file_name_on )
+ end if
+ end if
+ end subroutine m_Files_open_nfwfk_orb_proj
+
+ subroutine m_Files_close_nfwfk_orb_proj()
+ logical :: open
+
+ if (mype==0) then
+ inquire( unit=nfwfk_orb_proj, opened = open )
+ if(open) close( nfwfk_orb_proj )
+ end if
+ end subroutine m_Files_close_nfwfk_orb_proj
+
+ subroutine m_Files_open_nfband_spwt(icond)
+ integer, intent(in) :: icond
+ logical :: open
+
+ if (mype==0) then
+ inquire(unit = nfband_spectr_wght, opened = open)
+
+ if (open) close(nfband_spectr_wght)
+
+ if (icond == FIXED_CHARGE .or. &
+ & (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ALL_AT_ONCE)) then
+ call open0( nfband_spectr_wght, F_BAND_SPECTR_WGHT, 'F_BAND_SPECTR_WGHT',&
+ & unknown, formatted, check_file_name_on )
+ else if (icond==FIXED_CHARGE_CONTINUATION &
+ & .and. fixed_charge_k_parallel==ONE_BY_ONE) then
+ call open1( nfband_spectr_wght, F_BAND_SPECTR_WGHT, 'F_BAND_SPECTR_WGHT ', &
+ & unknown,formatted, check_file_name_on )
+ else
+ call open1( nfband_spectr_wght, F_BAND_SPECTR_WGHT, 'F_BAND_SPECTR_WGHT', &
+ & unknown,formatted, check_file_name_on )
+ end if
+ end if
+ end subroutine m_Files_open_nfband_spwt
+
+ subroutine m_Files_close_nfband_spwt()
+ logical :: open
+
+ if (mype==0) then
+ inquire( unit=nfband_spectr_wght, opened = open )
+ if(open) close( nfband_spectr_wght )
+ end if
+ end subroutine m_Files_close_nfband_spwt
+! ====
+
subroutine m_Files_close_nfinp()
logical :: op
if(mype == 0) then
diff -uprN phase0_2015.01/src_phase_3d/m_Force.F90 phase0_2015.01.01/src_phase_3d/m_Force.F90
--- phase0_2015.01/src_phase_3d/m_Force.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Force.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_Force
!
@@ -49,7 +49,7 @@
#endif
module m_Force
-! $Id: m_Force.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Force.F90 472 2015-11-28 09:01:17Z ktagami $
use m_IterationNumbers, only : iteration_ionic
use m_Charge_Density, only : chgq_l, hsr
use m_Electronic_Structure, only : zaj_l,vlhxcQ,occup_l,eko_l &
@@ -117,6 +117,12 @@ module m_Force
use m_FFT, only : fft_box_size_CD,nfftps
+! === Positron ==== 2015/11/28
+ use m_Control_Parameters, only : sw_positron, positron_method
+ use m_Const_Parameters, only : Positron_GGGC, OFF
+ use m_Positron_Wave_Functions, only : pchg_l
+! ================= 2015/11/28
+
implicit none
include 'mpif.h'
diff -uprN phase0_2015.01/src_phase_3d/m_Ionic_System.F90 phase0_2015.01.01/src_phase_3d/m_Ionic_System.F90
--- phase0_2015.01/src_phase_3d/m_Ionic_System.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Ionic_System.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 442 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 490 $)
!
! MODULE: m_Ionic_System
!
@@ -53,7 +53,7 @@
module m_Ionic_System
! (m_IS)
-! $Id: m_Ionic_System.F90 442 2015-08-03 08:52:00Z jkoga $
+! $Id: m_Ionic_System.F90 490 2016-05-27 04:49:30Z jkoga $
!
! This module is for structure factor, ewald energy,
! and motions of atoms.
@@ -297,6 +297,7 @@ module m_Ionic_System
integer :: nrsv = 1 ! number of heat bath
integer :: set_initial_velocity = ON ! (by J. Koga)
integer :: sw_read_velocities = OFF ! (by T. Yamamoto)
+ integer :: sw_shift_velocities = OFF
real(kind=DP),private :: tk_initial = 0.d0
!!$ real(kind=DP),private,allocatable,dimension(:) :: qmass,tkb,cprv,frsv ! d(nrsv)
real(kind=DP),allocatable,dimension(:) :: qmass,tkb,cprv,frsv ! d(nrsv)
@@ -360,6 +361,7 @@ module m_Ionic_System
character(len("set_initial_velocity")),private,parameter :: tag_set_initial_velocity = "set_initial_velocity" ! (by J. Koga)
character(len("sw_read_velocities")),private,parameter :: tag_sw_read_velocities = "sw_read_velocities"
character(len("initial_temperature")),private,parameter :: tag_initial_temperature = "initial_temperature"
+ character(len("sw_shift_velocities")),private,parameter :: tag_sw_shift_velocities = "sw_shift_velocities"
! constraint sigma sgmc
! 1. BONDLENGTH_FIX_1
@@ -838,7 +840,10 @@ contains
end subroutine m_IS_put_lattice_system
subroutine alloc_normal_hypervector()
- allocate(normal_hypervector(natm,3,PUCV:CARTS))
+ if ( .not. allocated(normal_hypervector) ) then
+ allocate(normal_hypervector(natm,3,PUCV:CARTS))
+ endif
+ normal_hypervector = 0.0d0
end subroutine alloc_normal_hypervector
subroutine set_normal_hypervector()
@@ -1075,7 +1080,11 @@ contains
deallocate(work)
+ constraints_exist = .false.
+
! --- constraint ---
+ call initialize_constraint_param ! use this for cell optimization
+
if( f_selectBlock( tag_constraint) == 0) then
if(ipriinputfile >= 1) write(nfout,'(" !** -- tag_constraint is found --")')
if(imdalg == CG_STROPT) then
@@ -1116,7 +1125,7 @@ contains
iret = f_selectParentBlock()
end if
! --- setting bondlength fix sets ---
- call alloc_bondlength_fix_set() ! allocate(bondlength_fix_set(2,num_fixed_bonds))
+ if (tf) call alloc_bondlength_fix_set() ! allocate(bondlength_fix_set(2,num_fixed_bonds))
tf = f_selectBlock( tag_fixed_bond) == 0
if(.not.tf) tf = f_selectBlock( tag_fix_bondlength) == 0
if(.not.tf) tf = f_selectBlock( tag_bondlength_fix) == 0
@@ -1759,7 +1768,9 @@ contains
if ( f_getIntValue(tag_sw_read_velocities,iret) == 0 ) then
sw_read_velocities = iret
endif
-
+ if ( f_getIntValue(tag_sw_shift_velocities,iret) == 0 ) then
+ sw_shift_velocities = iret
+ endif
if( f_getRealValue(tag_initial_temperature,dret,"") == 0 ) then
tk_initial = dret * CONST_kB
if(ipriinputfile >= 1 .and. printable) then
@@ -4379,7 +4390,8 @@ contains
pcom(i) = 0.d0
do ia=1,natm
ir = icnstrnt_typ(imdt(ia),imdalg_t)
- if ((imode == 1 .and. ir >= 1 .and. imdtyp(ia).ne.0).or.(imode==2 .and. ir == 1.and.imdtyp(ia).ne.0)) then
+ if ((imode == 1 .and. ir >= 1 .and. imdtyp(ia).ne.0).or. &
+ & (imode == 2 .and. ir == 1 .and. imdtyp(ia).ne.0)) then
cpd_l(ia,i) = random(ir,ia,i)
if(iprimd >= 2) write(nfout,'(" !!! ia, ir = ",2i8," cpd_l(ia,",i3,") = " &
& ,f12.6, " <<set_initial_velocities>>")') ia, ir, i, cpd_l(ia,i)
@@ -4509,6 +4521,79 @@ contains
end subroutine m_IS_rd_n
+ subroutine shift_velocities(imode)
+ integer, intent(in) :: imode
+ integer :: i,j,ia,ir
+ real(kind=DP) :: mcom
+ integer,dimension(natm) :: imdt
+ integer :: icnstrnt_typ
+ integer :: imdalg_t
+ real(kind=DP),dimension(3) :: pcom
+ real(kind=DP), parameter :: eps = 1.d-12
+ if(imode == 1) then
+ do i=1,natm
+ if ( imdtyp(i) .le. NOSE_HOOVER ) then
+ imdt(i) = NOSE_HOOVER + 1
+ else
+ imdt(i) = imdtyp(i)
+ endif
+ enddo
+ imdalg_t = T_CONTROL
+ else
+ do i=1, natm
+ imdt(i) = imdtyp(i)
+ end do
+ imdalg_t = VERLET
+ end if
+
+ do i=1,3
+ pcom(i) = 0.d0
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ((imode == 1 .and. ir >= 1 .and. imdtyp(ia).ne.0).or. &
+ & (imode == 2 .and. ir == 1 .and. imdtyp(ia).ne.0)) then
+ pcom(i) = pcom(i) + amion(ityp(ia))*cpd_l(ia,i)
+ endif
+ enddo
+ enddo
+
+ mcom = 0.d0
+ if(imode == 1) then
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir >= 1 .and. imdtyp(ia).ne.0 ) then
+ mcom = mcom + amion(ityp(ia))
+ end if
+ end do
+ else
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir == 1 .and. imdtyp(ia).ne.0 ) then
+ mcom = mcom + amion(ityp(ia))
+ end if
+ end do
+ end if
+
+ ! shift velocity
+ if(mcom.gt.eps) pcom(:) = pcom(:)/mcom
+
+ if(imode == 1) then
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir >= 1 .and. imdtyp(ia).ne.0 ) then
+ cpd_l(ia,:) = cpd_l(ia,:) - pcom(:)
+ endif
+ enddo
+ else
+ do ia=1,natm
+ ir = icnstrnt_typ(imdt(ia),imdalg_t)
+ if ( ir == 1 .and. imdtyp(ia).ne.0 ) then
+ cpd_l(ia,:) = cpd_l(ia,:) - pcom(:)
+ endif
+ enddo
+ end if
+ end subroutine shift_velocities
+
!!$ 2011.06.06
subroutine scale_velocity()
integer :: ia,ir,irp
@@ -5642,6 +5727,7 @@ contains
stop ' Invalid value of mdmode <<m_IS_md>>'
end if
+ if (sw_shift_velocities==ON.and.mdalg==VERLET) call shift_velocities(1)
deallocate(forc_l)
call md1_dealloc()
call tstatc0_end(id_sname)
@@ -6348,6 +6434,12 @@ contains
end function m_IS_force_check_md_nhp
! <--
+ subroutine initialize_constraint_param
+ forcmx_constraint_quench = 1.d+2
+ forc_norm_hyperplane_vert = 1.d+2
+ forcmx_hyperplane_vert = 1.d+2
+ end subroutine initialize_constraint_param
+
subroutine evolve_velocities(mdalg,forc_l)
integer, intent(in) :: mdalg
real(kind=DP), intent(inout), dimension(natm,3) :: forc_l
@@ -7312,7 +7404,7 @@ contains
if(t_ctrl_method == VELOCITY_SCALING)then
call scale_velocity()
endif
-
+ if (sw_shift_velocities==ON) call shift_velocities(1)
call md2_dealloc !-(m_Ionic_System)
call tstatc0_end(id_sname)
contains
@@ -7900,6 +7992,10 @@ contains
integer :: id_sname = -1
call tstatc0_begin('m_IS_gdiis ',id_sname)
+ if(absolute_convergence_of_forc(forc_l_in))then
+ write(nfout,'(a)') ' m_IS_gdiis: forces are absolutely converged!! nothing to do...'
+ return
+ endif
if(mdmode == ORDINA) then
allocate(forc_l(natm,3))
@@ -9090,6 +9186,10 @@ contains
integer :: id_sname = -1
call tstatc0_begin('m_IS_cg2',id_sname)
+ if(absolute_convergence_of_forc(forc_l_in))then
+ write(nfout,'(a)') ' CG2: forces are absolutely converged!! nothing to do...'
+ return
+ endif
if(.not.allocated(vec_g)) allocate(vec_g(natm,3))
if(.not.allocated(vec_h)) allocate(vec_h(natm,3))
@@ -9099,6 +9199,7 @@ contains
if(.not.allocated(cps2)) allocate(cps2(natm,3))
if(.not.allocated(f_total2)) allocate(f_total2(natm,3))
+
f_total0(:,:) = forc_l_in(:,:)
@@ -9950,6 +10051,80 @@ contains
#endif
end subroutine m_IS_symmetrize_atom_pos
+ subroutine m_IS_force_af_symmetry(nfout)
+#ifdef SX
+!CDIR BEGIN NOVECTOR
+#endif
+ integer, intent(in) :: nfout
+
+ real(kind=DP), dimension(natm2,3) :: cps_wk,cps_wk2
+ real(kind=DP), dimension(natm,3) :: cpso,poso
+ real(kind=DP), dimension(3,3) :: rltv_t
+ real(kind=DP), dimension(3) :: p,di,dimin
+ real(kind=DP) :: df,dfmin
+ integer, dimension(natm2) :: ityp_wk,ityp_af
+ integer :: i,n,ia,ja,iia
+ cps_wk(1:natm,1:3) = cps(1:natm,1:3)
+ do i=1,natm
+ ityp_af(i) = nint(iatomn(ityp(i)))
+ end do
+ n = natm
+ do i=1,natm
+ if(iwei(i)==1) cycle
+ n = n + 1
+ cps_wk(n,1:3) = -cps(i,1:3)
+ ityp_af(n) = nint(iatomn(ityp(i)))
+ end do
+ cps_wk2 = 0.d0
+ do ia=1,natm2
+ p = matmul(op(1:3,1:3,nopr+af),cps_wk(ia,1:3)) + tau(1:3,nopr+af,CARTS)
+ iia = 0
+ dfmin = 1.d10
+ do ja=1,natm2
+ if(ityp_af(ia) /= ityp_af(ja)) cycle
+ di = matmul(transpose(rltv),(p - cps_wk(ja,1:3)))
+ df = sum(abs(cos(di(1:3))-1.d0))
+ if(df < dfmin) then
+ iia = ja
+ dfmin = df
+ dimin = di/PAI2
+ end if
+ end do
+ if(iia == 0) stop 'm_IS_symmetrize_atom_pos: error iia=0'
+ p = p - matmul(altv,nint(dimin))
+ cps_wk2(iia,1:3) = cps_wk2(iia,1:3) + p(1:3)
+ cps_wk(iia,1:3) = cps_wk2(iia,1:3)
+ end do
+
+ cpso = cps
+ poso = pos
+ cps = cps_wk2(1:natm,1:3)
+ rltv_t = transpose(rltv)/PAI2
+ call change_of_coordinate_system(rltv_t,cps,natm,natm,pos) !-(b_I.S.) cps -> pos
+ if(printable.and.ipri>1) then
+ write(nfout,*) 'Atomic coordinates were symmetrized.'
+ !!$write(nfout,'(20x,"Inputted Cartesian coordinate -> symmetrized Cartesian coordinate")')
+ !!$do ia=1,natm
+ !!$ write(nfout,'(i4,3f15.8," -> ",3f15.8)') ia,cpso(ia,1:3),cps(ia,1:3)
+ !!$end do
+ !!$write(nfout,'(20x,"Inputted internal coordinate -> symmetrized internal coordinate")')
+ !!$do ia=1,natm
+ !!$ write(nfout,'(i4,3f15.8," -> ",3f15.8)') ia,poso(ia,1:3),pos(ia,1:3)
+ !!$end do
+ write(nfout,'(" === Symmetrized Cartesian coordinates and errors===")')
+ do ia=1,natm
+ write(nfout,'(i4,7f18.9)') ia,cpso(ia,1:3),cps(ia,1:3),sqrt(sum((cps(ia,1:3)-cpso(ia,1:3))**2))
+ end do
+ write(nfout,'(" === Symmetrized internal coordinates ===")')
+ do ia=1,natm
+ write(nfout,'(i4,6f18.9)') ia,poso(ia,1:3),pos(ia,1:3)
+ end do
+ end if
+#ifdef SX
+!CDIR END
+#endif
+ end subroutine m_IS_force_af_symmetry
+
subroutine m_IS_dealloc(neb_mode)
logical, intent(in), optional :: neb_mode
logical :: neb
@@ -11535,4 +11710,19 @@ contains
deallocate(pos_full)
end subroutine m_IS_dump_cif
+ logical function absolute_convergence_of_forc(forc_l_in)
+ real(kind=DP), intent(in), dimension(natm,3) :: forc_l_in
+ real(kind=DP),allocatable,dimension(:,:) :: forct
+ integer :: ia
+ allocate(forct(natm,3));forct=forc_l_in
+ absolute_convergence_of_forc = .false.
+ do ia=1,natm
+ if(imdtyp(ia)==0) forct(ia,:)=0.d0
+ enddo
+ if(sum(forct(1:natm,1:3)**2).lt.1e-15)then
+ absolute_convergence_of_forc = .true.
+ endif
+ deallocate(forct)
+ end function absolute_convergence_of_forc
+
end module m_Ionic_System
diff -uprN phase0_2015.01/src_phase_3d/m_Kpoints.F90 phase0_2015.01.01/src_phase_3d/m_Kpoints.F90
--- phase0_2015.01/src_phase_3d/m_Kpoints.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Kpoints.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 486 $)
!
! MODULE: m_Kpoint
!
@@ -37,7 +37,7 @@
!
module m_Kpoints
! (m_Kp)
-! $Id: m_Kpoints.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Kpoints.F90 486 2016-05-15 13:59:14Z ktagami $
!
use m_Crystal_Structure, only : il,imag,inv,ngen,igen,jgen, a,b,c,ca,cb,cc &
& , altv, rltv, nbztyp , nbztyp_spg, n1_sc, n2_sc, n3_sc
@@ -237,7 +237,7 @@ contains
end if
end if
if(npes > 1) call mpi_bcast(kv3_previous,1,mpi_integer,0,mpi_comm_group,ierr)
- if(printable) write(nfout,'(i5, " : kv3_previous_job")') kv3_previous
+ if(printable) write(nfout,'(i8, " : kv3_previous_job")') kv3_previous
end subroutine m_Kp_rd_kv3
subroutine m_Kp_rd_n(nfout)
@@ -560,7 +560,7 @@ contains
allocate(vkxyz(kv3,3,CRDTYP)); vkxyz = 0.d0
if(ipri_kp >= 2) then
write(nfout,'(" !kp vkxyz is allocated now <<m_Kp_alloc_kpoints>>")')
- write(nfout,'(" !kp kv3 = ", i5," CRDTYP = ",i3)') kv3,CRDTYP
+ write(nfout,'(" !kp kv3 = ", i8," CRDTYP = ",i3)') kv3,CRDTYP
end if
else
if(ipri_kp >= 2) write(nfout,'(" !kp vkxyz is already allocated <<m_Kp_alloc_kpoints>>")')
@@ -692,9 +692,9 @@ contains
! ================================================================ 11.0
if(ipri_kp >=1 ) then
- write(nfout,'(" !kp ek_group = ",i5)') ek_group
- write(nfout,'(" !kp kv3_ek = ",i5)') kv3_ek
- write(nfout,'(" !kp kv3 = ",i5)') kv3
+ write(nfout,'(" !kp ek_group = ",i8)') ek_group
+ write(nfout,'(" !kp kv3_ek = ",i8)') kv3_ek
+ write(nfout,'(" !kp kv3 = ",i8)') kv3
end if
end subroutine m_Kp_set_ek_group
@@ -783,7 +783,7 @@ contains
read(nfinp,'(a132)') str
if(ipri_kp>=2) write(nfout,'(" ! str : ",a50)') str(1:50)
call read_nkpnt(str,len_str,ikpnt) !-(b_Kpoints)
- if(ipri_kp>=2) write(nfout,'(" ! ikpnt(#skipped lines) = ",i5)') ikpnt
+ if(ipri_kp>=2) write(nfout,'(" ! ikpnt(#skipped lines) = ",i8)') ikpnt
read(nfinp,'(a132)') str
call read_coordsystem(str,len_str,sw_k_coord_system) !-(b_Kpoints)
if(sw_k_coord_system == NODATA) ikpnt = ikpnt - 1
@@ -976,7 +976,7 @@ contains
! =============== 2014/09/30
else
- if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i5, " nspin = ", i5)') kv3,nspin
+ if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i8, " nspin = ", i5)') kv3,nspin
! ======================= added by K. Tagami ================== 11.0
if(ipri_kp>=1) write(nfout,*) 'ndim_spinor = ', ndim_spinor
@@ -1794,7 +1794,7 @@ contains
call first_bz(b1,b2,b3,nkmesh,kmesh,nmp_kmesh,mp_kmesh,nface,face)
if(printable .and. printlevel .ge. 0) &
- & write(output,'(1x,"number of k-points in MP mesh = ",i5)') nmp_kmesh
+ & write(output,'(1x,"number of k-points in MP mesh = ",i8)') nmp_kmesh
! debug
!do i=1,nmp_kmesh
@@ -1826,7 +1826,7 @@ contains
call first_bz(b1,b2,b3,nkmesh,kmesh,nfbz_kmesh,fbz_kmesh,nface,face)
if(printable .and. printlevel .ge. 0) &
- & write(output,'(1x,"number of k-points in full BZ = ",i5)') nfbz_kmesh
+ & write(output,'(1x,"number of k-points in full BZ = ",i8)') nfbz_kmesh
! debug
!do i=1,nfbz_kmesh
@@ -2272,7 +2272,8 @@ contains
integer :: i,j,n
integer :: nequiv(nkpmax)
real(kind=DP) :: g(3),q(3)
- real(kind=DP), parameter :: eps = 1.d-3
+! real(kind=DP), parameter :: eps = 1.d-3
+ real(kind=DP), parameter :: eps = 1.d-5
logical :: not_included(nfbz_kmesh)
not_included(1:nfbz_kmesh) = .true.
@@ -2334,7 +2335,8 @@ contains
integer :: i,j,n
integer :: nequiv(nkpmax)
real(kind=DP) :: g(3), q(3), vec_tmp(3)
- real(kind=DP), parameter :: eps = 1.d-3
+! real(kind=DP), parameter :: eps = 1.d-3
+ real(kind=DP), parameter :: eps = 1.d-5
logical :: not_included(nfbz_kmesh)
not_included(1:nfbz_kmesh) = .true.
@@ -2436,7 +2438,7 @@ contains
if(printable .and. printlevel .ge. 0) &
- & write(output,'(1x,"number of k-points in irreducible BZ = ",i5)') nkpoint
+ & write(output,'(1x,"number of k-points in irreducible BZ = ",i8)') nkpoint
call gen_rgrid(a1,a2,a3,rgrid)
@@ -2515,7 +2517,7 @@ contains
if( n == nshell ) stop 'accuracy: n == nshell, accuracy check failure'
if(printable .and. printlevel .ge. 0 ) then
- write(output,'(1x,"Index of the first none zero shell = ",i5)') none_zero
+ write(output,'(1x,"Index of the first none zero shell = ",i8)') none_zero
write(output,'(1x,"|R| of the first none zero shell = ",f10.5)') length_nz
write(output,'(1x,"phase sum = ",f10.5)') sm_nz
write(output,'(1x,"efficiency = ",f8.2)') dble(none_zero)/dble(nkpoint)
@@ -2524,7 +2526,7 @@ contains
if(printable .and. printlevel .ge. 1) then
write(output,'(5x,4(1x,a10))') 'k1','k2','k3','weight'
do i=1,nkpoint
- write(output,'(i5,4(1x,f10.5))') i,kpoint(1:3,i),weight(i)
+ write(output,'(i8,4(1x,f10.5))') i,kpoint(1:3,i),weight(i)
end do
end if
@@ -2869,7 +2871,7 @@ contains
subroutine m_Kp_set_kv3(nk)
integer, intent(in) ::nk
kv3 = nk
- if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i5," <<m_kp_set_kv3>>")') kv3
+ if(ipri_kp>=1) write(nfout,'(" !kp kv3 = ",i8," <<m_kp_set_kv3>>")') kv3
end subroutine m_Kp_set_kv3
subroutine m_Kp_set_mesh_super
diff -uprN phase0_2015.01/src_phase_3d/m_Ldos.F90 phase0_2015.01.01/src_phase_3d/m_Ldos.F90
--- phase0_2015.01/src_phase_3d/m_Ldos.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Ldos.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 471 $)
!
! MODULE: m_Ldos
!
@@ -31,7 +31,7 @@
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
module m_Ldos
-! $Id: m_Ldos.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: m_Ldos.F90 471 2015-11-13 01:14:05Z jkoga $
use m_Const_Parameters, only : DP, CMPLDP, REGULAR_INTERVALS, BY_ATOMIC_POSITIONS &
& , DELTA10, EXECUT, ON, SOFTPART, HARDPART, DIRECT, PAI2 &
& , ALDOS, LAYERDOS, NO, OFF, ELECTRON
@@ -68,7 +68,8 @@ module m_Ldos
& , m_CD_restore_chgq &
& , m_CD_map_chgq_to_fft_box &
& , m_CD_set_ylm_enl_etc &
- & , m_CD_dealloc_ylm_enl_etc
+ & , m_CD_dealloc_ylm_enl_etc &
+ & , m_CD_keep_retrieve_hsr
! ============================== added by K. Tagami ============== 11.0
@@ -665,6 +666,7 @@ contains
call make_map()
denom = 1.d0/product(fft_box_size_WF(1:3,1))
+ call m_CD_keep_retrieve_hsr(.true.)
if(modnrm == EXECUT) call m_CD_set_ylm_enl_etc()
if(sw_save_ldos_weight == ON) call m_Ldos_wd_natm2_and_totch()
@@ -789,6 +791,8 @@ contains
end if
+ call m_CD_keep_retrieve_hsr(.false.)
+
deallocate(mapg2ly)
deallocate(mapg2lx)
if(modnrm == EXECUT) call m_CD_dealloc_ylm_enl_etc()
diff -uprN phase0_2015.01/src_phase_3d/m_OP_Moment.F90 phase0_2015.01.01/src_phase_3d/m_OP_Moment.F90
--- phase0_2015.01/src_phase_3d/m_OP_Moment.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_OP_Moment.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,5 +1,5 @@
module m_OP_Moment
-! $Id: m_OP_Moment.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_OP_Moment.F90 479 2016-03-12 12:30:51Z ktagami $
! =========== Contributions ===================================
!
@@ -159,6 +159,8 @@ contains
istmp = ( is1 -1 )*ndim_spinor + is2
Do m1=1, size1
Do m2=1, size1
+ if ( m1 /= m2 ) cycle
+
spinmom(1) = spinmom(1) +dmmat_ssrep(m1,m2,istmp) &
& *PauliMatrix(2,is2,is1)
spinmom(2) = spinmom(2) +dmmat_ssrep(m1,m2,istmp) &
@@ -191,8 +193,10 @@ contains
write(nfout,*) '! ia l type mx my mz '
!
- write(nfout,'(I7,I4,3X,A5,3F15.8)') ia, l, "orb ", orbmom(1), orbmom(2), orbmom(3)
- write(nfout,'(14X, A5,3F15.8)') "spin ", spinmom(1), spinmom(2), spinmom(3)
+ write(nfout,'(I7,I4,3X,A5,3F15.8)') ia, l, &
+ & "spin ", spinmom(1), spinmom(2), spinmom(3)
+ write(nfout,'(14X, A5,3F15.8)') &
+ & "orb ", orbmom(1), orbmom(2), orbmom(3)
!
write(nfout,*) '! ------ '
@@ -742,7 +746,7 @@ contains
Do it=1, ntyp
call new_radr_and_wos(ista_k,it)
- rad1 = rad_cov_default( iatomn(it) )
+ rad1 = rad_cov_default( nint(iatomn(it)) ) ! Revised according to a report from ASMS Co.ltd, 10 March 2016.
do lmt1=1,ilmt(it)
il1=ltp(lmt1,it); im1=mtp(lmt1,it); it1=taup(lmt1,it)
@@ -1210,29 +1214,13 @@ contains
integer :: ja
integer :: ixyz1, ixyz2, is_tmp
- real(kind=DP) :: ctmp1, weight, ctmp2
+ real(kind=DP) :: ctmp1, weight, ctmp2, weight2, determinant
allocate(hsr_tmp(natm,nlmt,nlmt,ndim_magmom)); hsr_tmp = 0.0d0
allocate(hsi_tmp(natm,nlmt,nlmt,ndim_magmom)); hsi_tmp = 0.0d0
!
hsr_tmp = rho_ylm1_ylm2_r; hsi_tmp = rho_ylm1_ylm2_i
-#if 0
- Do ia=1, natm
- it = ityp(ia)
- do lmt1 = 1, ilmt(it)
- do lmt2 = 1, ilmt(it)
- do is_tmp=1, ndim_magmom
- write(850+mype,*) ' ia lmt1 lmt2 istmp = ', ia, lmt1,lmt2,is_tmp
- write(850+mype,*) 'A ', hsr_tmp(ia,lmt1,lmt2,is_tmp), hsr_tmp(ia,lmt2,lmt1,is_tmp)
- write(850+mype,*) 'B ', hsi_tmp(ia,lmt1,lmt2,is_tmp), hsi_tmp(ia,lmt2,lmt1,is_tmp)
- end do
- end do
- end do
- end Do
- close( 850+mype )
-#endif
-
do ia=1,natm
it=ityp(ia)
do is =1, ndim_magmom
@@ -1254,6 +1242,13 @@ contains
weight = 1.0d0
endif
+ call calc_determinant( op(:,:,iopr), determinant )
+ if ( determinant > 0 ) then
+ weight2 = 1.0d0
+ else
+ weight2 = -1.0d0
+ endif
+
do ia = 1, natm
it = ityp(ia)
ja=abs(ia2ia_symmtry_op_inv(ia,iopr))
@@ -1298,7 +1293,7 @@ contains
crotylm_paw(m,jj,iopr,ia)
rho_ylm1_ylm2_i(ia,lmt1,lmt2,1) = &
rho_ylm1_ylm2_i(ia,lmt1,lmt2,1) + &
- weight * &
+ weight * weight2 * &
hsi_tmp(ja,lmt3,lmt4,1)* &
crotylm_paw(n,ii,iopr,ia)* &
crotylm_paw(m,jj,iopr,ia)
@@ -1306,7 +1301,8 @@ contains
Do ixyz1=1, 3
Do ixyz2=1, 3
ctmp1 = op(ixyz2, ixyz1, iopr) *weight
-
+ ctmp2 = op(ixyz2, ixyz1, iopr) *weight2
+
rho_ylm1_ylm2_r(ia,lmt1,lmt2,ixyz2+1) &
& = rho_ylm1_ylm2_r(ia,lmt1,lmt2,ixyz2+1) &
& + ctmp1 &
@@ -1315,7 +1311,7 @@ contains
& *crotylm_paw(m,jj,iopr,ia)
rho_ylm1_ylm2_i(ia,lmt1,lmt2,ixyz2+1) &
& = rho_ylm1_ylm2_i(ia,lmt1,lmt2,ixyz2+1) &
- & + op(ixyz2, ixyz1, iopr) &
+ & + ctmp2 &
& *hsi_tmp(ja,lmt3,lmt4,ixyz1+1) &
& *crotylm_paw(n,ii,iopr,ia) &
& *crotylm_paw(m,jj,iopr,ia)
@@ -1335,22 +1331,6 @@ contains
rho_ylm1_ylm2_r = rho_ylm1_ylm2_r/nopr; rho_ylm1_ylm2_i = rho_ylm1_ylm2_i/nopr;
-#if 0
- Do ia=1, natm
- it = ityp(ia)
- do lmt1 = 1, ilmt(it)
- do lmt2 = 1, ilmt(it)
- do is_tmp=1, ndim_magmom
- write(860+mype,*) ' ia lmt1 lmt2 istmp = ', ia, lmt1,lmt2,is_tmp
- write(860+mype,*) 'A ', rho_ylm1_ylm2_r(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_r(ia,lmt2,lmt1,is_tmp)
- write(860+mype,*) 'B ', rho_ylm1_ylm2_i(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_i(ia,lmt2,lmt1,is_tmp)
- end do
- end do
- end do
- end Do
- close( 860+mype )
-#endif
-
do ia=1,natm
it=ityp(ia)
do is =1, ndim_magmom
@@ -1363,24 +1343,19 @@ contains
end do
end do
-#if 0
- Do ia=1, natm
- it = ityp(ia)
- do lmt1 = 1, ilmt(it)
- do lmt2 = 1, ilmt(it)
- do is_tmp=1, ndim_magmom
- write(870+mype,*) ' ia lmt1 lmt2 istmp = ', ia, lmt1,lmt2,is_tmp
- write(870+mype,*) 'A ', rho_ylm1_ylm2_r(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_r(ia,lmt2,lmt1,is_tmp)
- write(870+mype,*) 'B ', rho_ylm1_ylm2_i(ia,lmt1,lmt2,is_tmp), rho_ylm1_ylm2_i(ia,lmt2,lmt1,is_tmp)
- end do
- end do
- end do
- end Do
- close( 870+mype )
-#endif
-
deallocate(hsr_tmp); deallocate(hsi_tmp)
+ contains
+ subroutine calc_determinant( a, determinant )
+ real(kind=DP), intent(in) :: a(3,3)
+ real(kind=DP), intent(out) :: determinant
+
+ determinant = a(1,1)*( a(2,2)*a(3,3) -a(2,3)*a(3,2) ) &
+ & -a(1,2)*( a(2,1)*a(3,3) -a(2,3)*a(3,1) ) &
+ & +a(1,3)*( a(2,1)*a(3,2) -a(2,2)*a(3,1) )
+
+ end subroutine calc_determinant
+
end subroutine symmetrz_rho_ylm1_ylm2
! ============= 2014/08/26
diff -uprN phase0_2015.01/src_phase_3d/m_Orbital_Population.F90 phase0_2015.01.01/src_phase_3d/m_Orbital_Population.F90
--- phase0_2015.01/src_phase_3d/m_Orbital_Population.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Orbital_Population.F90 2016-07-12 12:51:53.000000000 +0900
@@ -29,7 +29,7 @@
!
!
module m_Orbital_Population
-! $Id: m_Orbital_Population.F90 416 2014-12-17 04:11:16Z jkoga $
+! $Id: m_Orbital_Population.F90 492 2016-05-31 03:06:04Z jkoga $
use m_Const_Parameters, only : DP,ON,ANEW,RENEW,SIMPLE,BROYD1,BROYD2,DFP,PULAY,OFF,UNIT_MATRIX
use m_Files, only : nfout, nfoccmat, m_Files_open_nfoccmat
use m_IterationNumbers, only : iteration_for_cmix
@@ -37,7 +37,9 @@ module m_Orbital_Population
& , proj_attribute &
& , proj_group, num_proj_elems, max_projs &
& , iprihubbard &
- & , hownew,nbxmix,istrbr,ipripulay, sw_force_simple_mixing_hub
+ & , hownew,nbxmix,istrbr,ipripulay, sw_force_simple_mixing_hub &
+ & , sw_metric_diff, alpha_pulay, sw_recomposing &
+ & , sw_mix_bothspins_sametime, sw_force_simple_mixing
use m_Ionic_System, only : natm,ntyp,ityp,iproj_group,zeta1
use m_PseudoPotential, only : prodphi,ilmt,ltp,mtp,taup,nlmt,ntau,nlmtt
use m_Crystal_Structure, only : op,nopr
@@ -140,6 +142,11 @@ module m_Orbital_Population
integer, private :: sw_mix_imaginary_component = ON
! ===================================================================== 11.0
+ real(DP),private,allocatable,target,dimension(:,:,:,:) :: urec_l
+ real(DP),private,allocatable,dimension(:,:) :: d0_l,u_l,v_l
+ real(kind=DP), allocatable, dimension(:,:) :: ynorm
+ real(DP),private,allocatable,dimension(:) :: f_p !d(ista_kgpm:iend_kgpm)
+
include 'mpif.h'
contains
@@ -186,6 +193,56 @@ contains
!!$write(nfout,*) 'nyymax=',nyymax
end subroutine m_OP_set_i2lp_max2lp
+ subroutine m_OP_store_om()
+ omold = om
+ end subroutine m_OP_store_om
+
+ subroutine m_OP_om_diff()
+ integer :: is,ia,ja,it,ilmt1,ilmt2
+ integer :: l1,l2,m1,m2,t1,t2,m1r,m2r
+ integer :: iyy,iopr,mm1,mm2
+ integer :: ig,ip,i
+
+ integer :: ilp
+ real(kind=DP) :: diff,sumdiff
+ integer :: icount
+ sumdiff = 0.d0
+ icount=0
+ do is=1,nspin,af+1
+
+ do ia=1,natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+
+ do i=1,num_proj_elems(ig)
+ ip=proj_group(i,ig)
+ it = proj_attribute(ip)%ityp
+ ilp = proj_attribute(ip)%l+1
+
+ do ilmt1 = 1, ilmt(it)
+ l1 = ltp(ilmt1,it); m1 = mtp(ilmt1,it)
+ t1 = taup(ilmt1,it)
+ if ( l1 /= ilp ) cycle
+
+ do ilmt2 = 1, ilmt(it)
+ l2 = ltp(ilmt2,it); m2 = mtp(ilmt2,it)
+ t2 = taup(ilmt2,it)
+ if( l2 /= ilp ) cycle
+
+ diff = abs(omold(m1,m2,i,ia,is)-om(m1,m2,i,ia,is))
+ sumdiff = sumdiff+diff
+ icount = icount+1
+ end do
+ end do
+! =============================================================
+ end do
+ !!if(printable) write(nfout,'(a,i5,a,f20.12)') 'omdiff for atom ',ia,' : ',sumdiff/dble(icount)
+ sumdiff = 0.d0
+ icount = 0
+ end do
+ end do
+ end subroutine m_OP_om_diff
+
subroutine m_OP_alloc
allocate(i2lp(num_projectors))
call m_OP_set_i2lp_max2lp
@@ -2318,36 +2375,430 @@ contains
else
nspin_m = nspin/(af+1)
endif
-! ====================================================================== 11.0
- allocate(din(nsize_rho,nspin_m))
- allocate(dout(nsize_rho,nspin_m))
- allocate(urec(nsize_rho,nspin_m,nbxmix,2))
+! ================================================================= 11.0
+
+! =========================================== Modified by K. Tagami =========
+! allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_CD)
+ allocate(f_p(1:nsize_rho)); f_p = 0
+! ============================================================================
+
+ allocate(din(1:nsize_rho,nspin_m))
+ allocate(dout(1:nsize_rho,nspin_m))
+ allocate(urec_l(1:nsize_rho,nspin_m,nbxmix,2))
allocate(uuf_p(nbxmix,nspin_m))
allocate(f(nbxmix,nbxmix,nspin_m))
allocate(g_p(nbxmix,nspin_m))
allocate(ncrspd(nbxmix))
+
+ allocate(ynorm(nbxmix,nspin_m));ynorm=1.d0
+! ======================================= Added by K. Tagami ===========
+ din = 0.0d0; dout = 0.0d0; urec_l = 0.0d0; uuf_p = 0.0d0; f = 0.0d0
+ g_p = 0.0d0; ncrspd = 0
+! ======================================================================
end subroutine mix_pulay_allocate
subroutine mix_pulay_deallocate
+ if(allocated(f_p)) deallocate(f_p)
if(allocated(din)) deallocate(din)
if(allocated(dout)) deallocate(dout)
- if(allocated(urec)) deallocate(urec)
+ if(allocated(urec_l)) deallocate(urec_l)
if(allocated(uuf_p)) deallocate(uuf_p)
if(allocated(f)) deallocate(f)
if(allocated(g_p)) deallocate(g_p)
if(allocated(ncrspd)) deallocate(ncrspd)
+ if (allocated(ynorm)) deallocate(ynorm)
end subroutine mix_pulay_deallocate
subroutine mix_pulay_alloc2
- allocate(d0(nsize_rho,nspin_m))
+ allocate(d0_l(nsize_rho,nspin_m))
+ d0_l = 0.0d0
end subroutine mix_pulay_alloc2
subroutine mix_pulay_dealloc2
- deallocate(d0)
+ deallocate(d0_l)
end subroutine mix_pulay_dealloc2
subroutine m_OP_mix_pulay(rmx)
- real(kind=DP), intent(in) :: rmx
+ integer, parameter :: iRho = 1, iResid = 2
+ real(DP),intent(in) :: rmx
+ integer :: iter, mxiter
+ real(DP),pointer,dimension(:) :: e_wk, f_wk, ww1, finv
+ integer, pointer,dimension(:) :: ip
+! --> T. Yamasaki 03 Aug. 2009
+ real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
+! real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
+! <--
+ real(kind=DP) :: rmxtt
+ integer :: id_sname = -1
+ call tstatc0_begin('m_OP_mix_pulay ',id_sname,1)
+
+ if(previous_waymix /= PULAY) then
+ if(first) then
+ call create_map_func(.true.)
+ call alloc_rho
+ call create_map_func(.false.)
+ first = .false.
+ end if
+ call mix_dealloc_previous()
+ call mix_pulay_allocate()
+ end if
+
+ if ( noncol ) then
+ call map_om_to_rho_noncl(om, om_aimag, rho)
+ call map_om_to_rho_noncl(omold,omold_aimag,rhoo)
+ else
+ call map_om_to_rho(om,rho)
+ call map_om_to_rho(omold,rhoo)
+ endif
+
+ iter = iter_from_reset() !-(m_OP)
+
+ nspin_m = ndim_magmom/(af+1)
+ allocate( rmxtrck(nspin_m) )
+ if ( noncol ) then
+ rmxtrck = rmx
+ else
+ if ( sw_recomposing_occmat == YES .and. af == 0 .and. nspin == 2 ) then
+ call alloc_rhostore_recomp( rmx, rmxtrck )
+ else
+ rmxtrck = rmx
+ endif
+ end if
+! ========================================================================= 11.0
+
+ if((iter-istrbr+1) <= 1) then
+! ===================================== modified by K. Tagami ======== 5.0
+!! call simple_mix(rmx) !-(m_OP)
+ call simple_mix_kt( rmxtrck ) !-(m_OP)
+! ==================================================================== 5.0
+ else
+ call mix_pulay_alloc2 !-(m_CD) d0_l,u_l, and w_l are allocated
+ call set_ncrspd_mxiter(nbxmix,iter-istrbr,mxiter) ! -> ncrspd, mxiter
+!!$ call mix_pulay_alloc3(nbxmix,iter-istrbr) !-(c.h.) e_wk,f_wk,ww1,finv,ip
+ call mix_pulay_alloc3(mxiter) !-(c.h.) e_wk,f_wk,ww1,finv,ip
+
+ call Resid_and_dd_into_urec(mxiter) !-(c.h.)
+ ! dF ->urec_l; dd ->urec_l; d0_l,din,dout
+ call Ri_dot_Rj(mxiter) !-(c.h.) <R(i)|R(j)>->f
+ call get_finv_lapack(nbxmix,mxiter,f) !-(c.h.) f -> f^{-1}= <R(i)|R(j)>^{-1}
+
+ call Rj_dot_d(mxiter) !-(c.h.) <R(j)|d>,(j=1,iter-istrb) -> uuf_p
+
+ call get_gmatrix(mxiter) !-(c.h.) (f,uuf_p)->g
+ call renew_d_using_g(mxiter,rmxtrck) !-(c.h.)
+
+ call mix_pulay_dealloc3 !-(c.h.)
+ call mix_pulay_dealloc2 !-(m_CD)
+ endif
+
+ deallocate(rmxtrck)
+
+ if ( noncol ) then
+ call map_rho_to_om_noncl( ommix,ommix_aimag,rho )
+ else
+ call map_rho_to_om( ommix,rho )
+ endif
+
+ previous_waymix = PULAY
+ call tstatc0_end(id_sname)
+ contains
+ subroutine mix_pulay_alloc3(m)
+ integer, intent(in) :: m
+ allocate(e_wk(m*m)); allocate(f_wk(m*m)); allocate(ww1(m)); allocate(finv(m*m))
+ allocate(ip(m))
+! ===================================== Added by K. Tagami ============
+ e_wk = 0; f_wk = 0; ww1 = 0; finv = 0; ip = 0
+! =====================================================================
+ end subroutine mix_pulay_alloc3
+
+ subroutine set_ncrspd_mxiter(n,iter,m)
+ integer, intent(in) :: n, iter
+ integer, intent(out) :: m
+ integer :: i, nx
+ if(hownew == ANEW) then
+ m = iter
+!!$ ncrspd(:) = (/(i,i=1,m)/)
+ do i=1,iter
+ ncrspd(i) = i
+ end do
+ else ! hownew == RENEW
+ if(iter <= n) then
+ m = iter
+!!$ ncrspd(:) = (/(i,i=1,m)/)
+ do i=1,iter
+ ncrspd(i) = i
+ end do
+ else
+ m = n
+ nx = ncrspd(1)
+ do i = 1, m-1
+ ncrspd(i) = ncrspd(i+1)
+ end do
+ ncrspd(m) = nx
+ end if
+ end if
+ end subroutine set_ncrspd_mxiter
+
+ subroutine mix_pulay_dealloc3
+ deallocate(e_wk); deallocate(f_wk); deallocate(ww1); deallocate(finv)
+ deallocate(ip)
+ end subroutine mix_pulay_dealloc3
+
+ subroutine Resid_and_dd_into_urec(iter)
+ integer, intent(in) :: iter
+ integer :: itc,itc0,itc1
+ integer :: i,j,k,imix
+ real(kind=DP) :: sum1,sum2
+ itc = ncrspd(iter)
+ urec_l(:,:,itc,iResid) = rho(:,:) - rhoo(:,:) - (dout(:,:) - din(:,:)) ! =dF(=delta F^i)
+ urec_l(:,:,itc,iRho ) = rhoo(:,:) - din(:,:) ! =dd
+ d0_l(:,:) = rho(:,:) - rhoo(:,:)
+ din(:,:) = rhoo(:,:)
+ dout(:,:) = rho(:,:)
+ ynorm(itc,:)=0.d0
+ do i=1,nspin_m
+ do k=1,nsize_rho
+ ynorm(itc,i) = ynorm(itc,i)+urec_l(k,i,itc,iResid)*urec_l(k,i,itc,iResid)
+ enddo
+ enddo
+ ynorm(itc,:) = 1.d0/sqrt(ynorm(itc,:))
+ end subroutine Resid_and_dd_into_urec
+
+ subroutine Ri_dot_Rj(n)
+ integer, intent(in) :: n
+ integer :: it,jt,itc,jtc
+ real(DP) :: ff1(nspin_m),ff1tmp
+
+ do it = 1, n
+ itc = ncrspd(it)
+ do jt = it, n
+ jtc = ncrspd(jt)
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp) ! <delta F^i|delta F^j>
+ ff1(1)=ff1tmp;ff1(2)=ff1tmp
+ else
+ call mult1s10(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1) ! <delta F^i|delta F^j>
+ endif
+
+ if ( noncol ) then
+ call mult1s10_reduce_spin( urec_l, nbxmix, 2, itc, iResid, &
+ & urec_l, jtc, iResid, f_p, ff1tmp )
+ ! <delta F^i|delta F^j>
+ ff1(:) = ff1tmp
+ endif
+ f(it,jt,1:nspin_m) = ff1(1:nspin_m)
+ if(jt /= it) f(jt,it,1:nspin_m) = f(it,jt,1:nspin_m)
+ end do
+ end do
+ end subroutine Ri_dot_Rj
+
+ subroutine Rj_dot_d(n)
+ integer, intent(in) :: n
+ integer :: jt, jtc
+ real(DP) :: ff1(nspin_m),ff1tmp
+
+ do jt = 1, n
+ jtc = ncrspd(jt)
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
+ ff1(1) = ff1tmp;ff1(2)=ff1tmp
+ else
+ call mult1s5(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1)
+ endif
+
+ if ( noncol ) then
+ call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
+ ff1(:) = ff1tmp
+ endif
+
+ uuf_p(jt,1:nspin_m) = ff1(1:nspin_m)
+ end do
+ end subroutine Rj_dot_d
+
+ subroutine get_finv_lapack(m,n,f)
+ integer,intent(in) :: m,n
+ real(DP),intent(inout),dimension(m,m,nspin_m) :: f
+ real(DP), allocatable,dimension(:,:) :: fwork
+ integer :: is,inf,it,jt,kt,nnspin
+ real(DP) :: div,tmp
+ allocate(fwork(n,n))
+ nnspin = nspin
+ if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1
+
+ if ( noncol ) then
+ nnspin = 1
+ end if
+
+ do is=1,nnspin
+ if(ipripulay >= 2) then
+ write(nfout,600) n,(('(',it,jt,')',f(it,jt,is),jt=1,n),it=1,n)
+600 format(//11x,"**input matrix**"/12x &
+ & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ fwork=0
+ do it=1,n
+ do jt=1,n
+ fwork(jt,it) = f(jt,it,is)*ynorm(jt,is)*ynorm(it,is)
+ if(it==jt) fwork(jt,it)=fwork(jt,it)+alpha_pulay
+ enddo
+ enddo
+ call dpotrf('U',n,fwork,n,inf)
+ call dpotri('U',n,fwork,n,inf)
+ do it=1,n-1
+ do jt=it+1,n
+ fwork(jt,it) = fwork(it,jt)
+ enddo
+ enddo
+ do it=1,n
+ do jt=1,n
+ f(jt,it,is) = fwork(jt,it)*ynorm(jt,is)*ynorm(it,is)
+ enddo
+ enddo
+ if(ipripulay >= 2) then
+ write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
+630 format(/11x, "**inverse matrix**" &
+ & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ enddo
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ do it=1,n
+ do jt=1,n
+ f(jt,it,2) = f(jt,it,1)
+ enddo
+ enddo
+ endif
+! ============================== added by K. Tagami ========== 11.0
+ if ( noncol ) then
+ do it=1,n
+ do jt=1,n
+ f(jt,it,:) = f(jt,it,1)
+ enddo
+ end do
+ endif
+! ============================================================ 11.0
+ deallocate(fwork)
+
+ end subroutine get_finv_lapack
+
+ subroutine get_finv(m,n,f)
+ integer,intent(in) :: m,n
+ real(DP),intent(inout),dimension(m,m,nspin_m) :: f
+
+ integer :: icount,is,jt,it,icon
+ real(DP) :: div
+
+ e_wk = 0.d0
+ do it = 1, n
+ e_wk(it*it) = 1.d0
+ end do
+
+! ======================================= modified by K. Tagami =========== 11.0
+! do is = 1, nspin, af+1
+ do is = 1, ndim_magmom, af+1
+! ========================================================================== 11.0
+ div = 1.d0/f(1,1,is)
+ icount = 1
+ do jt = 1, n
+ do it = 1, n
+ f_wk(icount) = f(it,jt,is)*div
+ icount = icount + 1
+ end do
+ end do
+ if(ipripulay >= 1) then
+ write(nfout,600) n,(('(',it,jt,')',f(it,jt,is)*div,jt=1,n),it=1,n)
+600 format(//11x,"**input matrix**"/12x &
+ & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ call rdecomp(n,f_wk,ww1,ip,icon)
+ if(icon /= 0) then
+ stop 'LU decomposition is impossible.'
+ else
+ call rsolve(n,n,f_wk,e_wk,finv,ip)
+ endif
+
+ icount = 1
+ do jt = 1, n
+ do it = 1, n
+ f(it,jt,is) = finv(icount)
+ icount = icount + 1
+ end do
+ end do
+ if(ipripulay >= 1) then
+ write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
+630 format(/11x, "**inverse matrix**" &
+ & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
+ end if
+ end do
+ end subroutine get_finv
+
+ subroutine get_gmatrix(n)
+ integer,intent(in) :: n
+ integer :: is, it, jt, nnspin
+ nnspin = nspin
+ if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1
+
+! ============================ added by K. Tagami ============= 11.0
+ if ( noncol ) nnspin = 1
+! ============================================================== 11.0
+
+ g_p = 0.d0
+ do is = 1, nnspin
+ do it = 1, n
+ do jt = 1, n
+ g_p(it,is) = g_p(it,is) - f(jt,it,is)*uuf_p(jt,is)
+ end do
+ end do
+ if(ipripulay >= 2) then
+ write(nfout,'(" -- g_p(1:",i3,") --")') n
+ write(nfout,'(8f20.12)') (g_p(it,is),it=1,n)
+ end if
+ end do
+ if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
+ do it = 1,n
+ g_p(it,2) = g_p(it,1)
+ enddo
+ endif
+! ============================== added by K. Tagami ============ 11.0
+ if ( noncol ) then
+ do it = 1,n
+ g_p(it,:) = g_p(it,1)
+ enddo
+ endif
+! ============================================================== 11.0
+
+ end subroutine get_gmatrix
+
+ subroutine renew_d_using_g(n,p)
+ integer, intent(in) :: n
+ real(DP),intent(in),dimension(nspin_m) :: p
+ integer :: is, k, i, it, itc, ns
+
+!!$ do is = 1, nspin, af+1
+ ns = nspin_for_qnewton()
+ do is = 1, ns,af+1
+ do i = 1,nsize_rho
+ rho(i,is) = rhoo(i,is) + p(is)*d0_l(i,is)
+ end do
+ do it = 1, n
+ itc = ncrspd(it)
+ do i = 1,nsize_rho
+ rho(i,is) = rho(i,is) + g_p(it,is)* &
+ & (urec_l(i,is,itc,iRho) + p(is)*urec_l(i,is,itc,iResid))
+ end do
+ end do
+ end do
+
+ end subroutine renew_d_using_g
+
+ integer function nspin_for_qnewton()
+ if ( noncol ) then
+ nspin_for_qnewton=ndim_magmom
+ else
+ nspin_for_qnewton=nspin
+ if (sw_force_simple_mixing==ON .and. sw_recomposing==ON) nspin_for_qnewton=1
+ endif
+ end function nspin_for_qnewton
+
end subroutine m_OP_mix_pulay
subroutine create_map_func(paramset)
@@ -2597,6 +3048,13 @@ contains
! =========================================================== 11.0
end subroutine m_OP_cp_ommix_to_omold
+ subroutine m_OP_cp_ommix_to_om
+ om = ommix
+! ========================= added by K. Tagami ============== 11.0
+ if ( noncol ) om_aimag = ommix_aimag
+! =========================================================== 11.0
+ end subroutine m_OP_cp_ommix_to_om
+
subroutine m_OP_simple_mixing(nfout,rmxt)
integer, intent(in) :: nfout
real(kind=DP), intent(in) :: rmxt
@@ -2691,6 +3149,119 @@ contains
end subroutine alloc_rhostore_recomp
+ subroutine mult1s5(u,mb,muv,j,iuv,v,f_q,fmult)
+ integer,intent(in) :: mb,muv,j,iuv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m) :: v
+ real(DP),intent(in), dimension(1:nsize_rho) :: f_q
+ real(DP),intent(out),dimension(nspin_m) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,i
+
+ fmult = 0.d0
+ do is = 1, ndim_magmom, af+1
+ p = 0.d0
+ fac=1.0d0
+ do i = 1,nsize_rho
+ if ( noncol ) then
+ fac=f_q(i)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(i)
+ endif
+ end if
+ p = p + fac*u(i,is,j,iuv)*v(i,is)
+ end do
+ fmult(is) = p
+ enddo
+ end subroutine mult1s5
+
+ subroutine mult1s5_reduce_spin(u,mb,muv,j,iuv,v,f_q,fmult)
+ integer,intent(in) :: mb,muv,j,iuv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m) :: v
+ real(DP),intent(in), dimension(1:nsize_rho):: f_q
+ real(DP),intent(out) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,i
+
+ fmult = 0.d0
+ p = 0.d0
+
+ do is = 1, ndim_magmom, af+1
+ fac = 1.0d0
+ do i = 1,nsize_rho
+ if ( noncol ) then
+ fac=f_q(i)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(i)
+ endif
+ end if
+ p = p + fac*u(i,is,j,iuv)*v(i,is)
+ end do
+ enddo
+ fmult = p
+ end subroutine mult1s5_reduce_spin
+
+ subroutine mult1s10(u,mb,muv,i,iu,v,j,iv,f_q,fmult)
+ integer,intent(in) :: mb,muv,i,iu,j,iv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u,v
+ real(DP),intent(in), dimension(1:nsize_rho):: f_q
+ real(DP),intent(out),dimension(nspin_m) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,ig
+ fmult = 0.d0
+
+ do is = 1, ndim_magmom, af+1
+ p = 0.d0
+ fac = 1.0d0
+ do ig = 1,nsize_rho
+ if ( noncol ) then
+ fac=f_q(ig)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(ig)
+ endif
+ end if
+ p = p + fac*u(ig,is,i,iu)*v(ig,is,j,iv)
+ end do
+ fmult(is) = p
+ enddo
+ end subroutine mult1s10
+
+ subroutine mult1s10_reduce_spin(u,mb,muv,i,iu,v,j,iv,f_q,fmult)
+ integer,intent(in) :: mb,muv,i,iu,j,iv
+ real(DP),intent(in), dimension(1:nsize_rho,nspin_m,mb,muv) :: u,v
+ real(DP),intent(in), dimension(1:nsize_rho):: f_q
+ real(DP),intent(out) :: fmult
+
+ real(DP) :: p, fac
+ integer :: is,ig
+
+ fmult = 0.d0
+ p = 0.d0
+
+ do is = 1, ndim_magmom, af+1
+ fac = 1.0d0
+ do ig = 1,nsize_rho
+
+ if ( noncol ) then
+ fac=f_q(ig)
+ else
+ if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
+ fac=f_q(ig)
+ endif
+ end if
+ p = p + fac*u(ig,is,i,iu)*v(ig,is,j,iv)
+ end do
+ enddo
+ fmult = p
+ end subroutine mult1s10_reduce_spin
+
! ================================================================= 5.0
end module m_Orbital_Population
diff -uprN phase0_2015.01/src_phase_3d/m_PAW_ChargeDensity.F90 phase0_2015.01.01/src_phase_3d/m_PAW_ChargeDensity.F90
--- phase0_2015.01/src_phase_3d/m_PAW_ChargeDensity.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_PAW_ChargeDensity.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 488 $)
!
! MODULE: m_PAW_ChargeDensity
!
@@ -33,10 +33,10 @@
!
module m_PAW_ChargeDensity
use m_db, only : getIntDB,getStringDB_TB,getIntDB_TB
- use m_Const_Parameters, only : DP,PAI2,PAI4,BUCS,SphericalHarmonicsExpansion, GaussLegendre, LOWER
+ use m_Const_Parameters, only : DP,PAI2,PAI4,BUCS,SphericalHarmonicsExpansion, GaussLegendre, LOWER, Bohr
use m_Control_Parameters, only : kimg,nspin,af,ipripaw,ipriinputfile,printable
use m_Files, only : nfout
- use m_Ionic_System, only : ityp,natm,ntyp,pos,iwei, speciesname
+ use m_Ionic_System, only : ityp,natm,ntyp,pos,iwei, speciesname, amion
use m_Charge_Density, only : hsr,chgq_l,chgsoft
use m_PlaneWaveBasisSet, only : igfp_l
use m_PseudoPotential, only : psirpw,phirpw,qrspspw &
@@ -45,7 +45,7 @@ module m_PAW_ChargeDensity
& ,il2p,isph,dl2p,iqitg &
& ,m_PP_find_maximum_l &
& ,ipaw,wf_mnrc,flg_symmtry &
- & ,mmesh
+ & ,mmesh, nmesh
use m_FFT, only : fft_box_size_CD,fft_box_size_CD_c, nfftp &
, m_FFT_CD_inverse0 &
, m_FFT_check_of_negative_CD &
@@ -167,6 +167,7 @@ module m_PAW_ChargeDensity
public:: calcGaussLegendreIntegration
public:: calcSphericalHarmonicsExpansion
+
contains
subroutine m_PAW_dealloc()
@@ -2313,7 +2314,7 @@ contains
subroutine set_ia2ia_symmtry_op
integer:: ia,it,no,ja,jt
integer:: i,j,k
- real(DP):: pos0(3),pos1(3),pos2(3)
+ real(DP):: pos0(3),pos1(3),pos2(3),pos3(3)
real(DP):: distance
allocate(op_pr(3,3,nopr+af))
@@ -2329,14 +2330,15 @@ contains
pos1(:)=matmul(op_pr(:,:,no),pos0(:))+tau(:,no,BUCS)
!print *,'pos1=',pos1
pos1(:) = pos1(:) - floor(pos1(:))
- KLoop: do k=-2,1
- do j=-2,1
- do i=-2,1
+ KLoop: do k=-1,1
+ do j=-1,1
+ do i=-1,1
do ja=1,natm
jt=ityp(ja)
if(it/=jt) cycle
-
- pos2(1:3)=pos(ja,1:3)+(/dble(i),dble(j),dble(k)/)
+ pos3(1:3) = pos(ja,1:3)
+ pos3(:) = pos3(:) - floor(pos3(:))
+ pos2(1:3)=pos3(1:3)+(/dble(i),dble(j),dble(k)/)
!print *,'pos2=',pos2
distance=abs(pos1(1)-pos2(1))+abs(pos1(2)-pos2(2)) &
+abs(pos1(3)-pos2(3))
@@ -2355,7 +2357,7 @@ contains
end if
if(kimg==1 .and. iwei(ja)==2) then
- pos2(1:3)=-pos(ja,1:3)+(/dble(i),dble(j),dble(k)/)
+ pos2(1:3)=-pos3(1:3)+(/dble(i),dble(j),dble(k)/)
distance=abs(pos1(1)-pos2(1))+abs(pos1(2)-pos2(2)) &
+abs(pos1(3)-pos2(3))
if(distance < 1.d-5) then
@@ -3850,4 +3852,5 @@ contains
! ==============================================================================
#endif
+
end module m_PAW_ChargeDensity
diff -uprN phase0_2015.01/src_phase_3d/m_PAW_XC_Potential.F90 phase0_2015.01.01/src_phase_3d/m_PAW_XC_Potential.F90
--- phase0_2015.01/src_phase_3d/m_PAW_XC_Potential.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_PAW_XC_Potential.F90 2016-07-12 12:51:53.000000000 +0900
@@ -7,7 +7,7 @@
#endif
!=======================================================================
!
-! SOFTWARE NAME : PHASE ($Revision: 416 $)
+! SOFTWARE NAME : PHASE ($Revision: 494 $)
!
! MODULE: m_PAW_XC_Potential
!
@@ -637,7 +637,7 @@ contains
dnps_dph = 0.d0
ddnps_ddr = 0.d0
- if(xctype == 'ldapw91' .or. xctype == 'ldapbe ') then
+ if(xctype == 'ldapw91' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf' ) then
grad_nae=0.d0;grad_tnae=0.d0
grad_nps=0.d0;grad_tnps=0.d0
else
@@ -668,7 +668,7 @@ contains
,grad_tnps(1:nrc),wos(1:nrc),texc &
,dF_dnps(1:nrc,1:nspin))
exc_ps=exc_ps+texc*omg_wght(ith)
- else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe ') then
+ else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf') then
call ex_ggapbe (nspin,nspin,1,nrc,nae(1:nrc,1:nspin) &
,grad_nae(1:nrc,1:nspin) &
,wos(1:nrc),texc &
@@ -2105,7 +2105,7 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
! ==============================================================================
if(af /= 0) then
do ia = 1, natm
- if(flg_done(ia) .eq. .true.) cycle
+ if(flg_done(ia)) cycle
ja = ia2ia_symmtry_op(ia,nopr+af)
if(ja > ia) flg_done(ja) = .true.
enddo
@@ -2398,7 +2398,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
dFc_dab_ps(ir)*nanb_ps_sph(ir,1)
end if
- if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' .and. xctype /= 'ldapbe ') then
+ if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' .and. xctype /= 'ldapbe ' &
+ & .and. xctype /= 'vdwdf') then
if(dabs(grad_nae(ir,1)) < DELTA10) cycle
if(dabs(grad_tnae(ir)) < DELTA10) cycle
if(dabs(grad_nps(ir,1)) < DELTA10) cycle
@@ -2446,7 +2447,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
if(vflag == VXC_AND_EXC) then
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
! === For nrc decomposion. by takto 2012/12/05 =================================
#ifndef PAW3D
! ==============================================================================
@@ -2579,7 +2581,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
! dFxcdnb_ae_sph=0.d0
! dFxcdnb_ps_sph=0.d0
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
num_isph_2tm=num_isph_g_g
isph_2tm=isph_g_g
else
@@ -2620,7 +2623,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
end if
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
sum1 = sum1 + &
0.5d0*dFadgaga_ae(ir)*gaga_ae_sph(ir,nsph) + &
0.5d0*dFadgg_ae(ir)*gg_ae_sph(ir,nsph) + &
@@ -2731,7 +2735,8 @@ START_TIMER('m_PAW_XC_cal_potential_sphe
end if
if(check_of_xctype()==GGA .and. xctype /= 'ldapw91' &
- .and. xctype /= 'ldapbe ') then
+ .and. xctype /= 'ldapbe ' &
+ .and. xctype /= 'vdwdf' ) then
sum1 = sum1 + &
0.5d0*dGadgaga_ae(ir)*gaga_ae_sph(ir,nsph) + &
dGadnaga_ae(ir)*naga_ae_sph(ir,nsph)
@@ -3852,7 +3857,7 @@ contains
! dnps_dph = 0.d0
! ddnps_ddr = 0.d0
- if(xctype == 'ldapw91' .or. xctype == 'ldapbe ') then
+ if(xctype == 'ldapw91' .or. xctype == 'ldapbe ' .or. xctype == 'vdwdf') then
grad_nae2_sph=0.d0;grad_tnae2_sph=0.d0
grad_nps2_sph=0.d0;grad_tnps2_sph=0.d0
grad_nae=0.d0;grad_tnae=0.d0
@@ -3936,7 +3941,7 @@ contains
,dFc_dagg_ps(1:nrc) &
,dFc_dbgg_ps(1:nrc) &
,dFc_dabg_ps(1:nrc))
- else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe ') then
+ else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf') then
call ex_ggapbe_paw_drv2(nrc,dnr,nspin &
,nae_sph(1:nrc,1:nspin,1) &
,grad_nae(1:nrc,1:nspin) &
@@ -4173,7 +4178,7 @@ contains
dF_dnps = 0.d0
dF_dgradnps = 0.d0
- if(xctype == 'ldapw91' .or. xctype == 'ldapbe ') then
+ if(xctype == 'ldapw91' .or. xctype == 'ldapbe '.or. xctype == 'vdwdf' ) then
grad_nae2_sph=0.d0;grad_tnae2_sph=0.d0
grad_nps2_sph=0.d0;grad_tnps2_sph=0.d0
grad_nae=0.d0;grad_tnae=0.d0
@@ -4261,7 +4266,7 @@ contains
,dFc_dbgg_ps &
,dFc_dabg_ps &
,ista_nrc, iend_nrc, ist, ien)
- else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe ') then
+ else if(xctype == 'ggapbe ' .or. xctype == 'ldapbe ' .or. xctype == 'vdwdf') then
call ex_ggapbe_paw_drv2_3D(nrc,dnr,nspin &
,nae_sph(ista_nrc,1,1) &
,grad_nae &
diff -uprN phase0_2015.01/src_phase_3d/m_Parallelization.F90 phase0_2015.01.01/src_phase_3d/m_Parallelization.F90
--- phase0_2015.01/src_phase_3d/m_Parallelization.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Parallelization.F90 2016-07-12 12:51:53.000000000 +0900
@@ -3,7 +3,7 @@
#endif
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 482 $)
!
! MODULE: m_Parallelization
!
@@ -65,7 +65,7 @@
module m_Parallelization
! (m_Parallel)
-! $Id: m_Parallelization.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_Parallelization.F90 482 2016-04-08 08:40:45Z jkoga $
use m_Const_Parameters, only : ON, OFF, tag_npes_etc
use m_ErrorMessages
! === For nrc decomposion. by takto 2012/12/07 =================================
@@ -214,6 +214,8 @@ module m_Parallelization
! ==============================================================================
integer :: ista_kngp, iend_kngp, np_kngp, mp_kngp
integer, allocatable, dimension(:) :: is_kngp, ie_kngp, nel_kngp
+ integer :: ista_kngp_exx, iend_kngp_exx, np_kngp_exx, mp_kngp_exx
+ integer, allocatable, dimension(:) :: is_kngp_exx, ie_kngp_exx, nel_kngp_exx
! natm for fxyzew_l
integer :: ista_atm, iend_atm, np_atm, mp_atm
integer, allocatable, dimension(:) :: is_atm, ie_atm, nel_atm
@@ -225,6 +227,12 @@ module m_Parallelization
integer :: ista_nn,iend_nn,np_nn,mp_nn
integer, allocatable, dimension(:) :: is_nn, ie_nn, nel_nn
+ integer :: ista_nq, iend_nq, np_nq, mp_nq
+ integer, allocatable, dimension(:) :: is_nq, ie_nq, nel_nq, map_nq, map_z_nq
+
+! integer :: ista_nval,iend_nval,np_nval,mp_nval
+! integer, allocatable, dimension(:) :: is_nval, ie_nval, nel_nval
+
integer :: ista_atm_B, iend_atm_B, np_atm_B, mp_atm_B
integer, allocatable, dimension(:) :: is_atm_B, ie_atm_B, nel_atm_B
integer, allocatable, dimension(:) :: mem_atm_B ! (1:natm)
@@ -296,6 +304,12 @@ module m_Parallelization
! ==============================================================================
#endif
+ integer :: nrank_nval,myrank_nval
+ integer :: ista_nval,iend_nval,np_nval,mp_nval
+ integer, allocatable, dimension(:) :: nis_nval,nie_nval,nel_nval
+ integer, allocatable, dimension(:) :: map_nval,map_z_nval
+ logical,private :: mpi_nval_enabled = .false.
+
! for nfft
integer :: ista_ffth, iend_ffth, np_ffth, mp_ffth
integer, allocatable, dimension(:) :: is_ffth, ie_ffth, nel_ffth
@@ -1674,6 +1688,31 @@ contains
__TIMER_SUB_STOP(1238)
end subroutine m_Parallel_init_mpi_rspace_aug
+ subroutine m_Parallel_init_mpi_nq(nfout,ipri,printable,nq)
+ integer, intent(in) :: nfout, ipri,nq
+ logical, intent(in) :: printable
+ integer :: i,j,ip
+
+ allocate(is_nq(0:npes-1));ista_nq=nq+1
+ allocate(ie_nq(0:npes-1));iend_nq=0
+ allocate(nel_nq(0:npes-1));nel_nq=0
+ allocate(map_nq(nq));map_nq=0
+ allocate(map_z_nq(nq));map_z_nq=0
+
+ call set_block_range(nq,npes,nel_nq,is_nq,ie_nq,.true.,map_nq)
+ ista_nq = is_nq(mype)
+ iend_nq = ie_nq(mype)
+ np_nq = nel_nq(mype)
+ mp_nq = maxval(nel_nq)
+ j = 0
+ do ip = 1, npes
+ do i = 1, nel_nq(ip-1)
+ j = j + 1
+ map_z_nq(j) = i
+ end do
+ end do
+ end subroutine m_Parallel_init_mpi_nq
+
subroutine m_Parallel_init_mpi_atm(nfout,ipri,printable,natm)
integer, intent(in) :: nfout,ipri,natm
logical, intent(in) :: printable
@@ -2056,14 +2095,22 @@ contains
else
NB = nblocksize_mgs_default
end if
+ if (.not.nblocksize_mgs_is_given.and. &
+ & mod(int(real(neg)/real(nrank_e)),NB)/=0.and. &
+ & mod(neg,nrank_e)==0) then
+ NB = int(real(neg)/real(nrank_e))
+ if(NB<1) NB=1
+ nblocksize_mgs = NB
+ nblocksize_mgs_is_given = .true.
+ endif
! === Change nblocksize_mgs if it's too large. by tkato 2014/===================
if(nrank_e /= 1) then
- max_block_size = int(real(neg)/real(nrank_e - 1))
+ max_block_size = int(real(neg)/real(nrank_e))
if(NB > max_block_size) then
if(mype == 0) then
write(0,'(a)') '=== WARNING!!! =============================================='
write(0,'(a)') 'Block size for block-cyclic division on band is too large!'
- write(0,'(a,i5,a)') 'Block size should be not greater than ', max_block_size, '!'
+ write(0,'(a,i5,a)') 'Block size should not be greater than ', max_block_size, '!'
write(0,'(a,i5,a)') 'So, nblocksize_mgs is changed into ', max_block_size, '!'
write(0,'(a)') 'FYI: '
write(0,'(a,i8)') ' neg: ', neg
@@ -2161,7 +2208,6 @@ contains
ista_e = nis_e(myrank_e)
iend_e = nie_e(myrank_e)
mp_e = maxval(nel_e)
-
! wk_sta(:) = nis_e(:) - 1
wk_sta(0:nrank_e-1) = nis_e(0:nrank_e-1) - 1
call mpi_allgatherv(neg_g, nel_e(myrank_e), mpi_integer, &
@@ -3161,9 +3207,9 @@ contains
nrank_e = ne
nrank_k = nk
nrank_g = ng
- if(printable) write(6,'(" nrank_e = ",i3)') nrank_e
- if(printable) write(6,'(" nrank_k = ",i3)') nrank_k
- if(printable) write(6,'(" nrank_g = ",i3)') nrank_g
+ if(printable) write(6,'(" nrank_e = ",i6)') nrank_e
+ if(printable) write(6,'(" nrank_k = ",i6)') nrank_k
+ if(printable) write(6,'(" nrank_g = ",i6)') nrank_g
! if( mype == 0 .and. nk/=1 ) then
! write(6,*) '[ERROR] nk =', nk
! call mpi_abort(mpi_comm_world, 2, err)
@@ -3685,6 +3731,61 @@ contains
!===============================================================================
+ subroutine m_Parallel_init_mpi_nval(nfout,ipri,printable,nval)
+ integer, intent(in) :: nfout, ipri,nval
+ logical, intent(in) :: printable
+ integer :: i,j,ip
+ nrank_nval = nrank_g
+ myrank_nval = myrank_g
+ if(mpi_nval_enabled) call m_Parallel_dealloc_mpi_nval()
+ call m_Parallel_alloc_mpi_nval(nval)
+ call set_block_range(nval,nrank_nval,nel_nval,nis_nval,nie_nval,.true.,map_nval)
+ mpi_nval_enabled = .true.
+ if(ipri>=2) call wd_val_range_3D()
+ ista_nval = nis_nval(myrank_nval)
+ iend_nval = nie_nval(myrank_nval)
+ np_nval = nel_nval(myrank_nval)
+ mp_nval = maxval(nel_nval)
+
+ j = 0
+ do ip = 1, nrank_nval
+ do i = 1, nel_nval(ip-1)
+ j = j + 1
+ map_z_nval(j) = i
+ end do
+ end do
+
+ contains
+
+ subroutine wd_val_range_3D()
+ if(printable) then
+ write(nfout,'(" !|| nrank_nval")')
+ write(nfout,'(" !|| i : ",20i4)')(i,i=0,nrank_nval-1)
+ write(nfout,'(" !|| ista_nval : ",20i4)')(nis_nval(i),i=0,nrank_nval-1)
+ write(nfout,'(" !|| iend_nval : ",20i4)')(nie_nval(i),i=0,nrank_nval-1)
+ write(nfout,'(" !|| nel_nval : ",20i4)')(nel_nval(i),i=0,nrank_nval-1)
+ end if
+ end subroutine wd_val_range_3D
+ end subroutine m_Parallel_init_mpi_nval
+
+ subroutine m_Parallel_alloc_mpi_nval(nval)
+ integer, intent(in) :: nval
+ allocate(nis_nval(0:nrank_nval-1));ista_nval=nval+1
+ allocate(nie_nval(0:nrank_nval-1));iend_nval=0
+ allocate(nel_nval(0:nrank_nval-1));nel_nval=0
+ allocate(map_nval(nval));map_nval=0
+ allocate(map_z_nval(nval));map_z_nval=0
+ end subroutine m_Parallel_alloc_mpi_nval
+
+ subroutine m_Parallel_dealloc_mpi_nval()
+ deallocate(nis_nval)
+ deallocate(nie_nval)
+ deallocate(nel_nval)
+ deallocate(map_nval)
+ deallocate(map_z_nval)
+ mpi_nval_enabled = .false.
+ end subroutine m_Parallel_dealloc_mpi_nval
+
subroutine m_Parallel_init_mpi_iba_3D(nfout,ipri,printable,kv3,iba)
integer, intent(in) :: nfout,ipri, kv3, iba(kv3)
logical, intent(in) :: printable
@@ -3931,6 +4032,35 @@ contains
end subroutine m_Parallel_init_mpi_kngp_3D
!===============================================================================
+ subroutine m_Parallel_init_mpi_kngp_exx(nfout,ipri,nmax_G_hyb)
+ integer, intent(in) :: nfout,ipri,nmax_G_hyb
+ integer :: iwork, i
+ integer :: npes, mype
+
+ npes = nrank_g
+ mype = myrank_g
+
+ allocate(is_kngp_exx(0:npes-1))
+ allocate(ie_kngp_exx(0:npes-1))
+ allocate(nel_kngp_exx(0:npes-1))
+ iwork = ( nmax_G_hyb - 1 ) / npes + 1
+ if(ipri >= 1) then
+ write(nfout,'(" << m_Parallel_init_mpi_kngp_exx >>")')
+ write(nfout,'(" !|| nmax_G_hyb = ",i12)') nmax_G_hyb
+ write(nfout,'(" !|| -- is_kngp_exx(ista_kngp_exx), ie_kngp_exx(iend_kngp_exx) --")')
+ end if
+ do i = 0, npes-1
+ is_kngp_exx(i) = min(i*iwork+1, nmax_G_hyb+1)
+ ie_kngp_exx(i) = min(is_kngp_exx(i)+iwork-1, nmax_G_hyb)
+ nel_kngp_exx(i) = ie_kngp_exx(i) - is_kngp_exx(i) + 1
+ if(ipri >= 1) write(nfout,'(" !|| ",2i10)') is_kngp_exx(i),ie_kngp_exx(i)
+ enddo
+ ista_kngp_exx = is_kngp_exx(mype)
+ iend_kngp_exx = ie_kngp_exx(mype)
+ np_kngp_exx = nel_kngp_exx(mype)
+ mp_kngp_exx = maxval(nel_kngp_exx)
+ end subroutine m_Parallel_init_mpi_kngp_exx
+
subroutine m_Parallel_init_mpi_kngp_B_3D(nfout,ipri,kngp)
integer, intent(in) :: nfout,ipri,kngp
integer :: iwork, i
diff -uprN phase0_2015.01/src_phase_3d/m_Phonon.F90 phase0_2015.01.01/src_phase_3d/m_Phonon.F90
--- phase0_2015.01/src_phase_3d/m_Phonon.F90 2015-09-15 12:16:40.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Phonon.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! SOFTWARE NAME : PHASE ($Revision: 409 $)
+! SOFTWARE NAME : PHASE ($Revision: 460 $)
!
! MODULE: m_Phonon
!
@@ -32,7 +32,7 @@
!
!
module m_Phonon
-! $Id: m_Phonon.F90 409 2014-10-27 09:24:52Z jkoga $
+! $Id: m_Phonon.F90 460 2015-09-15 02:53:17Z jkoga $
use m_Const_parameters, only : DP, ON, OFF, NOCONV, FMAXVALLEN, PAI, PAI2, PAI4 &
& , PHONON_GAMMA, PHONON_BAND, PHONON_DOS &
& , LOWER, CARTS, UNIT_PIEZO_CONST &
diff -uprN phase0_2015.01/src_phase_3d/m_PlaneWaveBasisSet.F90 phase0_2015.01.01/src_phase_3d/m_PlaneWaveBasisSet.F90
--- phase0_2015.01/src_phase_3d/m_PlaneWaveBasisSet.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_PlaneWaveBasisSet.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 481 $)
!
! MODULE: m_PlaneWaveBasisSet
!
@@ -34,9 +34,41 @@
!
! Revised for the GAMMA point (k=(0,0,0)) by T. Yamasaki, April 2006.
!
+
+#ifdef __TIMER_SUB__
+# define __TIMER_SUB_START(a) call timer_sta(a)
+# define __TIMER_SUB_STOP(a) call timer_end(a)
+#else
+# define __TIMER_SUB_START(a)
+# define __TIMER_SUB_STOP(a)
+#endif
+#ifdef __TIMER_DO__
+# define __TIMER_DO_START(a) call timer_sta(a)
+# define __TIMER_DO_STOP(a) call timer_end(a)
+#else
+# define __TIMER_DO_START(a)
+# define __TIMER_DO_STOP(a)
+#endif
+#ifdef FJ_TIMER
+# define __TIMER_FJ_START_w_BARRIER(str,a) call mpi_barrier(str,ierr) ; call timer_sta(a)
+# define __TIMER_FJ_START(a) call timer_sta(a)
+# define __TIMER_FJ_STOP(a) call timer_end(a)
+#else
+# define __TIMER_FJ_START_w_BARRIER(str,a)
+# define __TIMER_FJ_START(a)
+# define __TIMER_FJ_STOP(a)
+#endif
+#ifdef __TIMER_INIDO__
+# define __TIMER_INIDO_START(a) call timer_sta(a)
+# define __TIMER_INIDO_STOP(a) call timer_end(a)
+#else
+# define __TIMER_INIDO_START(a)
+# define __TIMER_INIDO_STOP(a)
+#endif
+
module m_PlaneWaveBasisSet
! ( m_pwBS )
-! $Id: m_PlaneWaveBasisSet.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_PlaneWaveBasisSet.F90 481 2016-03-25 02:51:57Z jkoga $
use m_Crystal_Structure, only : nopr, altv,rltv, m_CS_op_in_PUCV
use m_Kpoints, only : kv3,kv3_ek,vkxyz,qwgt, k_symmetry
use m_FFT, only : fft_box_size_WF, fft_box_size_CD, fft_box_size_pWF &
@@ -106,6 +138,11 @@ module m_PlaneWaveBasisSet
integer :: kg_tfw = 0
! ========================== 13.0U2
+! ===== EXP_CELLOPT ==== 2015/09/24
+ integer :: kg1_prev = 0
+ integer :: kgp_prev = 0
+! ====================== 2015/09/24
+
integer, dimension(3) :: n_rGv
integer, dimension(3) :: n_rGpv
integer, dimension(3) :: n_rGpv_reduced
@@ -289,6 +326,10 @@ contains
if(sw_positron /= OFF) deallocate(igf_pstrn)
! ------- Positron end
+! ========== KT_add ========================== 13.0F
+ if (sw_hybrid_functional /= OFF .and. use_fft_exx ) deallocate(igf_exx)
+ if (sw_hybrid_functional /= OFF ) deallocate(igfp_exx)
+! ============================================ 13.0F
end subroutine m_pwBS_dealloc_ngpt_igfp_gr
@@ -440,10 +481,7 @@ contains
integer, parameter :: CRITICAL_VECTOR_LENGTH = 10000
integer :: id_sname = -1
-#ifdef __TIMER_SUB__
- call timer_sta(1221)
-#endif
-
+ __TIMER_SUB_START(1221)
call tstatc0_begin('m_pwBS_for_each_WF ',id_sname)
if(ipri >= 2) then
@@ -753,9 +791,7 @@ contains
end if
call tstatc0_end(id_sname)
-#ifdef __TIMER_SUB__
- call timer_end(1221)
-#endif
+ __TIMER_SUB_STOP(1221)
contains
subroutine wd_ngshell_range
integer :: jg, j,n1,n2,n3
@@ -833,9 +869,7 @@ contains
kg1_exx = 0
do j = 1, kg_exx
- ga = ngabc(j,1)
- gb = ngabc(j,2)
- gc = ngabc(j,3)
+ ga = ngabc(j,1); gb = ngabc(j,2); gc = ngabc(j,3)
grvv = dsqrt(ttr(1)*ga*ga + ttr(2)*gb*gb + ttr(3)*gc*gc &
& + ttr(4)*ga*gb + ttr(5)*gb*gc + ttr(6)*gc*ga )
if(grvv <= gmax_exx) then
@@ -859,9 +893,7 @@ contains
kg1p_exx = 0
do j = 1, kgp_exx
- ga = ngabc(j,1)
- gb = ngabc(j,2)
- gc = ngabc(j,3)
+ ga = ngabc(j,1); gb = ngabc(j,2); gc = ngabc(j,3)
grvv = dsqrt(ttr(1)*ga*ga + ttr(2)*gb*gb + ttr(3)*gc*gc &
& + ttr(4)*ga*gb + ttr(5)*gb*gc + ttr(6)*gc*ga )
if(grvv <= gmaxp_exx) then
@@ -1590,6 +1622,8 @@ contains
if(allocated(nbase)) deallocate(nbase)
if(allocated(ylm_l)) deallocate(ylm_l)
+
+ if(allocated(nbase_gamma)) deallocate(nbase_gamma)
#ifdef _MPIFFT_
if(allocated(igfp_l_c)) deallocate(igfp_l_c)
@@ -1648,6 +1682,16 @@ contains
allocate(igf_pstrn(kg_pwf)) ; igf_pstrn = 0
end if
! ------- Positron end
+
+! ========== KT_add ========================== 13.0F
+ if (sw_hybrid_functional /= OFF .and. use_fft_exx ) then
+ allocate(igf_exx(kg_exx)) ; igf_exx = 0
+ end if
+ if (sw_hybrid_functional /= OFF) then
+ allocate(igfp_exx(kgp_exx)) ; igfp_exx = 0
+ endif
+! ============================================ 13.0F
+
end subroutine m_pwBS_alloc_ngpt_igfp_gr_3D
!------------------------------------------------------------------------------
@@ -1658,9 +1702,7 @@ contains
integer :: i, k, ngs
real(kind=DP) :: length_start, length
-#ifdef __TIMER_SUB__
- call timer_sta(1220)
-#endif
+ __TIMER_SUB_START(1220)
call tstatc0_begin('m_pwBS_calc_length_of_G_3D ',id_sname)
@@ -1735,9 +1777,7 @@ contains
end if
call tstatc0_end(id_sname)
-#ifdef __TIMER_SUB__
- call timer_end(1220)
-#endif
+ __TIMER_SUB_STOP(1220)
end subroutine m_pwBS_calc_length_of_G_3D
!------------------------------------------------------------------------------
@@ -1774,30 +1814,22 @@ contains
integer :: i,ni
real(kind=DP) a,b,c,d,e,f,gx,gy,gz
real(kind=DP) b1x,b1y,b1z,b2x,b2y,b2z,b3x,b3y,b3z
-#ifdef __TIMER_SUB__
- call timer_sta(1059)
-#endif
+ __TIMER_SUB_START(1059)
b1x = rltv(1,1); b1y = rltv(2,1); b1z = rltv(3,1)
b2x = rltv(1,2); b2y = rltv(2,2); b2z = rltv(3,2)
b3x = rltv(1,3); b3y = rltv(2,3); b3z = rltv(3,3)
ni = ista_ylm
-#ifdef __TIMER_DO__
- call timer_sta(1081)
-#endif
+ __TIMER_DO_START(1081)
if(ngabc(1,1) == 0 .and. ngabc(1,2) == 0 .and. ngabc(1,3) == 0) then
if(ni == 1) then
ni = 2
ylm(1) = dsqrt(1.d0/PAI4)
endif
end if
-#ifdef __TIMER_DO__
- call timer_end(1081)
-#endif
-#ifdef __TIMER_DO__
- call timer_sta(1082)
-#endif
+ __TIMER_DO_STOP(1081)
+ __TIMER_DO_START(1082)
if(is == 1) then
a = dsqrt(1.d0/PAI4)
do i = ni, iend_ylm !for mpi
@@ -2037,12 +2069,8 @@ contains
ylm(i) = a*(b-c)*gx*gy/f
end do
end if
-#ifdef __TIMER_DO__
- call timer_end(1082)
-#endif
-#ifdef __TIMER_SUB__
- call timer_end(1059)
-#endif
+ __TIMER_DO_STOP(1082)
+ __TIMER_SUB_STOP(1059)
end subroutine m_pwBS_sphrp2_3D
!------------------------------------------------------------------------------
@@ -2520,6 +2548,27 @@ contains
endif
end if
+ if ( sw_hybrid_functional /= OFF ) then
+ if( fft_box_size_CD(1,1) == fft_box_size_CD_exx(1,1) .and. &
+ & fft_box_size_CD(2,1) == fft_box_size_CD_exx(2,1) .and. &
+ & fft_box_size_CD(3,1) == fft_box_size_CD_exx(3,1) .and. &
+ & kgp == kgp_exx ) then
+ igfp_exx(ista_kngp:iend_kngp) = igfp_l(ista_kngp:iend_kngp)
+ call mpi_allreduce(MPI_IN_PLACE,igfp_exx,kgp_exx,mpi_integer,mpi_sum,mpi_ke_world,ierr)
+ else
+ id = fft_box_size_CD_exx(1,0)
+ do i = 1, kgp_exx
+ igf1 = ngabc(i,1) + 1
+ igf2 = ngabc(i,2) + 1
+ igf3 = ngabc(i,3) + 1
+ if(ngabc(i,1) <= -1) igf1 = igf1 + fft_box_size_CD_exx(1,1)
+ if(ngabc(i,2) <= -1) igf2 = igf2 + fft_box_size_CD_exx(2,1)
+ if(ngabc(i,3) <= -1) igf3 = igf3 + fft_box_size_CD_exx(3,1)
+ igfp_exx(i) = igf1 + (igf2-1)*id + (igf3-1)*id*fft_box_size_CD_exx(2,0)
+ end do
+ end if
+ endif
+
call tstatc0_end(id_sname)
end subroutine m_pwBS_setup_FFTmapfunctions_3D
@@ -2977,6 +3026,9 @@ contains
real(kind=DP) :: rd
real(kind=DP), allocatable, dimension(:) :: gmaxp_length
integer :: kgp_wk,i,nn,ierr
+! =========== KT_add ================================ 13.0F
+ real(kind=DP) :: gmax2_exx
+! =================================================== 13.0F
allocate(gmaxp_length(0:nrank_g))
rd = gmaxp/(DBLE(nrank_g)**(1.0d0/3.0d0))
@@ -2994,16 +3046,15 @@ contains
gmax2 = gmax*2
gmax2_pstrn = gmax_positron*2
+! =========== KT_add ================================ 13.0F
+ gmax2_exx = gmax_exx*2
+! =================================================== 13.0F
call adjust_n_rGv_to_2l3m5n ! -(contained here) fft_box_size_WF,CD -> n_rGV,n_rGpv
allocate(G_length_in_cube(2*n_rGpv(1)+3,2*n_rGpv(2)+3, 2*n_rGpv(3)+3))
-#ifdef FJ_TIMER
- call timer_sta(42)
-#endif
+ __TIMER_FJ_START(42)
call count_Gvectors_in_spheres
-#ifdef FJ_TIMER
- call timer_end(42)
-#endif
+ __TIMER_FJ_STOP(42)
call G_vectors_alloc ! ngabc
@@ -3012,20 +3063,13 @@ contains
!f allocate(gr_t(kgp))
-#ifdef FJ_TIMER
- call timer_sta(43)
-#endif
+ __TIMER_FJ_START(43)
call get_Gvectors_in_a_gmaxp_sphere
-#ifdef FJ_TIMER
- call timer_end(43)
-#endif
+ __TIMER_FJ_STOP(43)
!comm
! interface for ngabc
-#ifdef FJ_TIMER
- call mpi_barrier(mpi_comm_group, ierr)
- call timer_sta(44)
-#endif
+ __TIMER_FJ_START_w_BARRIER(mpi_comm_group,44)
call mpi_allgather(kgp_wk,1,mpi_integer,kgp_buff(0),1,mpi_integer,mpi_ke_world,ierr)
do i = 1,nrank_g-1
kgp_addr(i) = kgp_buff(i-1) + kgp_addr(i-1)
@@ -3034,9 +3078,7 @@ contains
call mpi_allgatherv(ngabc_wk(1,1),kgp_wk,mpi_integer,ngabc(1,1),kgp_buff,kgp_addr,mpi_integer,mpi_ke_world,ierr)
call mpi_allgatherv(ngabc_wk(1,2),kgp_wk,mpi_integer,ngabc(1,2),kgp_buff,kgp_addr,mpi_integer,mpi_ke_world,ierr)
call mpi_allgatherv(ngabc_wk(1,3),kgp_wk,mpi_integer,ngabc(1,3),kgp_buff,kgp_addr,mpi_integer,mpi_ke_world,ierr)
-#ifdef FJ_TIMER
- call timer_end(44)
-#endif
+ __TIMER_FJ_STOP(44)
deallocate(kgp_buff,kgp_addr,ngabc_wk,gr_t)
!f deallocate(gr_t)
@@ -3059,9 +3101,7 @@ contains
kg = 0
kgp_wk = 0
!!$ if(sw_positron /= OFF) kg_pwf = 0
-#ifdef __TIMER_INIDO__
- call timer_sta(1347)
-#endif
+ __TIMER_INIDO_START(1347)
do k = -n_rGpv(3)-1, n_rGpv(3)+1
do j = -n_rGpv(2)-1, n_rGpv(2)+1
do i = -n_rGpv(1)-1, n_rGpv(1)+1
@@ -3093,9 +3133,7 @@ contains
enddo
enddo
enddo
-#ifdef __TIMER_INIDO__
- call timer_end(1347)
-#endif
+ __TIMER_INIDO_STOP(1347)
if(ipri >= 2) then
write(nfout,'(" -- gr_t -- <<m_pwBS_generate_G_vectors>>")')
do i = 1, min(20, kgp_wk)
@@ -3112,13 +3150,9 @@ contains
!!$ call shellsort(nfout,ipri,ttr,kgp,kgp,ngabc)
!!$call sort_gvec_heap2(ttr,kgp,kgp,ngabc,gr_t)
!f call sort_gvec_heap3(ttr,kgp,kgp,ngabc,gr_t)
-#ifdef __TIMER_INIDO__
- call timer_sta(1348)
-#endif
+ __TIMER_INIDO_START(1348)
call sort_gvec_heap3(ttr,kgp_wk,kgp_wk,ngabc_wk,gr_t)
-#ifdef __TIMER_INIDO__
- call timer_end(1348)
-#endif
+ __TIMER_INIDO_STOP(1348)
if(ipri >= 2) then
write(nfout,'(" -- gr after (sort_gvec_heap2) -- <<m_pwBS_generate_G_vectors>>")')
do i = 1, min(20, kgp_wk)
@@ -3129,22 +3163,14 @@ contains
end do
end if
!f call shellsort2(nfout,ipri,ttr,kgp,kgp,ngabc,gr_t)
-#ifdef __TIMER_INIDO__
- call timer_sta(1349)
-#endif
+ __TIMER_INIDO_START(1349)
call shellsort2(nfout,ipri,ttr,kgp_wk,kgp_wk,ngabc_wk,gr_t)
-#ifdef __TIMER_INIDO__
- call timer_end(1349)
-#endif
+ __TIMER_INIDO_STOP(1349)
#elif _SIMPLE_SORT_
! Sorting G simply (M.Okamoto)
-#ifdef __TIMER_INIDO__
- call timer_sta(1350)
-#endif
+ __TIMER_INIDO_START(1350)
call sort_gvec_simple(ttr,kgp,kgp,ngabc)
-#ifdef __TIMER_INIDO__
- call timer_end(1350)
-#endif
+ __TIMER_INIDO_STOP(1350)
#else
! _BLUGEL_SORT_ ! Sorting G by Blugel
!!$ call gsort(ttr,kgp,kgp,ngabc)
@@ -3171,14 +3197,24 @@ contains
call getttr(rltv,ttr)
kg = 0
kgp = 0
+ kgp_reduced = 0
kg0 = 0
!f-----
kgp_wk = 0
!------
+! =========== KT_add ================================ 13.0F
+ if (sw_hybrid_functional /= OFF .and. use_fft_exx ) then
+ kg_exx = 0
+ endif
+ if (sw_hybrid_functional /= OFF ) kgp_exx = 0
+! =================================================== 13.0F
+
+! ==== KT_add ============= 13.0U2
+ if ( sw_modified_TFW_functional /= OFF ) kg_tfw = 0
+! ========================= 13.0U2
+
if(sw_positron /= OFF) kg_pwf = 0
-#ifdef __TIMER_INIDO__
- call timer_sta(1351)
-#endif
+ __TIMER_INIDO_START(1351)
do k = -n_rGpv(3)-1, n_rGpv(3)+1
do j = -n_rGpv(2)-1, n_rGpv(2)+1
do i = -n_rGpv(1)-1, n_rGpv(1)+1
@@ -3188,6 +3224,27 @@ contains
if(length_of_Gvector <= gmax2) kg = kg + 1
if(length_of_Gvector <= gmax) kg0 = kg0 + 1
if(sw_positron/=OFF .and. length_of_Gvector<=gmax2_pstrn) kg_pwf=kg_pwf+1
+! =========== KT_add ================================ 13.0F
+ if(sw_hybrid_functional/=OFF .and. use_fft_exx ) then
+ if ( length_of_Gvector<=gmax2_exx) then
+ kg_exx = kg_exx +1
+ endif
+ endif
+ if(sw_hybrid_functional /= OFF) then
+ if( length_of_Gvector <= gmaxp_exx) then
+ kgp_exx = kgp_exx+1
+ endif
+ endif
+! =================================================== 13.0F
+
+! ============ KT_add ========== 13.0U2
+ if ( sw_modified_TFW_functional /= OFF ) then
+ if ( length_of_Gvector<= gmaxp/2 ) then
+ kg_tfw = kg_tfw +1
+ endif
+ endif
+! ============================== 13.0U2
+
if(length_of_Gvector <= gmaxp) kgp = kgp + 1
G_length_in_cube(i+n_rGpv(1)+2,j+n_rGpv(2)+2, k+n_rGpv(3)+2) = length_of_Gvector
!f-----
@@ -3206,9 +3263,7 @@ contains
enddo
enddo
enddo
-#ifdef __TIMER_INIDO__
- call timer_end(1351)
-#endif
+ __TIMER_INIDO_STOP(1351)
if(ipri >= 1) then
write(nfout,'(" !pwBS kg0, kg, kgp = ",3i10)') kg0, kg, kgp
write(nfout,'(" !pwBS kg0 = (#G(<=Gmax)), kg = (#G(<=2Gmax)), kgp = (#G(<=Gmaxp))")')
@@ -3718,4 +3773,14 @@ contains
if(allocated(ngabc)) deallocate(ngabc)
end subroutine m_pwBS_dealloc_ngabc
+! ==== EXP_CELLOPT === 2015/09/24
+ subroutine m_pwBS_store_prev_kg1_kgp
+ kg1_prev = kg1; kgp_prev = kgp
+ if ( mype == 0 ) then
+ write(nfout,*) '** kg1_prev is ', kg1_prev
+ write(nfout,*) '** kgp_prev is ', kgp_prev
+ endif
+ end subroutine m_pwBS_store_prev_kg1_kgp
+! =================== 2015/09/24
+
end module m_PlaneWaveBasisSet
diff -uprN phase0_2015.01/src_phase_3d/m_Positron_Wave_Functions.F90 phase0_2015.01.01/src_phase_3d/m_Positron_Wave_Functions.F90
--- phase0_2015.01/src_phase_3d/m_Positron_Wave_Functions.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Positron_Wave_Functions.F90 2016-07-12 12:51:53.000000000 +0900
@@ -15,9 +15,9 @@
!
!=======================================================================
module m_Positron_Wave_Functions
-! $Id: m_Positron_Wave_Functions.F90 417 2014-12-22 11:44:44Z yamasaki $
+! $Id: m_Positron_Wave_Functions.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Const_Parameters, only : DP,POSITRON,OFF,ON,DIRECT,INVERSE, DELTAevdff, SD, MSD &
- & , DENSITY_ONLY, VTK, CUBE
+ & , DENSITY_ONLY, VTK, CUBE, SmallestPositiveNumber
use m_Control_Parameters, only : af, nspin, npeg,kimg,ipripositron &
& , delta_pev, evaluation_pev_diff &
& , num_extra_pev, sw_gga_p, sw_epsilon_ele, epsilon_ele &
@@ -37,7 +37,7 @@ module m_Positron_Wave_Functions
use m_Crystal_Structure, only : univol
use m_PlaneWaveBasisSet, only : kg_pwf, kg1_pwf, igf_pstrn, igfp_l, igfp_nonpara &
& , m_pwBS_pstrn_kinetic_energies
- use m_Electronic_Structure,only: vlhxc_l
+!! use m_Electronic_Structure,only: vlhxc_l
use m_Parallelization, only : mype, npes, ista_kngp, iend_kngp &
& , ista_sfftph, iend_sfftph, ierr, mpi_comm_group
use m_FFT, only : nfft, nfftp, nfftp_nonpara, nfft_pstrn, fft_box_size_pWF &
@@ -49,7 +49,7 @@ module m_Positron_Wave_Functions
use m_Crystal_Structure, only : altv
use m_Ionic_System, only : ntyp,ityp,zfm3_l,natm2, iatomn &
& , m_IS_pack_all_ions_in_uc
- use m_epc_potential, only : tchgr_l, grad_tchgr_l
+ use m_epc_potential, only : tchgr_l, grad_tchgr_l, vlhxc_p
use m_PseudoPotential, only : rhchg_l, ival
implicit none
@@ -58,6 +58,7 @@ module m_Positron_Wave_Functions
real(kind=DP),allocatable,dimension(:,:,:) :: pzaj ! positron wave functions d(kg1_pwf,npeg,kimg)
real(kind=DP),allocatable,dimension(:,:,:) :: pzaj_old ! d(kg1_pwf,npeg,kimg)
real(kind=DP),allocatable,dimension(:,:) :: pchg_l ! positron charge in g-space, d(ista_kngp:iend_kngp,kimg)
+ real(kind=DP),allocatable,dimension(:,:) :: pchgo_l ! positron charge in g-space, d(ista_kngp:iend_kngp,kimg)
real(kind=DP),allocatable,dimension(:) :: pchr_l ! positron charge in r-space, d(ista_sfftph:iend_sfftph)
integer, allocatable, dimension(:) :: npeordr, nprvf_ordr !d(npeg)
real(kind=DP),allocatable,dimension(:) :: pev, pev1 ! d(npeg)
@@ -89,12 +90,14 @@ contains
allocate(pev1(1:npeg)); pev1 = 0.d0
allocate(pevdff(3))
allocate(pchg_l(ista_kngp:iend_kngp,kimg))
+ allocate(pchgo_l(ista_kngp:iend_kngp,kimg))
allocate(pchr_l(ista_sfftph:iend_sfftph))
end subroutine m_pWF_allocate_pzaj_etc
subroutine m_pWF_deallocate_pzaj_etc()
if(allocated(pchr_l)) deallocate(pchr_l)
if(allocated(pchg_l)) deallocate(pchg_l)
+ if(allocated(pchgo_l)) deallocate(pchgo_l)
if(allocated(pevdff)) deallocate(pevdff)
if(allocated(pev)) deallocate(pev)
if(allocated(pev1)) deallocate(pev1)
@@ -213,8 +216,12 @@ contains
evr = pzaj(i,ib,1)
devr = (ekin(i) - pev(ib))*evr + VlocalpW(i1)*denom
wdi = ekin(i) + vlhxc0 - pev(ib)
- fdexp = dexp( -p(i) * wdi * dtim)
- pzaj(i,ib,1) = (fdexp - 1) * devr/wdi + evr
+ if (dabs(wdi) < SmallestPositiveNumber) then
+ pzaj(i,ib,1) = -p(i)*devr*dtim + evr
+ else
+ fdexp = dexp( -p(i) * wdi * dtim)
+ pzaj(i,ib,1) = (fdexp - 1) * devr/wdi + evr
+ endif
end do
else if(kimg==2) then
do i = 1, kg1_pwf
@@ -224,9 +231,14 @@ contains
devr = e1*evr+VlocalpW(2*i1-1)*denom
devi = e1*evi+VlocalpW(2*i1 )*denom
wdi = ekin(i) + vlhxc0 - pev(ib)
- fdexp = dexp( -p(i) * wdi * dtim)
- pzaj(i,ib,1) = (fdexp -1)*devr/wdi + evr
- pzaj(i,ib,kimg) = (fdexp -1)*devi/wdi + evi
+ if (dabs(wdi) < SmallestPositiveNumber) then
+ pzaj(i,ib,1) = -p(i)*devr*dtim + evr
+ pzaj(i,ib,2) = -p(i)*devi*dtim + evi
+ else
+ fdexp = dexp( -p(i) * wdi * dtim)
+ pzaj(i,ib,1) = (fdexp -1)*devr/wdi + evr
+ pzaj(i,ib,kimg) = (fdexp -1)*devi/wdi + evi
+ endif
end do
end if
end subroutine modified_sd_p
@@ -575,6 +587,10 @@ contains
! core_annihilation_rate=sss/dsqrt(4.d0*3.1415926d0)
core_annihilation_rate=sss/2.d0*univol
+#ifdef SINGLE_POSITRON
+ core_annihilation_rate = sss *univol
+#endif
+
end subroutine m_pWF_core_annihilation
subroutine m_pWF_valence_annihilation()
@@ -920,6 +936,11 @@ contains
if(nspin==1) then
valence_annihilation_rate=sss/2.d0
+
+#ifdef SINGLE_POSITRON
+ valence_annihilation_rate = sss
+#endif
+
ssk=((0.5292d0)**3)*1.d4/(2.8d0**2)/3.d0/3.1415926d0
ssk=ssk
sss=core_annihilation_rate+valence_annihilation_rate
@@ -1086,6 +1107,11 @@ subroutine m_pWF_wlifetime()
end if
end subroutine m_pWF_wlifetime
+ subroutine m_pWF_update_lifetime
+ if(ipripositron >= 1) write(nfout,*)'lifetime: ',p_old_lifetime,p_new_lifetime
+ p_old_lifetime=p_new_lifetime
+ end subroutine m_pWF_update_lifetime
+
subroutine m_pWF_wd_pzaj(nfout,comment,nc)
integer, intent(in) :: nfout, nc
character(len=nc), intent(in) :: comment
diff -uprN phase0_2015.01/src_phase_3d/m_PseudoPotential.F90 phase0_2015.01.01/src_phase_3d/m_PseudoPotential.F90
--- phase0_2015.01/src_phase_3d/m_PseudoPotential.F90 2015-09-14 15:39:35.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_PseudoPotential.F90 2016-07-12 12:51:53.000000000 +0900
@@ -3,7 +3,7 @@
#define _PAW_CONTINUE_DATA_PREVIOUS_BEFORE_201403_STYLE_
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 454 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 461 $)
!
! MODULE: m_PseudoPotential
!
@@ -72,7 +72,7 @@
module m_PseudoPotential
! (m_PP)
-! $Id: m_PseudoPotential.F90 454 2015-09-07 07:58:39Z yamasaki $
+! $Id: m_PseudoPotential.F90 461 2015-09-15 04:27:48Z ktagami $
!
! The original subroutine name was "pspot", which had been coded by
! Y. Morikawa (JRCAT-NAIR) in 1993 or ealier.
@@ -103,7 +103,7 @@ module m_PseudoPotential
! === DEBUG by tkato 2011/09/22 ================================================
! & , nspin, af, printable, PAW_switch
& , nspin, af, printable, PAW_switch, sw_fef &
- & , omega_exx, sw_rspace_hyb &
+ & , omega_exx &
! ==============================================================================
& , sw_remove_pcc_from_pawpot, sw_wannier90 &
& , sw_optimize_lattice &
@@ -1753,8 +1753,10 @@ contains
comment_statement = .false.
endif
enddo
+
select case (fn_number_of_words(str))
- case (9)
+! case (9)
+ case (4,9)
is_gncpp = pp_GNCPP1 ! = 1
pptype_char = "GNCPP1"
!!$ if(ipripp>=1 .and. .not.ppprinted) write(nfout,'(" !PP PP type --> GNCPP1")')
@@ -2488,7 +2490,7 @@ contains
if(.not.paramset) then
call coef_simpson_integration(nmesh(it),nmesh(it),xh(it),radr&
& ,wos)
- if(sw_hybrid_functional==ON.and.sw_rspace_hyb==OFF) call alloc_qitg_exx()
+ call alloc_qitg_exx()
end if
call rd_qrsps_then_iqitg_and_qitgft(is_gncpp,nfp,it,nfout,gr_l,ngshell,ngshell_range &
& ,paramset,mmt) ! m_PP
@@ -2599,7 +2601,7 @@ contains
if(.not.paramset) then
call coef_simpson_integration(nmesh(it),nmesh(it),xh(it),radr&
& ,wos)
- if(sw_hybrid_functional==ON.and.sw_rspace_hyb==OFF) call alloc_qitg_exx() ! ????????????
+ call alloc_qitg_exx() ! ????????????
end if
call rd_qrsps_iqitg_and_qitgft_soc( is_gncpp,nfp,it,nfout,gr_l, &
@@ -7346,7 +7348,7 @@ contains
endif
! ================ 2014/09/19
- if(.not.paramset .and. sw_hybrid_functional==ON .and. m_PP_include_vanderbilt_pot(it)/=SKIP.and.sw_rspace_hyb==OFF) &
+ if(.not.paramset .and. sw_hybrid_functional==ON .and. m_PP_include_vanderbilt_pot(it)/=SKIP) &
& call qitgft_qmk(it,nmm_il3,mm_il3,qrsps_mm,lcmax,h) ! in b_PseudoPotential_EXX
if(itpcc(it) == 1) then
@@ -8111,7 +8113,7 @@ contains
if(.not.paramset .and. iflag_ft == 1) call qitgft_mm() ! contained here
- if(.not.paramset .and. sw_hybrid_functional==ON .and. m_PP_include_vanderbilt_pot(it)/=SKIP.and.sw_rspace_hyb==OFF) &
+ if(.not.paramset .and. sw_hybrid_functional==ON .and. m_PP_include_vanderbilt_pot(it)/=SKIP) &
& call qitgft_qmk(it,nmm_il3,mm_il3,qrsps_mm,lcmax,h) ! in b_PseudoPotential_EXX
@@ -15435,4 +15437,53 @@ contains
if(allocated(radr)) deallocate(radr)
end subroutine m_PP_dealloc_radr
+ subroutine m_PP_rd_ival(nfp,it,nfout,ival)
+ integer, intent(in) :: nfp,it,nfout
+ real(kind=DP), intent(out) :: ival
+ call mpi_barrier(mpi_comm_group,ierr)
+ call read_natomn_ival()
+
+ contains
+ subroutine read_natomn_ival()
+ integer :: natomn, iloc,itpcc
+ if(mype == 0) then
+ rewind(nfp)
+ if(ipripp >= 2) write(nfout,'(" !PP READING POTENTIAL FILE ",i5)') nfp
+ call skip_commentlines_pp(nfp)
+ read(nfp,*) natomn,ival,iloc,itpcc
+ if(ipripp >= 2) write(nfout,110) natomn,ival,iloc,itpcc
+110 FORMAT(' !PP ',2f8.4,2I4,' : NATOMN, IVAL, ILOC, ITPCC ')
+ if( abs(iatomn(it) - natomn) > 1.d-8) then
+ if(ipripp >= 2) write(nfout,*) ' !PP iatomn.ne.natomn ',iatomn(it),natomn
+ if(iatomn(it)>=1) call phase_execution_error(INVALID_ATOMIC_NUMBER)
+ write(nfout,'(a,i4,a,f7.3)') ' !PP atomic number for element',it,':',natomn
+ end if
+ end if
+ end subroutine read_natomn_ival
+
+ subroutine skip_commentlines_pp(nf)
+ integer, intent(in) :: nf
+ integer, parameter :: len_str = 80
+ character(len=len_str) :: str
+ logical :: comment_statement
+ comment_statement = .true.
+ do while(comment_statement)
+ read(nfp,'(a80)',end=1000) str
+ if(str(1:1) == '#'.or. str(1:1) == '$' .or. str(1:1) == '!' &
+ & .or. str(1:1) == '%' .or. str(1:1) == '*') then
+ if(ipripp >= 1) write(nfout,'(a80)') str
+ else if(len(trim(str)) == 0) then
+ if(ipripp >= 1) write(nfout,'(a80)') str
+ else
+ comment_statement = .false.
+ endif
+ enddo
+ backspace(nfp)
+ return
+1000 write(nfout,'(" eof is reached")')
+ stop ' eof is reached in PP reading'
+ end subroutine skip_commentlines_pp
+
+ end subroutine m_PP_rd_ival
+
end module m_PseudoPotential
diff -uprN phase0_2015.01/src_phase_3d/m_Raman.F90 phase0_2015.01.01/src_phase_3d/m_Raman.F90
--- phase0_2015.01/src_phase_3d/m_Raman.F90 2015-09-14 15:39:43.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Raman.F90 2016-07-12 12:51:53.000000000 +0900
@@ -16,7 +16,8 @@ module m_Raman
use m_Control_Parameters, only : sw_lo_to_splitting, sw_phonon_oneshot, &
& printable, ipriphonon, &
& sw_phonon_with_epsilon, sw_calc_dielectric_tensor, &
- & num_phonon_calc_mode, sw_excitation
+ & num_phonon_calc_mode, sw_excitation, &
+ & sw_phonon, sw_calc_force, sw_use_add_proj, sw_raman
use m_Const_Parameters, only : DP, ON, OFF, FMAXVALLEN, LOWER, PAI4, CMPLDP
@@ -53,6 +54,8 @@ module m_Raman
character(len("classical") ), private, parameter :: &
& tag_classical = "classical"
!
+ character(len("sw_raman") ), private, parameter :: &
+ & tag_sw_raman = "sw_raman"
character(len("sw_phonon_with_epsilon") ), private, parameter :: &
& tag_sw_phonon_with_epsilon = "sw_phonon_with_epsilon"
character(len("sw_calc_dielectric_tensor") ), private, parameter :: &
@@ -208,12 +211,23 @@ contains
logical :: tf
if( f_selectBlock( tag_raman ) == 0) then
+! === 2015/10/19
+ if ( f_getIntValue( tag_sw_raman, iret) == 0 ) sw_raman = iret
+ if ( sw_raman == OFF ) return
+
+ if ( sw_phonon == ON ) sw_phonon_with_epsilon = on
+! === 2015/10/19
+
if ( f_getIntValue( tag_sw_phonon_with_epsilon, iret) == 0) &
& sw_phonon_with_epsilon = iret
if ( sw_phonon_with_epsilon == ON ) then
sw_excitation = ON
write(nfout,*) "!** sw_excitation is turned on"
+! === 2015/10/19
+ sw_use_add_proj = ON
+ write(nfout,*) "!** sw_use_add_proj is turned on"
+! === 2015/10/19
endif
if ( f_getStringValue( tag_raman_calc_scheme, rstr, LOWER) == 0 ) then
@@ -221,6 +235,12 @@ contains
if(tf) sw_phonon_with_epsilon = on
endif
+! === 2015/10/19
+ if ( sw_phonon_with_epsilon == ON ) then
+ if ( sw_calc_force == ON ) sw_calc_dielectric_tensor = ON
+ endif
+! === 2015/10/19
+
if ( f_getIntValue( tag_sw_calc_dielectric_tensor, iret) == 0) &
& sw_calc_dielectric_tensor = iret
@@ -323,8 +343,9 @@ contains
endif
if( f_selectBlock( tag_spectrum ) == 0) then
- if( f_getRealValue( tag_hwhm, dret,'') == 0 ) then
- raman_spectra_hwhm = dret ! in cm-1
+ if( f_getRealValue( tag_hwhm, dret,'') == 0 &
+ & .or. f_getRealValue( tag_linewidth, dret,'') == 0 ) then
+ raman_spectra_hwhm = dret ! in cm-1
if ( raman_spectra_hwhm < 0.0 ) raman_spectra_hwhm = 5.0d0
endif
@@ -375,6 +396,7 @@ contains
end subroutine m_Raman_initialize
subroutine m_Raman_print_param
+ if ( sw_raman == OFF ) return
if ( sw_phonon_with_epsilon == OFF ) return
write(nfout,'(A)') '!** ----- RAMAN setup ----- '
diff -uprN phase0_2015.01/src_phase_3d/m_ThomasFermiW_Potential.F90 phase0_2015.01.01/src_phase_3d/m_ThomasFermiW_Potential.F90
--- phase0_2015.01/src_phase_3d/m_ThomasFermiW_Potential.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_ThomasFermiW_Potential.F90 2016-07-12 12:51:53.000000000 +0900
@@ -84,7 +84,7 @@ contains
ik = ista_k
call new_radr_and_wos(ik,it) ! --> radr, wos
- rcut = rad_cov_default( iatomn(it) )
+ rcut = rad_cov_default( nint(iatomn(it)) ) ! Revised according to a report from ASMS Co.ltd, 10 March 2016.
Do il1=1, lpsmax(it)
if ( il1 == iloc(it) ) cycle
diff -uprN phase0_2015.01/src_phase_3d/m_Total_Energy.F90 phase0_2015.01.01/src_phase_3d/m_Total_Energy.F90
--- phase0_2015.01/src_phase_3d/m_Total_Energy.F90 2015-09-14 15:39:53.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Total_Energy.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 454 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_Total_Energy
!
@@ -33,7 +33,7 @@
!
module m_Total_Energy
! ( m_TE )
-! $Id: m_Total_Energy.F90 454 2015-09-07 07:58:39Z yamasaki $
+! $Id: m_Total_Energy.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Charge_Density, only : chgq_l, chgqo_l, hsr
!fj$$ use m_XC_Potential, only : vxc_l, exc, m_XC_cal_potential
use m_XC_Potential, only : vxc_l, exc,eex,ecor
@@ -148,6 +148,15 @@ module m_Total_Energy
use m_Control_Parameters, only : m_CtrlP_get_isolver_now
+! === Positron SCF ==== 2015/11/28
+ use m_Control_Parameters, only : sw_positron, npeg, positron_method
+ use m_Const_Parameters, only : positron_GGGC
+ use m_epc_potential, only : ecorr_pztr => epc, m_epc_cal_potential, vepc_l
+ use m_PlaneWaveBasisSet, only : kg1_pwf
+ use m_Positron_Wave_Functions, only : pzaj, nprvf_ordr, pchg_l, pchgo_l, pev
+ use m_PlaneWaveBasisSet, only : m_pwBS_pstrn_kinetic_energies
+! ==================== 2015/11/28
+
implicit none
include 'mpif.h'
@@ -218,6 +227,10 @@ module m_Total_Energy
real(kind=DP),private :: espinorb_old, espinorb_now
! ========================================================================== 11.0
+! === positron
+ real(kind=DP) :: ekin_pztr, elocal_pztr, ehartr_ep, eohxc_pztr
+! ===
+
integer,private, parameter :: len_str = 132
character(len=len_str),private :: str
@@ -341,6 +354,7 @@ contains
end subroutine get_kinetic_energy_directly
! ==============================================================================
+
subroutine get_xc_and_HE_of_old_CD_paw_sym
integer :: ispin, it,lmt1, lmt2, il1, im1, il2, im2, ia
@@ -542,6 +556,14 @@ contains
endif
! ================= 13.0S
+! ==== POSITRON SCF == 2015/11/28
+ if ( sw_positron /= OFF ) then
+ if ( positron_method == Positron_GGGC ) then
+ etotal0 = etotal0 +ekin_pztr +elocal_pztr +ecorr_pztr +ehartr_ep
+ endif
+ endif
+! =================== 2015/11/28
+
if(sw_dipole_correction == ON) etotal0 = etotal0 + edip
if(sw_hubbard == ON) etotal0 = etotal0 + ehub0
if(sw_hybrid_functional == ON) etotal0 = etotal0 + eexx
diff -uprN phase0_2015.01/src_phase_3d/m_Wannier90.F90 phase0_2015.01.01/src_phase_3d/m_Wannier90.F90
--- phase0_2015.01/src_phase_3d/m_Wannier90.F90 2015-09-14 15:40:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_Wannier90.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,4 +1,6 @@
#define WAN90_SAVE_MEMORY
+#define WAN90_SKIP_FFT
+#define WAN90_SPN_FORMATTED
!=======================================================================
!
! PROGRAM PHASE/0 2014.01 ($Rev: 110 $)
@@ -48,16 +50,22 @@ module m_Wannier90
& , nrank_e,myrank_e,map_e,ista_e,iend_e,istep_e,idisp_e &
& , map_z,np_e,mpi_k_world,myrank_k,map_k,ista_k,iend_k &
& , ista_snl, iend_snl, ierr, map_ek, nrank_k
-! === KT_add === 2015/02/23, 08/31
+! === KT_add === 2015/02/23, 09/02
use m_Const_Parameters, only : Delta07, zi, ON, UP, DOWN
use m_Control_Parameters, only : ndim_spinor, sw_use_hardpart_wan90, noncol, &
& spin_component_wan90
use m_Ionic_System, only : natm, ityp, cps, pos
use m_PseudoPotential, only : dk_wan, nloc, nlmta, m_PP_include_vanderbilt_pot, &
& ltp, mtp, taup, ilmt, lmta, il2p, isph, iqitg, dl2p, &
- & qitg_wan, nqitg, phirpw, psirpw
+ & qitg_wan, nqitg, phirpw, psirpw, q
use m_Electronic_Structure,only: fsr_l, fsi_l
-! ============== 2015/02/23, 08/31
+! ============== 2015/02/23, 09/02
+
+! === KT_add === 2015/09/14
+ use m_Const_Parameters, only : ELECTRON, DIRECT, INVERSE
+ use m_FFT, only : m_FFT_WF
+ use m_PlaneWaveBasisSet, only : kg1, kg
+! ============== 2015/09/14
implicit none
@@ -77,10 +85,18 @@ module m_Wannier90
integer, allocatable :: ib_inc(:) ! d(num_bands)
real(kind=DP), allocatable :: projfunc(:,:,:,:) ! d(kg1,n_proj,ista_snl:iend_snl,kimg)
-! ==== KT_add === 2015/04/13
+
+! ==== KT_add === 2015/04/13 & 09/02
real(kind=DP), allocatable :: dk_unit(:,:)
logical, allocatable :: centre_on_atom(:)
-! =============== 2015/04/13
+
+ integer, allocatable :: spn_index(:)
+ real(kind=DP), allocatable :: spn_quant_dir(:,:)
+! =============== 2015/04/13 & 09/02
+
+! ==== KT_add === 2015/09/14
+ integer, allocatable :: igf_wan90(:,:,:,:)
+! =============== 2015/09/14
include 'mpif.h' ! MPI
integer istatus(mpi_status_size) ! MPI
@@ -146,10 +162,26 @@ contains
allocate(zaxis(3,n_proj))
allocate(xaxis(3,n_proj))
allocate(zona(n_proj))
- do i=1,n_proj
- read(nfwannier,*) centre(1:3,i), lang(i), mr(i), irf(i)
- read(nfwannier,*) zaxis(1:3,i), xaxis(1:3,i), zona(i)
- end do
+
+ if ( noncol ) then
+ allocate( spn_index(n_proj) )
+ allocate( spn_quant_dir(3,n_proj) )
+ endif
+
+ if ( noncol ) then
+ do i=1,n_proj
+ read(nfwannier,*) centre(1:3,i), lang(i), mr(i), irf(i)
+ read(nfwannier,*) zaxis(1:3,i), xaxis(1:3,i), zona(i)
+!
+ read(nfwannier,*) spn_index(i), spn_quant_dir(1:3,i)
+ end do
+ else
+ do i=1,n_proj
+ read(nfwannier,*) centre(1:3,i), lang(i), mr(i), irf(i)
+ read(nfwannier,*) zaxis(1:3,i), xaxis(1:3,i), zona(i)
+ end do
+ endif
+
read(nfwannier,*)
read(nfwannier,*)
@@ -183,7 +215,7 @@ contains
close(nfwannier)
-! == KT add == 2015/02/23
+! == KT add == 2015/02/23 & 09/02
100 continue
if ( npes > 1 ) then
call mpi_bcast( calc_only_A, 1, mpi_logical, 0, mpi_comm_group, ierr )
@@ -214,6 +246,17 @@ contains
call mpi_bcast( zona, n_proj, mpi_double_precision, 0, &
& mpi_comm_group, ierr )
+ if ( noncol ) then
+ if ( mype /= 0 ) then
+ allocate( spn_index(n_proj) )
+ allocate( spn_quant_dir(3,n_proj) )
+ endif
+ call mpi_bcast( spn_index, n_proj, mpi_integer, 0, &
+ & mpi_comm_group, ierr )
+ call mpi_bcast( spn_quant_dir, 3*n_proj, mpi_double_precision, 0, &
+ & mpi_comm_group, ierr )
+ endif
+
call mpi_bcast( lang, n_proj, mpi_integer, 0, mpi_comm_group, ierr )
call mpi_bcast( mr, n_proj, mpi_integer, 0, mpi_comm_group, ierr )
call mpi_bcast( irf, n_proj, mpi_integer, 0, mpi_comm_group, ierr )
@@ -231,7 +274,7 @@ contains
endif
call mpi_bcast( exclude_bands, n_exclude, mpi_integer, 0, mpi_comm_group, ierr )
endif
-! ============= 2015/02/23
+! ============= 2015/02/23 & 09/02
num_bands = nb_wan90 - n_exclude
allocate(ib_inc(num_bands))
@@ -469,7 +512,10 @@ contains
end subroutine gather_matrix
subroutine print_mat
- integer :: ik ,m, n, ik_start, iktmp
+ integer :: ik ,m, n, ik_start, iktmp, is
+ real(kind=DP) :: theta, phi
+ complex(kind=CMPLDP) :: ztmp, z1
+ complex(kind=CMPLDP), allocatable :: spn_weight(:,:)
if ( mype /= 0 ) return
@@ -487,15 +533,37 @@ contains
write(nfwannier,*) num_bands, kv3/nspin, n_proj
if ( noncol ) then
- do ik = 1, kv3, nspin
- iktmp = ( ik -1 )/nspin +1
+ allocate( spn_weight(2,n_proj) ); spn_weight = 0.0d0
+
+ Do n=1, n_proj
+ theta = acos( spn_quant_dir(3,n) )
+ phi = atan2( spn_quant_dir(2,n), spn_quant_dir(1,n) )
+!
+ if ( spn_index(n) == 1 ) then
+ spn_weight(1,n) = exp( zi *phi /2.0d0 ) *cos( theta /2.0d0 )
+ spn_weight(2,n) = -exp( zi *phi /2.0d0 ) *sin( theta /2.0d0 )
+ else
+ spn_weight(1,n) = exp( -zi *phi /2.0d0 ) *sin( theta /2.0d0 )
+ spn_weight(2,n) = exp( -zi *phi /2.0d0 ) *cos( theta /2.0d0 )
+ endif
+ End do
+
+ do ik = 1, kv3, ndim_spinor
+ iktmp = ( ik -1 )/ndim_spinor +1
do n=1,n_proj
do m=1,num_bands
+ ztmp = 0.0d0
+ Do is=1, ndim_spinor
+ z1 = dcmplx( a_mat(m,n,ik+is-1,1), a_mat(m,n,ik+is-1,2 ) )
+ ztmp = ztmp +spn_weight(is,n) *z1
+ End do
+
write(nfwannier,'(3(1x,i5),2(1x,f18.12))') m, n, iktmp, &
- & a_mat(m,n,ik,1:2) +a_mat(m,n,ik+1,1:2)
+ & real(ztmp), aimag(ztmp)
end do
end do
end do
+ deallocate( spn_weight )
else
ik_start = 1
@@ -1306,4 +1374,345 @@ contains
end subroutine deompose_sphr_into_lm
! =========== 2015/02/23
+! ==== KT_add === 2015/09/04
+ subroutine m_Wan90_gen_mat_spn
+ integer :: npauli = 3
+
+ complex(kind=CMPLDP), allocatable :: spn_mat(:,:,:,:) ! d(neg,neg,kv3/nspin,3)
+
+ allocate( spn_mat( npauli, num_bands, num_bands, kv3/ndim_spinor) ); spn_mat = 0.d0
+
+ call contrib_softpart
+ if ( sw_use_hardpart_wan90 == ON ) call contrib_hardpart
+
+ call gather_matrix
+ call print_mat
+
+ deallocate( spn_mat )
+
+ contains
+
+ subroutine contrib_softpart
+ integer :: ik0, ik1, ik2, iktmp, is1, is2
+ integer :: ig
+ integer :: m, mi, n, ni, ib1, ib2
+ complex(kind=CMPLDP) :: zsum
+
+ real(kind=DP), allocatable :: wk_zaj(:,:)
+ real(kind=DP) :: c1, c2
+ complex(kind=CMPLDP) :: z1, z2
+
+ allocate( wk_zaj( kg1, kimg ) ); wk_zaj = 0.0d0
+
+ do ik0=1, kv3, ndim_spinor
+ if ( map_k(ik0) /= myrank_k ) cycle
+
+ iktmp = ( ik0 -1 )/ndim_spinor +1
+
+ Do is2=1, ndim_spinor
+ ik2 = ik0 +is2 -1
+
+ Do n=1, num_bands
+ ni = ib_inc(n)
+ ib2 = neordr(ni,ik2)
+
+ if ( map_e(ib2) == myrank_e ) then
+ wk_zaj(1:iba(ik2),1:kimg) = zaj_l(1:iba(ik2),map_z(ib2),ik2,1:kimg)
+ endif
+ call mpi_bcast( wk_zaj, kg1*kimg, mpi_double_precision, map_e(ib2), &
+ & mpi_k_world(myrank_k), ierr )
+
+ Do is1=1, ndim_spinor
+ ik1 = ik0 +is1 -1
+
+ do m=1,num_bands
+ mi = ib_inc(m)
+ ib1 = neordr(mi,ik1)
+
+ if ( map_e(ib1) /= myrank_e ) cycle
+
+ zsum = 0.0d0
+
+ if ( kimg == 1 ) then
+ Do ig=1, iba(ik0)
+ c1 = zaj_l(ig,map_z(ib1),ik1,1)
+ c2 = c1 *wk_zaj(ig,1)
+ zsum = zsum +c2
+ End do
+ else
+ Do ig=1, iba(ik0)
+ z1 = dcmplx( zaj_l(ig,map_z(ib1),ik1,1), &
+ & zaj_l(ig,map_z(ib1),ik1,2) )
+ z2 = conjg(z1) *dcmplx( wk_zaj(ig,1), wk_zaj(ig,2) )
+ zsum = zsum +z2
+ End Do
+ endif
+!
+ if ( is1 == 1 .and. is2 == 1 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) +zsum
+ else if ( is1 == 1 .and. is2 == 2 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) -zsum *zi
+ else if ( is1 == 2 .and. is2 == 1 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) +zsum *zi
+ else if ( is1 == 2 .and. is2 == 2 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) -zsum
+ endif
+
+ end do
+ end Do
+ end do
+ end do
+ end do
+
+ end subroutine contrib_softpart
+
+ subroutine contrib_hardpart
+ integer :: ik0, ik1, ik2, iktmp, is1, is2
+ integer :: mi, m, ni, n, ib1, ib2
+ integer :: ia, it, mdvdb, lmt1, lmt2, il1, il2, it1, it2
+ integer :: lmta1, lmta2
+ complex(kind=CMPLDP) :: zsum, wf1, wf2
+ complex(kind=CMPLDP), allocatable :: wk_fsri(:)
+
+ allocate( wk_fsri(nlmta) ); wk_fsri = 0.0d0
+
+! -- start
+ Do ik0=1, kv3, ndim_spinor
+ if ( map_k(ik0) /= myrank_k ) cycle
+
+ iktmp = ( ik0 -1 )/ndim_spinor +1
+
+ Do is2=1, ndim_spinor
+ ik2 = ik0 +is2 -1
+
+ do n=1,num_bands
+ ni = ib_inc(n)
+ ib2 = neordr(ni,ik2)
+
+ if ( map_e(ib2) == mype ) then
+ wk_fsri(:) = dcmplx( fsr_l( map_z(ib2),:,ik2 ), &
+ & fsi_l( map_z(ib2),:,ik2 ) )
+ endif
+ call mpi_bcast( wk_fsri, 2*nlmta, mpi_double_precision, &
+ & map_e(ib2), mpi_k_world(myrank_k), ierr )
+
+ Do is1=1, ndim_spinor
+ ik1 = ik0 +is1 -1
+
+ do m=1,num_bands
+ mi = ib_inc(m)
+ ib1 = neordr(mi,ik1)
+
+ if ( map_e(ib1) /= myrank_e ) cycle
+
+ zsum = 0.d0
+
+ Do ia=1, natm
+ it = ityp(ia)
+ mdvdb = m_PP_include_vanderbilt_pot(it)
+ if ( mdvdb == SKIP ) cycle
+
+ Do lmt1=1, ilmt(it)
+ il1 = ltp(lmt1,it); it1 = taup(lmt1,it)
+ lmta1 = lmta( lmt1,ia )
+ wf1 = dcmplx( fsr_l( map_z(ib1), lmta1, ik1 ), &
+ & fsi_l( map_z(ib1), lmta1, ik1 ) )
+
+ Do lmt2=1, ilmt(it)
+ il2 = ltp(lmt2,it); it2 = taup(lmt2,it)
+ lmta2 = lmta( lmt2,ia )
+ wf2 = wk_fsri(lmta2)
+
+ zsum = zsum +conjg(wf1) * wf2 *q(lmt1,lmt2,it)
+ End do
+ End Do
+ End Do
+
+ if ( is1 == 1 .and. is2 == 1 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) +zsum
+ else if ( is1 == 1 .and. is2 == 2 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) -zsum *zi
+ else if ( is1 == 2 .and. is2 == 1 ) then
+ spn_mat(1,m,n,iktmp) = spn_mat(1,m,n,iktmp) +zsum
+ spn_mat(2,m,n,iktmp) = spn_mat(2,m,n,iktmp) +zsum *zi
+ else if ( is1 == 2 .and. is2 == 2 ) then
+ spn_mat(3,m,n,iktmp) = spn_mat(3,m,n,iktmp) -zsum
+ endif
+
+ End do
+ End Do
+ End DO
+ End Do
+ End Do
+
+ deallocate( wk_fsri )
+
+ end subroutine contrib_hardpart
+
+ subroutine gather_matrix
+ complex(kind=CMPLDP), allocatable :: spn_mat_mpi(:,:,:,:) ! d(neg,neg,kv3/nspin,3)
+
+ if (npes>1) then
+ allocate(spn_mat_mpi(npauli,num_bands,num_bands,kv3/nspin) )
+ spn_mat_mpi = spn_mat
+ spn_mat = 0.d0
+ call mpi_allreduce( spn_mat_mpi, spn_mat, &
+ & num_bands*num_bands*kv3/nspin*npauli*2, &
+ & mpi_double_precision, mpi_sum, mpi_comm_group,ierr )
+ deallocate(spn_mat_mpi)
+ end if
+
+ call mpi_barrier( mpi_comm_world, ierr )
+
+ end subroutine gather_matrix
+
+ subroutine print_mat
+ integer :: ik, mi, ni, ispn, num, nsize
+ complex(kind=CMPLDP), allocatable :: work(:,:)
+
+ if ( mype /= 0 ) return
+
+ open(nfwannier,file=trim(wan90_seedname)//".spn",form="formatted")
+
+#ifdef WAN90_SPN_FORMATTED
+ write(nfwannier,*) 'Generated by PHASE noncol'
+ write(nfwannier,*) num_bands, kv3/nspin
+
+ do ik=1, kv3/nspin
+ Do mi=1, num_bands
+ Do ni=1, mi
+ Do ispn=1, 3
+ write(nfwannier,'(2f16.12)') spn_mat(ispn,mi,ni,ik)
+ End Do
+ End Do
+ End do
+ end do
+#else
+ write(nfwannier) 'Generated by PHASE noncol'
+ write(nfwannier) num_bands, kv3/nspin
+
+ nsize = num_bands *( num_bands +1 ) /2
+ allocate( work(3, nsize) ); work = 0.0d0
+
+ Do ik=1, kv3/nspin
+ num = 0
+ Do mi=1, num_bands
+ Do ni=1, mi
+ num = num +1
+ work(:,num) = spn_mat(:,mi,ni,ik)
+ End Do
+ End Do
+ write(nfwannier) ( (work(ispn,mi),ispn=1,3), mi=1, nsize )
+ End do
+ deallocate( work )
+#endif
+
+ close(nfwannier)
+
+ end subroutine print_mat
+
+ end subroutine m_Wan90_gen_mat_spn
+! ================== 2015/09/04
+
+! ==== KT_add ==== 2015/09/14
+ subroutine m_Wan90_set_igf_wan90
+ integer :: id, i
+ integer :: igf1, igf2, igf3
+ integer :: nx, ny, nz
+ integer :: nxmin, nymin, nzmin, nxmax, nymax, nzmax
+!
+ nxmin = minval( nncell(1,:,:) ); nxmax = maxval( nncell(1,:,:) );
+ nymin = minval( nncell(2,:,:) ); nymax = maxval( nncell(2,:,:) );
+ nzmin = minval( nncell(3,:,:) ); nzmax = maxval( nncell(3,:,:) );
+
+ allocate( igf_wan90( kg, nxmin:nxmax, nymin:nymax, nzmin:nzmax ) )
+ igf_wan90 = 0
+!
+ id = fft_box_size_WF(1,0)
+
+ Do nx=nxmin, nxmax
+ Do ny=nymin, nymax
+ Do nz=nzmin, nzmax
+
+ do i = 1, kg
+ igf1 = ngabc(i,1) + 1 -nx
+ igf2 = ngabc(i,2) + 1 -ny
+ igf3 = ngabc(i,3) + 1 -nz
+!
+ if ( igf1 <= 0 ) igf1 = igf1 + fft_box_size_WF(1,1)
+ if ( igf2 <= 0 ) igf2 = igf2 + fft_box_size_WF(2,1)
+ if ( igf3 <= 0 ) igf3 = igf3 + fft_box_size_WF(3,1)
+
+ igf_wan90(i,nx,ny,nz) = igf1 + (igf2-1)*id &
+ & + (igf3-1)*id*fft_box_size_WF(2,0)
+ enddo
+ End Do
+ End Do
+ End Do
+ end subroutine m_Wan90_set_igf_wan90
+
+ subroutine m_Wan90_map_WF_on_fftmesh(k1,k2,ik,psi_l,bfft,igf_in)
+ integer, intent(in) :: k1,k2,ik
+ integer, intent(in) :: igf_in(kg1)
+ real(kind=DP), intent(in),dimension(kg1,1,k1:k2,kimg) :: psi_l
+ real(kind=DP), intent(inout), dimension(nfft) :: bfft
+
+ integer :: i,i1,ri, j, i2, ii
+
+ bfft = 0.d0
+ if(k_symmetry(ik) == GAMMA) then
+ if(kimg == 1) then
+ i1 = igf_in(1)
+ bfft(i1) = psi_l(1,1,ik,1)
+#ifdef NEC_TUNE_SMP
+!CDIR NODEP
+#endif
+ do ii = 2, iba(ik)
+!!$ i = nbase(ii,1)
+ i = nbase(ii,ik)
+ i1 = igf_in(i)
+ bfft(i1) = psi_l(ii,1,ik,1)
+ j = nbase_gamma(ii,2)
+ i2 = igf_in(j)
+ bfft(i2) = psi_l(ii,1,ik,1)
+ end do
+ else if(kimg == 2) then
+ i1 = 2*igf_in(1) - 1
+ bfft(i1) = psi_l(1,1,ik,1)
+ bfft(i1+1) = psi_l(1,1,ik,2)
+#ifdef NEC_TUNE_SMP
+!CDIR NODEP
+#endif
+ do ii = 2, iba(ik)
+!!$ i = nbase(ii,1)
+ i = nbase(ii,ik)
+ i1 = 2*igf_in(i)-1
+ bfft(i1 ) = psi_l(ii,1,ik,1)
+ bfft(i1+1) = psi_l(ii,1,ik,2)
+ j = nbase_gamma(ii,2)
+ i2 = 2*igf_in(j)-1
+ bfft(i2 ) = psi_l(ii,1,ik,1)
+ bfft(i2+1) = -psi_l(ii,1,ik,2)
+ end do
+ end if
+ else
+#ifdef NEC_TUNE_SMP
+!CDIR NOLOOPCHG
+#endif
+ do ri = 1, kimg
+#ifdef NEC_TUNE_SMP
+!CDIR NODEP
+#endif
+ do i = 1, iba(ik)
+ i1 = kimg*igf_in(nbase(i,ik)) + (ri - kimg)
+ bfft(i1) = psi_l(i,1,ik,ri) ! MPI
+ end do
+ end do
+ end if
+ end subroutine m_Wan90_map_WF_on_fftmesh
+! ===== 2015/09/14
+
end module m_Wannier90
diff -uprN phase0_2015.01/src_phase_3d/m_XC_Potential.F90 phase0_2015.01.01/src_phase_3d/m_XC_Potential.F90
--- phase0_2015.01/src_phase_3d/m_XC_Potential.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_XC_Potential.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 493 $)
!
! MODULE: m_XC_Potential
!
@@ -69,7 +69,7 @@
#define XC_PACK_FFT
module m_XC_Potential
-! $Id: m_XC_Potential.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: m_XC_Potential.F90 493 2016-06-01 04:57:01Z ktagami $
!
! Upgraded on 23rd Aug. 2006 by T. Yamasaki
! Differentials of the charge density function in GGA calculation are
@@ -89,7 +89,7 @@ module m_XC_Potential
use m_Crystal_Structure, only : rltv,univol
use m_Ionic_System, only : ntyp,natm,iwei,ityp,pos,zfm3_l
use m_FFT, only : fft_box_size_CD, fft_box_size_CD_c, nfftp &
- & , m_FFT_check_of_negative_CD
+ & , m_FFT_check_of_negative_CD, fft_box_size_CD_nonpara
#ifdef _MPIFFT_
use m_FFT, only : m_FFT_set_cdata &
& , lx,ly,lz,ly_d,lz_d, ny_d,nz_d
diff -uprN phase0_2015.01/src_phase_3d/m_epc_potential.F90 phase0_2015.01.01/src_phase_3d/m_epc_potential.F90
--- phase0_2015.01/src_phase_3d/m_epc_potential.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_epc_potential.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 472 $)
!
! MODULE: m_epc_potential
!
@@ -24,7 +24,7 @@
!
!
module m_epc_potential
-! $Id: m_epc_potential.F90 440 2015-08-03 07:18:01Z ktagami $
+! $Id: m_epc_potential.F90 472 2015-11-28 09:01:17Z ktagami $
use m_Electronic_Structure, only : vlhxc_l
!$$#ifdef PARA3D
use m_PlaneWaveBasisSet, only : ngabc,gr_l,igfp_l,igfp_nonpara,kg,kgp,kgp_reduced,ylm_l
@@ -56,10 +56,19 @@ module m_epc_potential
& , nis_sfftp,nie_sfftp,nel_sfftp,idisp_sfftp,np_sfftp,mp_sfftp &
& , npes_cdfft
+! === Postitron SCF === 2015/11/28
+ use m_Control_Parameters, only : positron_method
+ use m_Const_Parameters, only : positron_CONV
+ use m_Charge_Density, only : chgq_l
+ use m_PseudoPotential, only : psc_l
+! ===================== 2015/11/28
+
implicit none
include 'mpif.h'
+ real(kind=DP), pointer :: vlhxc_p( :,:,: )
+
real(kind=DP), allocatable, dimension(:,:,:) :: tchgq_l ! d(ista_kngp:iend_kngp,kimg)
real(kind=DP), allocatable, dimension(:,:) :: tchgr_l ! d(ista_sfftph:iend_sfftph,nspin)
!!$ real(kind=DP), allocatable, dimension(:) :: p_potential_l ! d(ista_kngp:iend_kngp)
@@ -98,6 +107,16 @@ contains
integer :: np0, j0, i2, j2, k2, n0
#endif
+ if ( allocated(tchgq_l) ) deallocate( tchgq_l )
+ if ( allocated(tchgr_l) ) deallocate( tchgr_l )
+ if ( allocated( grad_tchgr_l ) ) deallocate( grad_tchgr_l )
+ if ( allocated( chden_l ) ) deallocate( chden_l )
+ if ( allocated( inx ) ) deallocate( inx )
+ if ( allocated( jnx ) ) deallocate( jnx )
+ if ( allocated( knx ) ) deallocate( knx )
+ if ( allocated( vepc_l ) ) deallocate( vepc_l )
+ if ( allocated( f2or1) ) deallocate( f2or1 )
+
allocate(tchgq_l(ista_kngp:iend_kngp,kimg,nspin)); tchgq_l = 0.d0
allocate(tchgr_l(ista_sfftph:iend_sfftph,nspin)); tchgr_l = 0.d0
if(sw_gga_p == ON) then
@@ -227,6 +246,7 @@ contains
!!$ tchgq_l(:,:,1) = tchgq_l(:,:,2)
!!$ end if
+ tchgq_l = 0.0d0
do ispin = 1, nspin
do j = 1, kimg
do i = ista_kngp, iend_kngp
@@ -673,7 +693,26 @@ contains
if(npes >= 2) call tstatc0_end(id_sname)
end subroutine afft_allgatherv
-subroutine m_epc_ESlhxc_potential(nfout)
+! ==== POSITRON SCF ===== 2015/11/28
+ subroutine m_epc_alloc_vlhxc_p
+ if ( positron_method == positron_CONV ) then
+ vlhxc_p => vlhxc_l
+ else
+ if ( .not. associated( vlhxc_p ) ) then
+ allocate( vlhxc_p(ista_kngp:iend_kngp,kimg,nspin) )
+ vlhxc_p = 0.0d0
+ endif
+ endif
+ end subroutine m_epc_alloc_vlhxc_p
+
+ subroutine m_epc_dealloc_vlhxc_p
+ if ( positron_method /= positron_CONV ) then
+ if ( associated( vlhxc_p ) ) deallocate( vlhxc_p )
+ endif
+ end subroutine m_epc_dealloc_vlhxc_p
+! ======================= 2015/11/28
+
+ subroutine m_epc_ESlhxc_potential(nfout)
integer, intent(in) :: nfout
! real(kind=DP), intent(in) :: chg(ista_kngp:iend_kngp,kimg,nspin)
! real(kind=DP), intent(in) :: vxc(ista_kngp:iend_kngp,kimg,nspin)
@@ -684,26 +723,26 @@ subroutine m_epc_ESlhxc_potential(nfout)
! call tstatc0_begin('m_ESlhxc_potential ',id_sname)
- vlhxc_l = 0.d0
+ vlhxc_p = 0.d0
ist = ista_kngp
if(ist == 1) ist = 2
do is = 1, nspin
do ik = 1, kimg
- if(mype==0) vlhxc_l(1,ik,is) = vepc_l(1,ik,is)
+ if(mype==0) vlhxc_p(1,ik,is) = vepc_l(1,ik,is)
if(nspin == 1) then
do i = ist, iend_kngp !for mpi
- vlhxc_l(i,ik,is) = vepc_l(i,ik,is) -PAI4*tchgq_l(i,ik,is)&
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) -PAI4*tchgq_l(i,ik,is)&
&/gr_l(i)**2
end do
else if(nspin == 2) then
do i = ist, iend_kngp !for mpi
- vlhxc_l(i,ik,is) = vepc_l(i,ik,is) -PAI4*(tchgq_l(i,ik,UP)&
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) -PAI4*(tchgq_l(i,ik,UP)&
&+tchgq_l(i,ik,DOWN))/gr_l(i)**2
end do
endif
! do it = 1,ntyp
! do i = ista_kngp, iend_kngp !for mpi
-! vlhxc_l(i,ik,is) ! & = vlhxc_l(i,ik,is)
+! vlhxc_p(i,ik,is) ! & = vlhxc_p(i,ik,is)
!+psc_l(i,it)*zfm3_l(i,it,ik)
! end do
! end do
@@ -711,17 +750,57 @@ subroutine m_epc_ESlhxc_potential(nfout)
end do
! call tstatc0_end(id_sname)
if(ipripositron >= 3) then
- write(nfout,'(" -- vepc_l tchgq_l vlhxc_l << m_epc_ESlhxc_potential>&
+ write(nfout,'(" -- vepc_l tchgq_l vlhxc_p << m_epc_ESlhxc_potential>&
&>")')
do is = 1, nspin
if(nspin == 2) write(nfout,'(" ispin = ",i5)') is
do ik = 1, kimg
do i = ist, min(ist+20,iend_kngp)
write(nfout,'(3f10.4)') vepc_l(i,ik,is),tchgq_l(i,ik,is)&
- &,vlhxc_l(i,ik,is)
+ &,vlhxc_p(i,ik,is)
end do
end do
end do
end if
end subroutine m_epc_ESlhxc_potential
+
+! ==== POSITRON SCF ===== 2015/11/28
+ subroutine m_epc_ESlhxc_potential_mod(nfout) ! for scf
+ integer, intent(in) :: nfout
+
+ integer :: is,ik,i,it
+ integer :: ist
+ integer :: id_sname = -1
+
+ vlhxc_p = 0.d0
+ ist = ista_kngp
+
+ if(ist == 1) ist = 2
+ do is = 1, nspin
+ do ik = 1, kimg
+ if(mype==0) vlhxc_p(1,ik,is) = vepc_l(1,ik,is)
+ if(nspin == 1) then
+ do i = ist, iend_kngp !for mpi
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) &
+ & -PAI4 *chgq_l(i,ik,is) /gr_l(i)**2
+ end do
+ else if(nspin == 2) then
+ do i = ist, iend_kngp !for mpi
+ vlhxc_p(i,ik,is) = vepc_l(i,ik,is) &
+ & -PAI4*( chgq_l(i,ik,UP)&
+ & +chgq_l(i,ik,DOWN) )/gr_l(i)**2
+ end do
+ endif
+ do it = 1,ntyp
+ do i = ista_kngp, iend_kngp !for mpi
+ vlhxc_p(i,ik,is) = vlhxc_p(i,ik,is) &
+ & -psc_l(i,it) *zfm3_l(i,it,ik)
+ end do
+ end do
+ end do
+ end do
+
+ end subroutine m_epc_ESlhxc_potential_mod
+! ============== 2015/11/28
+
end module m_epc_potential
diff -uprN phase0_2015.01/src_phase_3d/m_vdWDF.F90 phase0_2015.01.01/src_phase_3d/m_vdWDF.F90
--- phase0_2015.01/src_phase_3d/m_vdWDF.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/m_vdWDF.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 (rev.375)
+! PROGRAM PHASE/0 2014.01 (rev.375)
!
! "First-principles Electronic Structure Calculation Program"
!
@@ -29,7 +29,7 @@
! Consortium.
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
-
+!
!********************************** Note ******************************************
! This program calculates the non-local correlation energy (Ecnl) and
! the local correlation energy (EcLDA) as the post calculation by utilizing
@@ -47,7 +47,23 @@
! Periodic systems are assumed.
! The atomic units (Hartree) are used.
!
+! ======= modification =====
+!
+! 2016/06/06 : by asms
+! The FFT normalization parameters are changed in order to be consistent
+! with the other subroutines.
+!
+! rho(G) = 1/V *Int rho(r) exp(-iGr); rho(r) = sum_{G} rho(G) exp(iGr)
+!
+! In the dicretized grids, rho(G) = FFT[rho(r)] /(na*nb*nc);
+! rho(r) = FFT[rho(G)]
+!
+! By this, the nonlocal vdW energy is written as
+! Encl = V**2 /2 sum_{ij} sum_{G} conjg(theta(i,G))*phi(i,j,G)*theta(i,G)
+! and
+! phi(i,j,G) = 1/V Int phi(i,j,r) exp(-iGr)
!
+! =========================
!
! ++++++++ List of subroutines ++++++
! All subroutine files listed below are included in this file.
@@ -110,107 +126,106 @@
!**********************************************************************************
#ifndef DISABLE_VDWDF
module progress_bar
- implicit none
- logical,private :: printable = .false.
- integer,private :: iend=10
- integer,private :: uni=6
- integer,private :: j=0
- logical, dimension(0:9),private :: done
-
- contains
-
- subroutine set_printable(pri)
- logical, intent(in) :: pri
- printable = pri
- end subroutine set_printable
-
- subroutine reset_progress()
- j = 0
- done = .false.
- if(printable) write(unit=uni,fmt="(a10)") "0% 100%"
- end subroutine reset_progress
-
- subroutine set_unit(un)
- integer, intent(in) :: un
- uni = un
- end subroutine set_unit
-
- subroutine set_end(en)
- integer, intent(in) :: en
- iend = en
- end subroutine set_end
-
- subroutine progress()
- use m_Const_Parameters, only : DP
- implicit none
- integer(kind=4)::k
- character(len=17)::bar="???% | |"
- integer :: jj
- real(kind=DP) :: jjj
- j = j+1
- if(j.gt.iend) j=iend
- jj = int(10*(dble(j)/dble(iend))*0.999999d0)
- if(.not.done(jj).and.j<=iend) then
- if(printable) write(unit=uni,fmt="(a1,$)") '*'
- call flush(uni)
- done(jj) = .true.
- endif
- if(j==iend.and.printable) write(unit=uni,fmt=*)
-! jjj = (dble(j)/dble(iend))
-! write(unit=bar(1:3),fmt="(i3)") int(100*jjj)
-! do k=1, jj
-! bar(6+k:6+k)="*"
-! enddo
-! ! print the progress bar.
-! write(unit=uni,fmt="(a1,a17,$)") char(13), bar
-!! write(unit=uni,fmt="(a1,a17)") char(13), bar
-! if (j/=iend) then
-! flush(unit=6)
-! else
-! write(unit=6,fmt=*)
-! do k=1,jj
-! bar(6+k:6+k) = ""
-! enddo
-! endif
- return
- end subroutine progress
+ implicit none
+ logical,private :: printable = .false.
+ integer,private :: iend=10
+ integer,private :: uni=6
+ integer,private :: j=0
+ logical, dimension(0:9),private :: done
+
+contains
+
+ subroutine set_printable(pri)
+ logical, intent(in) :: pri
+ printable = pri
+ end subroutine set_printable
+
+ subroutine reset_progress()
+ j = 0
+ done = .false.
+ if(printable) write(unit=uni,fmt="(a10)") "0% 100%"
+ end subroutine reset_progress
+
+ subroutine set_unit(un)
+ integer, intent(in) :: un
+ uni = un
+ end subroutine set_unit
+
+ subroutine set_end(en)
+ integer, intent(in) :: en
+ iend = en
+ end subroutine set_end
+
+ subroutine progress()
+ use m_Const_Parameters, only : DP
+ implicit none
+ integer(kind=4)::k
+ character(len=17)::bar="???% | |"
+ integer :: jj
+ real(kind=DP) :: jjj
+ j = j+1
+ if(j.gt.iend) j=iend
+ jj = int(10*(dble(j)/dble(iend))*0.999999d0)
+ if(.not.done(jj).and.j<=iend) then
+ if(printable) write(unit=uni,fmt="(a1,$)") '*'
+ call flush(uni)
+ done(jj) = .true.
+ endif
+ if(j==iend.and.printable) write(unit=uni,fmt=*)
+ ! jjj = (dble(j)/dble(iend))
+ ! write(unit=bar(1:3),fmt="(i3)") int(100*jjj)
+ ! do k=1, jj
+ ! bar(6+k:6+k)="*"
+ ! enddo
+ ! ! print the progress bar.
+ ! write(unit=uni,fmt="(a1,a17,$)") char(13), bar
+ !! write(unit=uni,fmt="(a1,a17)") char(13), bar
+ ! if (j/=iend) then
+ ! flush(unit=6)
+ ! else
+ ! write(unit=6,fmt=*)
+ ! do k=1,jj
+ ! bar(6+k:6+k) = ""
+ ! enddo
+ ! endif
+ return
+ end subroutine progress
end module progress_bar
module m_vdWDF
-
- use m_Const_Parameters, only : DP, ON, PAI, FMAXVALLEN, LOWER
- use m_Control_Parameters, only : printable,nspin,eval_kernel_by_interpolation,na_gl &
- & , a1,a2,dq_vdw,lambda,q0cut,ds,ndel,nphiD,nr12,nk,maxk &
- & , r12max,oneshot
+ use m_Const_Parameters, only : DP, ON, PAI, FMAXVALLEN, LOWER, CMPLDP
+ use m_Control_Parameters, only : printable,nspin,eval_kernel_by_interpolation, &
+ & na_gl,a1,a2,dq_vdw,lambda,q0cut,ds,ndel,nphiD, &
+ & nr12,nk,maxk, r12max,oneshot, ipri, &
+ & sw_save_memory_vdw, kimg, iprixc
use m_Files, only : nfout
use m_Charge_Density, only : m_CD_get_rspace_charge
use m_FFT, only : fft_box_size_CD,fft_box_size_CD_nonpara
- use m_Crystal_Structure, only : altv,univol
-
- use m_Parallelization, only : npes,mype,mpi_comm_group
+ use m_Crystal_Structure, only : altv,univol, rltv
+ use m_Parallelization, only : npes,mype,mpi_comm_group,m_Parallel_init_mpi_nq, &
+ & ista_nq,iend_nq,np_nq,mp_nq,is_nq,ie_nq,nel_nq, &
+ & map_z_nq
use m_Timing, only : tstatc0_begin,tstatc0_end
implicit none
-
include 'mpif.h'
real(kind=DP),parameter :: pi=PAI
-! Physical values
+ ! Physical values
Real(kind=DP) ExGGA,Ecnl,Ecnl_12,Ecnl_12_ab,Ecnl_3,Ecnl_3s,EcLDA
- Integer na,nb,nc,nabc
- Real(kind=DP) aa(3,3),dv
- Real(kind=DP), Allocatable :: rho(:,:,:),grad(:,:,:)
-
real(kind=DP) :: phi0=2.77d0
-
+
+ Integer na,nb,nc,nabc
+ Real(kind=DP) :: aa(3,3),dv
+ Real(kind=DP), Allocatable :: rho(:,:,:),grad(:,:,:), cgrad(:,:,:,:)
real(kind=DP),allocatable,dimension(:) :: phi_ab
-! Grid points
+ ! Grid points
!!!! Spline curves
Integer nq0
real(kind=DP) :: qa,qb,q0max,q0min
@@ -218,12 +233,12 @@ module m_vdWDF
!!!! The table of phidD
real(kind=DP), allocatable, dimension(:,:) :: phidD
-! Internal parameters
+ ! Internal parameters
Real(kind=DP),parameter :: rhomin=1.d-9
-! Real-space and reciprocal-space Functions
+ ! Real-space and reciprocal-space Functions
Complex*16, Allocatable :: theta_G(:,:,:), &
-& theta_G_ab(:,:,:,:),theta_G_a(:,:,:),theta_G_b(:,:,:)
+ & theta_G_ab(:,:,:,:),theta_G_a(:,:,:),theta_G_b(:,:,:)
Real(kind=DP), Allocatable :: theta_R(:,:,:),dtheta_R(:,:,:,:),ddtheta_R(:,:,:,:)
complex(kind=DP), allocatable, dimension(:,:,:,:) :: ualpha_g,ualpha_r
@@ -239,51 +254,97 @@ module m_vdWDF
integer, parameter :: FFTW_ESTIMATE = 64
integer, parameter :: FFTW_FORWARD = -1
integer, parameter :: FFTW_BACKWARD = +1
- contains
+
+ real(kind=DP), allocatable, dimension(:,:,:) :: dFdrho, dFddrho
+ real(kind=DP), allocatable, dimension(:,:,:) :: rkar
+
+ real(kind=DP) :: s_cnl1(3,3), s_cnl2(3,3), ecnl_vdwdf
+ real(kind=DP) :: s_cnl1_pc(3,3), s_cnl2_pc(3,3)
+
+ ! logical :: grad_rho_eq_0 = .true.
+ logical :: grad_rho_eq_0 = .false.
+
+contains
subroutine print_vdw_parameters()
if(printable)then
- write(nfout,'(a)') '-- parameters for the vdW-DF calculations --'
- write(nfout,'(a,2f15.10,i8)') ' rmax, kmax, nmesh : ',r12max,maxk,nr12
- write(nfout,'(a,3f15.10)') ' dq, lambda, and q0cut : ',dq_vdw,lambda,q0cut
- write(nfout,'(a,2f15.10,i5)') ' q0min, q0max, nq0 : ',q0min,q0max,nq0
- write(nfout,'(a,f15.10)' ) ' ds : ',ds
- write(nfout,'(a,i5,2f15.10)') ' na_gl, a1, a2 : ',na_gl,a1,a2
- if(eval_kernel_by_interpolation)then
- write(nfout,'(a)') ' kernel evaluation : by interpolation'
- write(nfout,'(a,2i8)') ' ndel, nphiD : ',ndel,nphiD
- else
- write(nfout,'(a)') ' kernel evaluation : direct'
- endif
+ write(nfout,'(a)') '-- parameters for the vdW-DF calculations --'
+ write(nfout,'(a,2f15.10,i8)') ' rmax, kmax, nmesh : ',r12max,maxk,nr12
+ write(nfout,'(a,3f15.10)') ' dq, lambda, and q0cut : ',dq_vdw,lambda,q0cut
+ write(nfout,'(a,2f15.10,i5)') ' q0min, q0max, nq0 : ',q0min,q0max,nq0
+ write(nfout,'(a,f15.10)' ) ' ds : ',ds
+ write(nfout,'(a,i5,2f15.10)') ' na_gl, a1, a2 : ',na_gl,a1,a2
+ if(eval_kernel_by_interpolation)then
+ write(nfout,'(a)') ' kernel evaluation : by interpolation'
+ write(nfout,'(a,2i8)') ' ndel, nphiD : ',ndel,nphiD
+ else
+ write(nfout,'(a)') ' kernel evaluation : direct'
+ endif
endif
end subroutine print_vdw_parameters
subroutine initialize_vdwdf_scf(nspin,ispin,na,nb,nc,chgr,grad_rho)
use progress_bar, only : set_printable
+
integer, intent(in) :: nspin,ispin,na,nb,nc
real(kind=DP), dimension(na*nb*nc), intent(in) :: chgr,grad_rho
+
integer :: i,cix,ciy,ciz,nrxyz
+ integer :: idp, mmp, nlphf, cix2, ciy2, ciz2
real(kind=DP) :: q
- call set_printable(printable)
+ call set_printable(printable)
call do_cell_params()
+
+ idp = fft_box_size_CD_nonpara(1,0)
+ mmp = fft_box_size_CD_nonpara(2,0)
+
+ if(kimg == 1) then
+ nlphf = idp/2
+ else
+ nlphf = idp
+ end if
+
rinplw = 1.d0/(dble(na*nb*nc))
q0max = q0cut*1.01d0
q0min = 0.09d0
nq0 = DINT(dLOG((q0max-q0min)*(lambda-1.d0)/dq_vdw+1.d0)/dLOG(lambda))+1
maxk = dble(nr12)/r12max
+ if(firstcall) call m_Parallel_init_mpi_nq(nfout,ipri,printable,nq0)
if(firstcall) call print_vdw_parameters()
call alloc_vdw()
- do cix = 1,na
- do ciy = 1,nb
- do ciz = 1,nc
- nrxyz=(ciz-1)*nb*na+(ciy-1)*na+cix
- rho(cix,ciy,ciz) = chgr(nrxyz)
- grad(cix,ciy,ciz) = grad_rho(nrxyz)
+
+ if ( kimg == 1 ) then
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ if ( cix > nlphf ) then
+ cix2 = idp -cix
+ ciy2 = nb +2 -ciy
+ ciz2 = nc +2 -ciz
+ if ( ciy2 > nb ) ciy2 = ciy2 -nb
+ if ( ciz2 > nc ) ciz2 = ciz2 -nc
+ else
+ cix2 = cix; ciy2 = ciy; ciz2 = ciz
+ endif
+ nrxyz=(ciz2-1)*mmp*nlphf +(ciy2-1)*nlphf +cix2
+ rho(cix,ciy,ciz) = chgr(nrxyz)
+ grad(cix,ciy,ciz) = grad_rho(nrxyz)
+ end do
+ end do
+ end do
+ else
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ nrxyz = (ciz-1)*nb*na +(ciy-1)*na +cix
+ rho(cix,ciy,ciz) = chgr(nrxyz)
+ grad(cix,ciy,ciz) = grad_rho(nrxyz)
+ end do
end do
end do
- end do
+ endif
do i=1,nq0
q = q0min + dq_vdw*(lambda**DBLE(i-1)-1.d0)/(lambda-1.d0)
@@ -291,7 +352,9 @@ module m_vdWDF
enddo
call spline0(nq0,qar,q2ar)
- if(eval_kernel_by_interpolation.and.firstcall) call build_lookup_table(ndel,nphiD,phidD)
+ if (eval_kernel_by_interpolation.and.firstcall) then
+ call build_lookup_table(ndel,nphiD,phidD)
+ endif
firstcall = .false.
end subroutine initialize_vdwdf_scf
@@ -310,6 +373,7 @@ module m_vdWDF
q0min = 0.09d0
nq0 = DINT(dLOG((q0max-q0min)*(lambda-1.d0)/dq_vdw+1.d0)/dLOG(lambda))+1
maxk = dble(nr12)/r12max
+ if(firstcall) call m_Parallel_init_mpi_nq(nfout,ipri,printable,nq0)
call alloc_vdw()
call m_CD_get_rspace_charge(nfout,na,nb,nc,rho,is)
@@ -324,9 +388,9 @@ module m_vdWDF
call spline0(nq0,qar,q2ar)
if(eval_kernel_by_interpolation)then
- if(printable) write(nfout,'(a)') 'building the lookup table for the kernel function ...'
- call build_lookup_table(ndel,nphiD,phidD)
- if(printable) write(nfout,'(a)') '... done'
+ if(printable) write(nfout,'(a)') 'building the lookup table for the kernel function ...'
+ call build_lookup_table(ndel,nphiD,phidD)
+ if(printable) write(nfout,'(a)') '... done'
endif
if(printable) write(nfout,'(a)') '... done initialization'
@@ -341,18 +405,42 @@ module m_vdWDF
aa(i,1:3) = altv(1:3,i)/dble(fft_box_size_CD(i,1))
enddo
dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
-& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
-& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
+ & + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
+ & + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
end subroutine do_cell_params
+ function real_index(iq,pe) result(res)
+ integer, intent(in) :: iq
+ integer, intent(in),optional :: pe
+ integer :: res
+ integer :: ii,mpe
+ mpe = mype
+ if(present(pe))then
+ mpe = pe
+ endif
+ if(mpe==0)then
+ res = iq
+ return
+ endif
+ res = 0
+ do ii=0,mpe-1
+ res = res+nel_nq(ii)
+ enddo
+ res = res+iq
+ return
+ end function real_index
+
subroutine alloc_vdw()
+ integer :: i,cix,ciy,ciz
+ real(kind=DP) :: Ta,Tb,Tc, vec(3), bb(3,3)
+
Allocate(rho(na,nb,nc));rho=0.d0
allocate(grad(na,nb,nc));grad=0.d0
Allocate(theta_G(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
Allocate(theta_R(na,nb,nc))
if(.not.oneshot)then
- Allocate(dtheta_R(nq0,na,nb,nc))
- Allocate(ddtheta_R(nq0,na,nb,nc))
+ Allocate(dtheta_R(np_nq,na,nb,nc))
+ Allocate(ddtheta_R(np_nq,na,nb,nc))
endif
Allocate(theta_G_a(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
Allocate(theta_G_b(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
@@ -360,17 +448,57 @@ module m_vdWDF
if(eval_kernel_by_interpolation.and.firstcall) allocate(phidD(0:ndel,-1:nphiD+1))
allocate(qar(nq0));qar = 0.d0
allocate(q2ar(nq0,nq0));q2ar = 0.d0
- allocate(theta_G_ab(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ ! allocate(theta_G_ab(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ if(sw_save_memory_vdw) then
+ allocate(theta_G_ab(np_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ else
+ allocate(theta_G_ab(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ endif
if(.not.oneshot)then
- allocate(ualpha_g(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
- allocate(ualpha_r(nq0,na,nb,nc))
+ ! allocate(ualpha_g(nq0,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ ! allocate(ualpha_r(nq0,na,nb,nc))
+ allocate(dFdrho(na,nb,nc))
+ allocate(dFddrho(na,nb,nc))
endif
+
+ allocate(rkar(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+
+#if 0
+ Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
+ Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
+ Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ rkar(cix,ciy,ciz) = &
+ & DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
+ Enddo
+ Enddo
+ Enddo
+#else
+ Do i=1, 3
+ bb(1,i) = rltv(i,1) /PAI /2.0d0
+ bb(2,i) = rltv(i,2) /PAI /2.0d0
+ bb(3,i) = rltv(i,3) /PAI /2.0d0
+ End Do
+
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ vec(1:3) = dble(cix) *bb(1,1:3) &
+ & +dble(ciy) *bb(2,1:3) &
+ & +dble(ciz) *bb(3,1:3)
+ rkar(cix,ciy,ciz) = DSQRT( vec(1)**2 +vec(2)**2 +vec(3)**2 )
+ End Do
+ End Do
+ End Do
+#endif
end subroutine alloc_vdw
subroutine finalize_vdwdf()
call dealloc()
- contains
+ contains
subroutine dealloc()
deallocate(rho)
deallocate(grad)
@@ -388,9 +516,14 @@ module m_vdWDF
deallocate(q2ar)
deallocate(theta_G_ab)
if(.not.oneshot)then
- deallocate(ualpha_g)
- deallocate(ualpha_r)
+ ! deallocate(ualpha_g)
+ ! deallocate(ualpha_r)
+ deallocate(dFdrho)
+ deallocate(dFddrho)
endif
+ deallocate(rkar)
+ !
+ if ( allocated( cgrad ) ) deallocate( cgrad )
end subroutine dealloc
end subroutine finalize_vdwdf
@@ -404,28 +537,32 @@ module m_vdWDF
real(kind=DP) :: ddel,dphiD
integer :: ierr
integer :: id_sname=-1
+
call tstatc0_begin('build_lookup_table ',id_sname,1)
+
phidD = 0.d0
- ddel = 1/dble(ndel)
+ ddel = 1.d0 /dble(ndel)
dphiD = (q0max*eta1-q0min*etai)/(dble(nphiD))
+
if(oneshot) then
call reset_progress()
call set_end(int(floor(dble(ndel+1)/dble(npes))))
endif
+
do cdel=0,ndel
if(mod(cdel,npes)/=mype) cycle
if(oneshot) call progress()
do cphiD = -1,nphiD+1
del = dble(cdel)*ddel
phiD = q0min*etai + dble(cphiD)*dphiD
- di = phiD*(1+del)
- dk = phiD*(1-del)
+ di = phiD*(1.d0+del)
+ dk = phiD*(1.d0-del)
Call kernel_phi(di,dk,tmp)
phidD(cdel,cphiD) = tmp
enddo
enddo
if(npes>1) &
- & call mpi_allreduce(MPI_IN_PLACE,phidD,(ndel+1)*(nphiD+2),mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ & call mpi_allreduce(MPI_IN_PLACE,phidD,(ndel+1)*(nphiD+2),mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
call tstatc0_end(id_sname)
end subroutine build_lookup_table
@@ -434,15 +571,18 @@ module m_vdWDF
integer :: cqa,ierr
integer :: id_sname = -1
real(kind=DP),allocatable,dimension(:,:,:) :: tmpdr,tmpddr
+
call tstatc0_begin('build_theta ',id_sname,1)
-!+++++++++++++++ Execute FFT for theta_R_ab ++++++++++++++++++++
+
+ !+++++++++++++++ Execute FFT for theta_R_ab ++++++++++++++++++++
if(printable.and.oneshot) &
- & write(nfout,'(a)') 'building theta (spline coefficient x rho) and their Fourier transforms ...'
+ & write(nfout,'(a)') 'building theta (spline coefficient x rho) and their Fourier transforms ...'
if(oneshot)then
call reset_progress()
call set_end(int(floor(dble(nq0)/dble(npes))))
endif
theta_G_ab(:,:,:,:) = (0.d0,0.d0)
+
if(.not.oneshot)then
allocate(tmpdr(na,nb,nc));tmpdr=0.d0
allocate(tmpddr(na,nb,nc));tmpddr=0.d0
@@ -451,32 +591,31 @@ module m_vdWDF
allocate(tmpdr(1,1,1))
allocate(tmpddr(1,1,1))
endif
- Do cqa = 1,nq0
- if(mod(cqa,npes)/=mype) cycle
+ Do cqa = ista_nq,iend_nq
if(oneshot) call progress()
Call theta_ab(na,nb,nc,cqa,nq0,q0min,q0max,rho,grad,rhomin,theta_R,tmpdr,tmpddr)
Call RtoG(na,nb,nc,theta_R,theta_G)
- theta_G_ab(cqa,:,:,:) = theta_G(:,:,:)
+ if(sw_save_memory_vdw)then
+ theta_G_ab(map_z_nq(cqa),:,:,:) = theta_G(:,:,:)
+ else
+ theta_G_ab(cqa,:,:,:) = theta_G(:,:,:)
+ endif
if(.not.oneshot)then
- dtheta_R (cqa,:,:,:) = tmpdr (:,:,:)
- ddtheta_R (cqa,:,:,:) = tmpddr (:,:,:)
+ dtheta_R (map_z_nq(cqa),:,:,:) = tmpdr (:,:,:)
+ ddtheta_R (map_z_nq(cqa),:,:,:) = tmpddr (:,:,:)
endif
Enddo
+
+ if(.not.sw_save_memory_vdw)then
+ call mpi_allreduce(MPI_IN_PLACE,theta_G_ab,nq0*na*nb*nc,mpi_double_complex, &
+ & mpi_sum,mpi_comm_group,ierr)
+ endif
deallocate(tmpdr)
deallocate(tmpddr)
- if(npes>1) then
- call mpi_allreduce(MPI_IN_PLACE,theta_G_ab(1,-(na/2-1),-(nb/2-1),-(nc/2-1)), &
- & nq0*na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
- if(.not.oneshot)then
- call mpi_allreduce(MPI_IN_PLACE,dtheta_R(1,1,1,1), &
- & nq0*na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
- call mpi_allreduce(MPI_IN_PLACE,ddtheta_R(1,1,1,1), &
- & nq0*na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
- endif
- endif
+
if(printable.and.oneshot) write(nfout,'(a)') '... done'
call tstatc0_end(id_sname)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
end subroutine build_theta
subroutine phiab_by_interpl(ca,cb,nr12,phi_ab)
@@ -493,6 +632,7 @@ module m_vdWDF
real(kind=DP) :: phi1u
integer :: id_sname=-1
+
call tstatc0_begin('phiab ',id_sname,1)
phi_ab = 0.d0
@@ -501,8 +641,8 @@ module m_vdWDF
qb = qar(cb)
qab = DSQRT(qa**2+qb**2)
-! Coefficients phi2 and phi4 in the local part is determined to
-! match the non-local part in value and slope at d=d_s.
+ ! Coefficients phi2 and phi4 in the local part is determined to
+ ! match the non-local part in value and slope at d=d_s.
rs = ds/qab
@@ -520,7 +660,7 @@ module m_vdWDF
phi4 = (-1.d0/ds**4)*(phid_s-phi0) + (rs/(2.d0*ds**4))*d_phid_s
i = DINT((ds/qab)/dr12)
-! Non-local part of phi_ab(r12)
+ ! Non-local part of phi_ab(r12)
if(i.ge.nr12)return
ddel = 1/dble(ndel)
do cr12 = i+1,nr12
@@ -533,18 +673,18 @@ module m_vdWDF
phiD = 0.5d0*(di+dk)
cdel = DINT(del/ddel)
cphiD = DINT(DBLE(nphiD)*(phiD-q0min*etai)/(q0max*eta1-q0min*etai))
-! write(6,*) 'cdel, cphiD: ',cdel,cphiD
+ ! write(6,*) 'cdel, cphiD: ',cdel,cphiD
if(cdel.ge.ndel.or.cphiD.ge.nphiD.or.cdel.lt.0.or.cphiD.lt.-1)cycle
phix = del/ddel - dble(cdel)
phiy = dble(nphiD)*(phiD-q0min*etai)/(q0max*eta1-q0min*etai) - dble(cphiD)
- phi1u = (1-phix)*(1-phiy) * phidD(cdel ,cphiD ) &
-& + phix *(1-phiy) * phidD(cdel+1,cphiD ) &
-& +(1-phix)* phiy * phidD(cdel ,cphiD+1) &
-& + phix * phiy * phidD(cdel+1,cphiD+1)
+ phi1u = (1.d0-phix)*(1.d0-phiy) * phidD(cdel ,cphiD ) &
+ & + phix *(1.d0-phiy) * phidD(cdel+1,cphiD ) &
+ & +(1.d0-phix)* phiy * phidD(cdel ,cphiD+1) &
+ & + phix * phiy * phidD(cdel+1,cphiD+1)
phi_ab(cr12) = phi1u
enddo
-! Local part of phi_ab(r12)
+ ! Local part of phi_ab(r12)
Do cr12 = 0,i
r12 = DBLE(cr12)*dr12
@@ -556,20 +696,20 @@ module m_vdWDF
call tstatc0_end(id_sname)
end subroutine phiab_by_interpl
-!** SUBROUTINE phiab **************************************************************************
+ !** SUBROUTINE phiab **************************************************************************
Subroutine phiab(ca,cb,nr12,phi_ab)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer,intent(in) :: ca,cb,nr12
Real(kind=DP),intent(out) :: phi_ab(0:nr12)
-! Internal valuables
+ ! Internal valuables
Integer cr12,i
Real(kind=DP) qab,qa,qb,r12,rs,phiD,dr12,phi2,phi4,phid_s,phid_s1,d_phid_s,d1,d2,abs_d
Real(kind=DP) di,dk,tmp,dr
Parameter(dr=0.001d0)
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
integer :: id_sname=-1
call tstatc0_begin('phiab ',id_sname,1)
@@ -577,9 +717,9 @@ module m_vdWDF
qa = qar(ca)
qb = qar(cb)
qab = DSQRT(qa**2+qb**2)
-
-! Coefficients phi2 and phi4 in the local part is determined to
-! match the non-local part in value and slope at d=d_s.
+
+ ! Coefficients phi2 and phi4 in the local part is determined to
+ ! match the non-local part in value and slope at d=d_s.
rs = ds/qab
@@ -590,159 +730,439 @@ module m_vdWDF
di = qa*(rs+dr)
dk = qb*(rs+dr)
Call kernel_phi(di,dk,phid_s1)
-
+
d_phid_s = (phid_s1 - phid_s)/dr
-
+
phi2 = ( 2.d0/ds**2)*(phid_s-phi0) - (rs/(2.d0*ds**2))*d_phid_s
phi4 = (-1.d0/ds**4)*(phid_s-phi0) + (rs/(2.d0*ds**4))*d_phid_s
i = DINT((ds/qab)/dr12)
-! Non-local part of phi_ab(r12)
+ ! Non-local part of phi_ab(r12)
if(i.ge.nr12)return
+
Do cr12 = i+1,nr12
r12 = DBLE(cr12)*dr12
-
+
di = qa*r12
dk = qb*r12
-
+
Call kernel_phi(di,dk,tmp)
phi_ab(cr12) = tmp
-
+
Enddo
-
-! Local part of phi_ab(r12)
+
+ ! Local part of phi_ab(r12)
Do cr12 = 0,i
r12 = DBLE(cr12)*dr12
-
+
d1 = qa*r12
d2 = qb*r12
phiD = qab*r12
phi_ab(cr12) = phi0 + phi2*phiD**2 + phi4*phiD**4
Enddo
-
+
call tstatc0_end(id_sname)
End subroutine phiab
-!** End SUBROUTINE phiab **********************************************************************
+ !** End SUBROUTINE phiab **********************************************************************
- subroutine vdWdf_core()
+ subroutine vdWdf()
+ if(sw_save_memory_vdw) then
+ call vdWdf_core()
+ !call vdWdf_core2()
+ else
+ call vdWdf_core_org()
+ endif
+ end subroutine vdWdf
+
+ subroutine vdWdf_core_org()
use progress_bar
real(kind=DP) :: fac
- integer :: cqa,cqb,ierr
- integer,allocatable,dimension(:,:) :: ind
- integer :: i,ic,i1,i2,i3
+ integer :: cqaa,cqa,cqb,ierr
+ integer :: i,ic,i2,i3
complex(kind=DP), allocatable, dimension(:,:,:) :: tmpug,tmpur
integer :: id_sname = -1
+ integer :: id_sname3 = -1
+
call tstatc0_begin('vdWdf_core ',id_sname,1)
Ecnl_12 = 0.0d0
if(printable.and.oneshot) &
- & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
- allocate(ind(int(nq0*(nq0-1)*0.5+nq0),2));ind=0
- ic=0
-! do cqa=1,nq0
-! do cqb=cqa,nq0
-! ic=ic+1
-! ind(ic,1) = cqa
-! ind(ic,2) = cqb
-! enddo
-! enddo
+ & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
if(oneshot)then
call reset_progress()
- !call set_end(int(floor(dble(ic)/dble(npes))))
call set_end(int(floor(dble(nq0)/dble(npes))))
endif
if(.not.oneshot)then
allocate(tmpug(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));tmpug=0.d0
- ualpha_g = (0.d0,0.d0)
+ allocate(tmpur(na,nb,nc));tmpur=0.d0
+ ! ualpha_g = (0.d0,0.d0)
else
allocate(tmpug(1,1,1))
endif
-! do i=1,ic
- do cqa=1,nq0
- if(mod(cqa,npes)/=mype) cycle
- theta_G_a(:,:,:) = theta_G_ab(cqa,:,:,:)
- if(.not.oneshot) tmpug=(0.d0,0.d0)
- if(oneshot) call progress()
-! do cqb=cqa,nq0
- do cqb=1,nq0
- !cqa = ind(i,1)
- !cqb = ind(i,2)
- theta_G_b(:,:,:) = theta_G_ab(cqb,:,:,:)
-! fac=2.d0
-! if (cqa.eq.cqb) fac=1.d0
- fac = 1.d0
- if(eval_kernel_by_interpolation) then
- call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
- else
- Call phiab(cqa,cqb,nr12,phi_ab)
+ if(.not.oneshot)then
+ dFdrho=0.d0;dFddrho=0.d0
+ endif
+
+ do cqaa=1,np_nq
+ cqa = real_index(cqaa)
+ theta_G_a(:,:,:) = theta_G_ab(cqa,:,:,:)
+ if (.not.oneshot) tmpug=(0.d0,0.d0)
+ if (oneshot) call progress()
+ call tstatc0_begin('vdw_core_core ',id_sname3,1)
+ do cqb=1,nq0
+ theta_G_b(:,:,:) = theta_G_ab(cqb,:,:,:)
+ fac = 1.d0
+ if(eval_kernel_by_interpolation) then
+ call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
+ else
+ Call phiab(cqa,cqb,nr12,phi_ab)
+ endif
+ Call convolution_3d_by_fft(&
+ & na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
+ Ecnl_12 = Ecnl_12 + Ecnl_12_ab
+ enddo
+ call tstatc0_end(id_sname3)
+ if(.not.oneshot)then
+ call GtoR(na,nb,nc,tmpur,tmpug)
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(cqaa,:,:,:)
+ dFddrho(:,:,:) = dFddrho(:,:,:) + dble(tmpur(:,:,:))*ddtheta_R(cqaa,:,:,:)
endif
- Call convolution_3d_by_fft(na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
-
- Ecnl_12 = Ecnl_12 + Ecnl_12_ab
- enddo
- if(.not.oneshot) ualpha_g(cqa,:,:,:) = tmpug(:,:,:)
enddo
if(.not.oneshot)then
- if(npes>1) &
- & call mpi_allreduce(MPI_IN_PLACE,ualpha_g, &
- & nq0*na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,dFdrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,dFddrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ deallocate(tmpur)
+ endif
+ deallocate(tmpug)
+ endif
+
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,Ecnl_12,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ endif
+ if(printable.and.oneshot) write(nfout,'(a)') '... done'
+ call tstatc0_end(id_sname)
+
+ end subroutine vdWdf_core_org
+
+ subroutine vdWdf_core()
+ use progress_bar
+ real(kind=DP) :: fac, grho, rtmp, esum
+ integer :: cqaa,cqa,cqb,ierr
+ integer :: i,ic,i2,i3, cix, ciy ,ciz
+ complex(kind=DP), allocatable, dimension(:,:,:) :: tmpug,tmpur
+ complex(kind=DP), allocatable, dimension(:,:,:,:) :: theta_buf_s,theta_buf_r
+ integer :: ipos,i0,i1,isend,irecv,ireq,ireqr
+ integer, allocatable, dimension(:) :: ista
+ integer :: id_sname = -1, id_sname2 = -1, id_sname3 = -1
+
+ Ecnl_12 = 0.0d0
+ esum = 0.0d0
+
+ call tstatc0_begin('vdWdf_core ',id_sname,1)
+ if(printable.and.oneshot) &
+ & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
+
+ if(oneshot)then
+ call reset_progress()
+ call set_end(int(floor(dble(nq0)/dble(npes))))
+ endif
+
+ if(npes>1)then
+ allocate(ista(MPI_STATUS_SIZE))
+ allocate(theta_buf_r(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));theta_buf_r=(0.d0,0.d0)
endif
if(.not.oneshot)then
- ualpha_r = (0.d0,0.d0)
+ allocate(tmpug(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));tmpug=0.d0
allocate(tmpur(na,nb,nc));tmpur=0.d0
- do i=1,nq0
- if(mod(i,npes)/=mype) cycle
- tmpug(:,:,:) = ualpha_g(i,:,:,:)
- call GtoR(na,nb,nc,tmpur,tmpug)
- ualpha_r(i,:,:,:) = tmpur(:,:,:)
- enddo
- deallocate(tmpur)
+ ! ualpha_g = (0.d0,0.d0)
+ else
+ allocate(tmpug(1,1,1))
endif
+ if(.not.oneshot)then
+ dFdrho=0.d0;dFddrho=0.d0
+ endif
+
+ irecv = mype+1
+ if(irecv.ge.npes) irecv = irecv-npes
+ isend = mype-1
+ if(isend.lt.0) isend = isend+npes
+
+ do cqaa=1,mp_nq
+ cqa = real_index(cqaa)
+ if (npes>1) theta_buf_r(1:np_nq,:,:,:) = theta_G_ab(1:np_nq,:,:,:)
+ if (cqaa.le.np_nq) theta_G_a(:,:,:) = theta_G_ab(cqaa,:,:,:)
+
+ if (.not.oneshot) tmpug=(0.d0,0.d0)
+ if (oneshot) call progress()
+
+ call tstatc0_begin('vdw_core_core ',id_sname3,1)
+
+ do i0=0,npes-1
+ ipos = i0+mype
+ if(ipos.ge.npes) ipos = ipos-npes
+ if(ipos.lt.0) ipos = ipos+npes
+
+ if(cqaa.le.np_nq)then
+ do i1=1,nel_nq(ipos)
+ cqb = real_index(i1,ipos)
+ if(npes>1)then
+ theta_G_b(:,:,:) = theta_buf_r(i1,:,:,:)
+ else
+ theta_G_b(:,:,:) = theta_G_ab(i1,:,:,:)
+ endif
+
+ fac = 1.d0
+ if(eval_kernel_by_interpolation) then
+ call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
+ else
+ Call phiab(cqa,cqb,nr12,phi_ab)
+ endif
+ Call convolution_3d_by_fft( na,nb,nc,cqa,cqb,nr12,phi_ab, &
+ & theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
+ Ecnl_12 = Ecnl_12 + Ecnl_12_ab
+ enddo
+ endif
+ if(npes>1.and.i0.ne.npes-1)then
+ call tstatc0_begin('vdWdf_core (comm) ',id_sname2,1)
+ allocate(theta_buf_s(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ theta_buf_s = theta_buf_r
+ call mpi_sendrecv(theta_buf_s,mp_nq*na*nb*nc,mpi_double_complex,isend,0, &
+ & theta_buf_r,mp_nq*na*nb*nc,mpi_double_complex,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ deallocate(theta_buf_s)
+ call tstatc0_end(id_sname2)
+ endif
+ enddo
+ call tstatc0_end(id_sname3)
- deallocate(tmpug)
+ if(.not.oneshot.and.cqaa.le.np_nq)then
+ call GtoR(na,nb,nc,tmpur,tmpug)
+#if 1
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(cqaa,:,:,:)
+ if ( .not. grad_rho_eq_0 ) then
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ grho = grad(cix,ciy,ciz)
+ rtmp = rho(cix,ciy,ciz)
+ if ( grho > 1.0d-6 ) then
+ dFddrho(cix,ciy,ciz) = dFddrho(cix,ciy,ciz) &
+ & + dble(tmpur(cix,ciy,ciz)) &
+ & *ddtheta_R(cqaa,cix,ciy,ciz) /grho
+ endif
+ end do
+ end do
+ end do
+ endif
+#else
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(cqaa,:,:,:)
+ if ( .not. grad_rho_eq_0 ) then
+ dFddrho(:,:,:) = dFddrho(:,:,:) + dble(tmpur(:,:,:))*ddtheta_R(cqaa,:,:,:)
+ endif
+#endif
+
+ if ( iprixc >= 2 ) then
+ do cix = 1,na
+ do ciy = 1,nb
+ do ciz = 1,nc
+ esum = esum +dble(tmpur(cix,ciy,ciz)) *theta_R(cix,ciy,ciz)
+ end do
+ end do
+ end do
+ endif
+ endif
+ enddo
+
+ if(.not.oneshot)then
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,dFdrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,dFddrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ deallocate(tmpur)
+ endif
+ deallocate(tmpug)
+ endif
if(npes>1) then
call mpi_allreduce(MPI_IN_PLACE,Ecnl_12,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
- if(.not.oneshot) &
- & call mpi_allreduce(MPI_IN_PLACE,ualpha_r,nq0*na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
endif
- deallocate(ind)
+
+ if ( iprixc >=2 ) then
+ esum = esum *univol *rinplw /2.0d0
+ call mpi_allreduce(MPI_IN_PLACE,Esum,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ write(nfout,*) "vdw nonolocal E12 "
+ write(nfout,*) "evaluation in real space : ", esum
+ write(nfout,*) " in reciprocal space : ", ecnl_12
+ endif
+
+ if(npes>1)then
+ deallocate(ista)
+ deallocate(theta_buf_r)
+ endif
if(printable.and.oneshot) write(nfout,'(a)') '... done'
call tstatc0_end(id_sname)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
end subroutine vdWdf_core
+ subroutine vdWdf_core2()
+ use progress_bar
+ real(kind=DP) :: fac
+ integer :: cqbb,cqa,cqb,ierr
+ integer :: i,ic,i2,i3
+ complex(kind=DP), allocatable, dimension(:,:,:) :: tmpug,tmpur
+ complex(kind=DP), allocatable, dimension(:,:,:,:) :: theta_buf_s,theta_buf_r
+ real(kind=DP), allocatable, dimension(:,:,:,:) :: dtheta_buf
+ integer :: ipos,i0,i1,isend,irecv,ireq,ireqr
+ integer, allocatable, dimension(:) :: ista
+ integer :: id_sname = -1
+ integer :: id_sname2 = -1
+
+ call tstatc0_begin('vdWdf_core2 ',id_sname,1)
+ Ecnl_12 = 0.0d0
+ if(printable.and.oneshot) &
+ & write(nfout,'(a)') 'performing the core operation : Ecnl = sum theta_a x phi_ab x theta_b ...'
+ if(oneshot)then
+ call reset_progress()
+ call set_end(int(floor(dble(nq0)/dble(npes))))
+ endif
+ if(npes>1)then
+ allocate(ista(MPI_STATUS_SIZE))
+ allocate(theta_buf_r(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));theta_buf_r=(0.d0,0.d0)
+ if(.not.oneshot)then
+ allocate(dtheta_buf(mp_nq,na,nb,nc));dtheta_buf=0.d0
+ endif
+ endif
+ if(.not.oneshot)then
+ allocate(tmpug(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2));tmpug=0.d0
+ allocate(tmpur(na,nb,nc));tmpur=0.d0
+ ! ualpha_g = (0.d0,0.d0)
+ else
+ allocate(tmpug(1,1,1))
+ endif
+ if(.not.oneshot)then
+ dFdrho=0.d0;dFddrho=0.d0
+ endif
+
+ irecv = mype+1
+ if(irecv.ge.npes) irecv = irecv-npes
+ isend = mype-1
+ if(isend.lt.0) isend = isend+npes
+
+ if (npes>1) theta_buf_r(1:np_nq,:,:,:) = theta_G_ab(1:np_nq,:,:,:)
+ do i0=0,npes-1
+ ipos = i0+mype
+ if(ipos.ge.npes) ipos = ipos-npes
+ if(ipos.lt.0) ipos = ipos+npes
+ do i1=1,nel_nq(ipos)
+ cqa = real_index(i1,ipos)
+ if(npes>1)then
+ theta_G_a(:,:,:) = theta_buf_r(i1,:,:,:)
+ else
+ theta_G_a(:,:,:) = theta_G_ab(i1,:,:,:)
+ endif
+ do cqbb=1,np_nq
+ theta_G_b(:,:,:) = theta_G_ab(cqbb,:,:,:)
+ fac = 1.d0
+ cqb = real_index(cqbb)
+ if(eval_kernel_by_interpolation) then
+ call phiab_by_interpl(cqa,cqb,nr12,phi_ab)
+ else
+ Call phiab(cqa,cqb,nr12,phi_ab)
+ endif
+ Call convolution_3d_by_fft(&
+ & na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
+ Ecnl_12 = Ecnl_12 + Ecnl_12_ab
+ enddo
+ if(.not.oneshot)then
+ ! call mpi_allreduce(MPI_IN_PLACE,tmpug,na*nb*nc,mpi_double_complex,mpi_sum,mpi_comm_group,ierr)
+ call GtoR(na,nb,nc,tmpur,tmpug)
+ dFdrho(:,:,:) = dFdrho(:,:,:) + dble(tmpur(:,:,:))*dtheta_R(i1,:,:,:)
+ dFddrho(:,:,:) = dFddrho(:,:,:) + dble(tmpur(:,:,:))*ddtheta_R(i1,:,:,:)
+ endif
+ enddo
+ if(npes>1)then
+ call tstatc0_begin('vdWdf_core (comm) ',id_sname2,1)
+ allocate(theta_buf_s(1:mp_nq,-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2))
+ theta_buf_s = theta_buf_r
+ call mpi_sendrecv(theta_buf_s,mp_nq*na*nb*nc,mpi_double_complex,isend,0, &
+ & theta_buf_r,mp_nq*na*nb*nc,mpi_double_complex,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ if(.not.oneshot)then
+ dtheta_buf = dtheta_R
+ call mpi_sendrecv(dtheta_buf,mp_nq*na*nb*nc,mpi_double_precision,isend,0, &
+ & dtheta_R, mp_nq*na*nb*nc,mpi_double_precision,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ dtheta_buf = ddtheta_R
+ call mpi_sendrecv(dtheta_buf,mp_nq*na*nb*nc,mpi_double_precision,isend,0, &
+ & ddtheta_R, mp_nq*na*nb*nc,mpi_double_precision,irecv,0, &
+ & mpi_comm_group,ista,ierr)
+ endif
+ deallocate(theta_buf_s)
+ call tstatc0_end(id_sname2)
+ endif
+ enddo
+
+ if(.not.oneshot)then
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,dFdrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,dFddrho, &
+ & na*nb*nc,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ deallocate(tmpur)
+ endif
+ deallocate(tmpug)
+ endif
+
+ if(npes>1) then
+ call mpi_allreduce(MPI_IN_PLACE,Ecnl_12,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ endif
+ if(npes>1)then
+ deallocate(ista)
+ deallocate(theta_buf_r)
+ if(.not.oneshot) deallocate(dtheta_buf)
+ endif
+ if(printable.and.oneshot) write(nfout,'(a)') '... done'
+ call tstatc0_end(id_sname)
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ end subroutine vdWdf_core2
+
subroutine corrections()
- !!$if(printable) write(nfout,'(a)') 'calculating correction terms and contribution from the LDA ...'
+!!$if(printable) write(nfout,'(a)') 'calculating correction terms and contribution from the LDA ...'
if(printable.and.oneshot) write(nfout,'(a)') 'calculating correction terms ...'
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Call piDphi(Ecnl_3,Ecnl_3s)
!!$ Call cLDA(na,nb,nc,rho,rhomin,dv,EcLDA)
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if(printable.and.oneshot) write(nfout,'(a)') '... done'
end subroutine corrections
subroutine theta_ab(nx,ny,nz,ca,nq0,q0min,q0max,rho,grad,rhomin,theta_R,dtheta_R,ddtheta_R)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer, intent(in) :: nx,ny,nz,ca,nq0
Real(kind=DP), intent(in) :: q0min,q0max,rhomin
Real(kind=DP), intent(in) :: rho(nx,ny,nz),grad(nx,ny,nz)
real(kind=DP), intent(out) :: theta_R(nx,ny,nz),dtheta_R(nx,ny,nz),ddtheta_R(nx,ny,nz)
-! Internal valuables
+ ! Internal valuables
Integer cir,cix,ciy,ciz
Real(kind=DP) ni,dni,q0,dqdn,dqddn
real(kind=DP),allocatable,dimension(:) :: y,y2tmp
real(kind=DP) :: yout,y1out
+ integer :: id_sname = -1
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ call tstatc0_begin('theta_ab ',id_sname,1)
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(y(nq0));y=0.d0;y(ca)=1.d0
allocate(y2tmp(nq0));y2tmp(:) = q2ar(ca,:)
-! For the functions theta_R
+ ! For the functions theta_R
Do cir = 1,nx*ny*nz
cix = 1+(cir-1-MOD(cir-1+ny*nz,ny*nz))/(ny*nz)
ciy = 1+(cir-ny*nz*(cix-1)-1-MOD(cir-1+nz,nz))/nz
@@ -762,23 +1182,24 @@ module m_vdWDF
End do
deallocate(y)
deallocate(y2tmp)
+ call tstatc0_end(id_sname)
end subroutine theta_ab
-!** End SUBROUTINE theta_ab *******************************************************************
+ !** End SUBROUTINE theta_ab *******************************************************************
-!** SUBROUTINE piDphi **********************************************************************************
+ !** SUBROUTINE piDphi **********************************************************************************
Subroutine piDphi(Ecii,Ecii_s)
implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
real(kind=DP), intent(out) :: Ecii,Ecii_s
Real(kind=DP) da,db,a1,a2,dr
Parameter (dr = 0.001d0)
Integer ci,cj,ck,ca,cb
-! Gauss-Legendre integration
+ ! Gauss-Legendre integration
Integer cD,nD
Parameter (nD=10)
Real(kind=DP) maxD,minD,dD,LD,PLD,LDxi(nD),LDwi(nD)
@@ -792,23 +1213,23 @@ module m_vdWDF
Real(kind=DP) x,nnx,nny,nnz,nn2,r
Real(kind=DP) nxp,nxm,nyp,nym,nzp,nzm
Real(kind=DP) zx(-3:3),zy(-3:3),zz(-3:3),rn(3,-3:3)
-
+
Real(kind=DP) phi
Real(kind=DP) temp,rs,phid_s,phid_s1,d_phid_s,phi2,phi4
-! The table of phi1D
+ ! The table of phi1D
Integer c1D,n1D,ierr
Parameter(n1D = 1000)
Real(kind=DP) d1D,max1D,D,phix,phiy
Real(kind=DP) phi1D(0:n1D+1)
real(kind=DP) :: q0,dqdn,dqddn
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
-! Make the table of phi1D
+ !---------------------- Calculation Start ----------------------
+ ! Make the table of phi1D
max1D = ds
d1D = max1D/DBLE(n1D)
Do c1D = 0,n1D+1
@@ -877,42 +1298,40 @@ module m_vdWDF
phi4 = (-1.d0/ds**4)*(phid_s-phi0) + (rs/(2.d0*ds**4))*d_phid_s
Ecii_s = Ecii_s + 0.5d0*4.d0*pi*dv*(n**2)* &
-& (phi0*(rs**3)*(q0**0)/3.d0 + &
-& phi2*(rs**5)*(q0**2)/5.d0 + &
-& phi4*(rs**7)*(q0**4)/7.d0)
+ & (phi0*(rs**3)*(q0**0)/3.d0 + &
+ & phi2*(rs**5)*(q0**2)/5.d0 + &
+ & phi4*(rs**7)*(q0**4)/7.d0)
Enddo
if(npes>1) call mpi_allreduce(MPI_IN_PLACE,Ecii_s,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
End Subroutine piDphi
-!** End SUBROUTINE piDphi **********************
+ !** End SUBROUTINE piDphi **********************
-!** SUBROUTINE cLDA ****************************
+ !** SUBROUTINE cLDA ****************************
Subroutine cLDA(na,nb,nc,rho,rhomin,dv,EcLDA)
Implicit none
-!************************ Note *********************************
-! This Algorism follows Dion's 1-shot method.
-!
-! This program is a subroutine.
-! This program calculates the correlation energy from LDA.
-! The formula is given at Eq.(58) (p.93) of 'Theory of the
-! Inhomogeneous Electron Gas' Lundqvist, March.
-!
-!
-! Input
-! rho(nrxyz,nsipn) : Total density
-!
-! Output
-! EcLDA : Correlation energy from LDA.
-!
-!
-! Written by Youky Ono in 2009/Jul.
-!***************************************************************
-
-
+ !************************ Note *********************************
+ ! This Algorism follows Dion's 1-shot method.
+ !
+ ! This program is a subroutine.
+ ! This program calculates the correlation energy from LDA.
+ ! The formula is given at Eq.(58) (p.93) of 'Theory of the
+ ! Inhomogeneous Electron Gas' Lundqvist, March.
+ !
+ !
+ ! Input
+ ! rho(nrxyz,nsipn) : Total density
+ !
+ ! Output
+ ! EcLDA : Correlation energy from LDA.
+ !
+ !
+ ! Written by Youky Ono in 2009/Jul.
+ !***************************************************************
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
integer,intent(in) :: na,nb,nc
real(kind=DP),intent(in) :: rho(na,nb,nc)
real(kind=DP),intent(in) :: rhomin
@@ -926,11 +1345,9 @@ module m_vdWDF
real(kind=DP) e,m
parameter (e=1.d0,m=1.d0) ! Hatree atomic unit
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-
-
-!---------------------- Calculation Start ----------------------
+ !---------------------- Calculation Start ----------------------
EcLDA=0
Do cjr = 1,na*nb*nc
if(mod(cjr,npes)/=mype) cycle
@@ -938,102 +1355,105 @@ module m_vdWDF
cjy = 1+(cjr-nb*nc*(cjx-1)-1-MOD(cjr-1+nc,nc))/nc
cjz = cjr-nc*(nb*(cjx-1)-1+cjy)
n = MAX(rho(cjx,cjy,cjz),rhomin)
-
+
rs = ((3.d0/(4.d0*pi*n))**(1.d0/3.d0))/aB
x = rs/11.4d0
ec = -0.0666d0*0.5d0*((1.d0+x**3)*DLOG(1.d0+1.d0/x)-x**2+x/2.d0-1.d0/3.d0)
-
+
EcLDA = EcLDA + dv*n*ec
Enddo
if(npes>1) call mpi_allreduce(MPI_IN_PLACE,EcLDA,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
End Subroutine cLDA
-!** End SUBROUTINE cLDA **********************
+ !** End SUBROUTINE cLDA **********************
-!** SUBROUTINE RtoG ***************************************************************************
-! Execute FFT and transform theta_R to theta_G
+ !** SUBROUTINE RtoG ***************************************************************************
+ ! Execute FFT and transform theta_R to theta_G
Subroutine RtoG(na,nb,nc,theta_R,theta_G)
Implicit none
!!include "fftw3.f"
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer na,nb,nc,cix,ciy,ciz,ca,cb,cc
Real(kind=DP) rx,ry,rz,kx,ky,kz,ra,rb,rc,ka,kb,kc,rk,r12,x,y,z,term,term1
Real(kind=DP) theta_R(na,nb,nc)
Complex(kind=DP) theta_G(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
-! FFTW3 !!!
+ ! FFTW3 !!!
integer(kind=DP) :: plan
Complex(kind=DP),allocatable :: temp_R(:,:,:),temp_G(:,:,:)
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(temp_R(na,nb,nc))
allocate(temp_G(0:na-1,0:nb-1,0:nc-1))
-!***** FFT **************************************************
+ !***** FFT **************************************************
Do cix = 1,na
- Do ciy = 1,nb
- Do ciz = 1,nc
- temp_R(cix,ciy,ciz) = DCMPLX(theta_R(cix,ciy,ciz))
- Enddo
- Enddo
+ Do ciy = 1,nb
+ Do ciz = 1,nc
+ temp_R(cix,ciy,ciz) = DCMPLX(theta_R(cix,ciy,ciz))
+ Enddo
+ Enddo
Enddo
-! FFTW3 !!!
+ ! FFTW3 !!!
call dfftw_plan_dft_3d(plan,na,nb,nc,temp_R,temp_G,FFTW_FORWARD,FFTW_ESTIMATE)
call dfftw_execute(plan)
call dfftw_destroy_plan(plan)
Do ca = -(na/2-1),na/2
- Do cb = -(nb/2-1),nb/2
- Do cc = -(nc/2-1),nc/2
- cix = MOD(ca+na,na)
- ciy = MOD(cb+nb,nb)
- ciz = MOD(cc+nc,nc)
- theta_G(ca,cb,cc) = temp_G(cix,ciy,ciz) / DBLE(na*nb*nc)
- Enddo
- Enddo
+ Do cb = -(nb/2-1),nb/2
+ Do cc = -(nc/2-1),nc/2
+ cix = MOD(ca+na,na)
+ ciy = MOD(cb+nb,nb)
+ ciz = MOD(cc+nc,nc)
+ theta_G(ca,cb,cc) = temp_G(cix,ciy,ciz) / DBLE(na*nb*nc)
+ Enddo
+ Enddo
Enddo
-!***** END of FFT ******************************************
+ !***** END of FFT ******************************************
- deallocate(temp_R)
- deallocate(temp_G)
+ deallocate(temp_R); deallocate(temp_G)
End subroutine RtoG
-!** End SUBROUTINE RtoG ***********************************************************************
+ !** End SUBROUTINE RtoG ***********************************************************************
subroutine GtoR(na,nb,nc,theta_R,theta_G)
-! include "fftw3.f"
+ ! include "fftw3.f"
integer,intent(in) :: na,nb,nc
complex(kind=DP), dimension(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2), intent(in) :: theta_G
complex(kind=DP), dimension(na,nb,nc), intent(out) :: theta_R
+
integer :: ca,cb,cc,cix,ciy,ciz
integer(kind=DP) :: plan
complex(kind=DP),allocatable :: temp_R(:,:,:),temp_G(:,:,:)
integer :: id_sname=-1
+
call tstatc0_begin('GtoR ',id_sname,1)
+
allocate(temp_R(na,nb,nc))
allocate(temp_G(0:na-1,0:nb-1,0:nc-1))
+
Do ca = -(na/2-1),na/2
- Do cb = -(nb/2-1),nb/2
- Do cc = -(nc/2-1),nc/2
- cix = MOD(ca+na,na)
- ciy = MOD(cb+nb,nb)
- ciz = MOD(cc+nc,nc)
- temp_G(cix,ciy,ciz) = theta_G(ca,cb,cc)
- Enddo
- Enddo
+ Do cb = -(nb/2-1),nb/2
+ Do cc = -(nc/2-1),nc/2
+ cix = MOD(ca+na,na)
+ ciy = MOD(cb+nb,nb)
+ ciz = MOD(cc+nc,nc)
+ temp_G(cix,ciy,ciz) = theta_G(ca,cb,cc)
+ Enddo
+ Enddo
Enddo
-! FFTW3 !!!
+ ! FFTW3 !!!
call dfftw_plan_dft_3d(plan,na,nb,nc,temp_G,temp_R,FFTW_BACKWARD,FFTW_ESTIMATE)
call dfftw_execute(plan)
call dfftw_destroy_plan(plan)
-!***** END of FFT ******************************************
+ !***** END of FFT ******************************************
- theta_R = temp_R/dble(na*nb*nc)
-! theta_R = temp_R
+ ! theta_R = temp_R/dble(na*nb*nc)
+ theta_R = temp_R
deallocate(temp_R)
deallocate(temp_G)
@@ -1041,7 +1461,7 @@ module m_vdWDF
end subroutine GtoR
subroutine get_phi_ab_g(nr12,phi_ab,phi_ab_g)
-! include "fftw3.f"
+ ! include "fftw3.f"
integer, intent(in) :: nr12
real(kind=DP), dimension(0:nr12), intent(in) :: phi_ab
real(kind=DP), dimension(0:nr12), intent(out) :: phi_ab_g
@@ -1050,6 +1470,10 @@ module m_vdWDF
integer :: cr,ck
integer(kind=DP) :: plan
real(kind=DP) :: dd,r12,term,rk
+ real(kind=DP) :: rr
+ complex(kind=DP) :: zsum
+ complex(kind=DP), parameter :: zi = ( 0.0d0, 1.0d0 )
+
integer :: id_sname = -1
call tstatc0_begin('get_phi_ab_g ',id_sname,1)
allocate(cphiab_r(0:nr12));cphiab_r=0.d0
@@ -1058,20 +1482,27 @@ module m_vdWDF
dd = r12max/dble(nr12)
do cr=0,nr12
- cphiab_r(cr) = dcmplx(phi_ab(cr)*dble(cr),0.d0)
+ rr = dble(cr) *dd
+ cphiab_r(cr) = dcmplx( phi_ab(cr)*rr, 0.d0 )
enddo
+
+#if 0
call dfftw_plan_dft_1d(plan,nr12+1,cphiab_r,cphiab_g,FFTW_BACKWARD,FFTW_ESTIMATE)
+#else
+ call dfftw_plan_dft_1d( plan, nr12, cphiab_r(0:nr12-1), cphiab_g(0:nr12-1), &
+ & FFTW_BACKWARD, FFTW_ESTIMATE )
+#endif
call dfftw_execute(plan)
call dfftw_destroy_plan(plan)
do ck=1,nr12
rk = dble(ck)/r12max
- phi_ab_g(ck) = 2.d0*dd**2*dimag(cphiab_g(ck))/(dble(rk))
- enddo
+ phi_ab_g(ck) = 2.d0 *dd *dimag(cphiab_g(ck))/(dble(rk))
+ enddo
Do ck = 0,0
rk = dd * dble(ck)
- term = 0
+ term = 0.0d0
Do cr = 0,nr12
r12 = dd*dble(cr)
term = term + phi_ab(cr) * (r12**2)
@@ -1079,23 +1510,19 @@ module m_vdWDF
phi_ab_g(ck) = 4.0d0*pi*dd * term
End do
- deallocate(cphiab_r)
- deallocate(cphiab_g)
+ deallocate(cphiab_r); deallocate(cphiab_g)
+
+ phi_ab_g = phi_ab_g / univol
-! if(qa==1)then
-! do ck=0,nr12
-! rk = dble(ck)/r12max
-! write(qa*35+qb,*) rk,phi_ab_g(ck)
-! enddo
-! endif
call tstatc0_end(id_sname)
+
end Subroutine get_phi_ab_g
Subroutine convolution_3d_by_fft(na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,fac,Ecnl_12_ab,tmpug)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
integer, intent(in) :: na,nb,nc,cqa,cqb,nr12
complex(kind=DP), intent(in) :: theta_G_a(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
complex(kind=DP), intent(in) :: theta_G_b(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
@@ -1113,64 +1540,79 @@ module m_vdWDF
Real(kind=DP),allocatable :: core_G(:)
+ real*8 :: dd
+
real(kind=DP) :: pi2rk
integer :: id_sname = -1
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
call tstatc0_begin('convolution_3d_by_fft ',id_sname,1)
allocate(core_G(0:nr12));core_G=0.d0
nabc = na*nb*nc
-
- Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
- Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
- Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
+ ! dd = r12max/dble(nr12)
call get_phi_ab_g(nr12,phi_ab,core_G)
+
dk = 1.d0/r12max
temp_c = (0.0d0,0.0d0)
!tmpug = 0.d0
- Do ciz = -(nc/2-1),nc/2
- Do ciy = -(nb/2-1),nb/2
- Do cix = -(na/2-1),na/2
- rk = DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
- !If(rk.LT.maxk) Then
- ck = dint(rk/dk)
- phix = (rk - dk*DBLE(ck))/dk
- phiy = 1.0 - phix
- term = phiy*core_G(ck) + phix*core_G(ck+1)
- !Else
- ! term = 0.0d0
- !Endif
-
- temp_c = temp_c + &
-& DCONJG(theta_G_a(cix,ciy,ciz)) * &
-& theta_G_b(cix,ciy,ciz) * &
-& term
- if(.not.oneshot) tmpug(cix,ciy,ciz) = tmpug(cix,ciy,ciz)+theta_G_b(cix,ciy,ciz)*term*dv*nabc!*0.5d0*fac
- Enddo
- Enddo
- Enddo
+ if(oneshot)then
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ rk = rkar(cix,ciy,ciz)
+ ck = dint(rk/dk)
+
+ phix = (rk - dk*DBLE(ck))/dk
+ phiy = 1.0d0 -phix
+ term = phiy*core_G(ck) + phix*core_G(ck+1)
+
+ temp_c = temp_c + term *DCONJG(theta_G_a(cix,ciy,ciz)) &
+ & * theta_G_b(cix,ciy,ciz)
+ Enddo
+ Enddo
+ Enddo
+ else
+ Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do cix = -(na/2-1),na/2
+ rk = rkar(cix,ciy,ciz)
+ ck = dint(rk/dk)
+
+ phix = (rk - dk*DBLE(ck))/dk
+ phiy = 1.0d0 - phix
+ term = phiy*core_G(ck) + phix*core_G(ck+1)
+
+ temp_c = temp_c + term *DCONJG(theta_G_a(cix,ciy,ciz)) &
+ & * theta_G_b(cix,ciy,ciz)
+
+ tmpug(cix,ciy,ciz) = tmpug(cix,ciy,ciz) &
+ & +theta_G_b(cix,ciy,ciz)*term *univol
+ Enddo
+ Enddo
+ Enddo
+ endif
- temp_c = temp_c * dv*nabc
+ temp_c = temp_c * univol**2
Ecnl_12_ab = 0.5d0*DBLE(temp_c)*fac
- !tmpug(:,:,:) = tmpug(:,:,:)*dv*nabc*0.5d0*fac
-!***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
+ !***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
deallocate(core_G)
call tstatc0_end(id_sname)
+
End subroutine convolution_3d_by_fft
-!** End SUBROUTINE convolution_3d *************************************************************
+ !** End SUBROUTINE convolution_3d *************************************************************
Subroutine convolution_3d(na,nb,nc,cqa,cqb,nr12,phi_ab,theta_G_a,theta_G_b,Ecnl_12_ab)
Implicit none
-! include "fftw3.f"
+ ! include "fftw3.f"
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
integer, intent(in) :: na,nb,nc,cqa,cqb,nr12
complex(kind=DP), intent(in) :: theta_G_a(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
complex(kind=DP), intent(in) :: theta_G_b(-(na/2-1):na/2,-(nb/2-1):nb/2,-(nc/2-1):nc/2)
@@ -1189,21 +1631,21 @@ module m_vdWDF
Real(kind=DP),allocatable :: phiab_r(:)
real(kind=DP) :: pi2rk
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(core_G(0:nk-1))
allocate(phiab_r(0:nr12));phiab_r=0.d0
nabc = na*nb*nc
-! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
-!& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
-!& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
-
- Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
- Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
- Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
+ ! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
+ !& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
+ !& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
+
+ ! Ta = na*DSQRT(aa(1,1)**2 + aa(1,2)**2 + aa(1,3)**2)
+ ! Tb = nb*DSQRT(aa(2,1)**2 + aa(2,2)**2 + aa(2,3)**2)
+ ! Tc = nc*DSQRT(aa(3,1)**2 + aa(3,2)**2 + aa(3,3)**2)
-!***** Make the core function and execute 3d-FFT by hand *****
+ !***** Make the core function and execute 3d-FFT by hand *****
dr12 = r12max/dble(nr12)
dk = maxk/dble(nk-1)
@@ -1232,71 +1674,72 @@ module m_vdWDF
Enddo
core_G(ck) = 2.d0 * dr12 * term / rk
End do
-!***** END of Make the core function *************************
+ !***** END of Make the core function *************************
-! if(cqa==1)then
-! do ck=0,nr12
-! rk = dk * dble(ck)
-! write((cqa+1)*35+cqb,*) rk,core_G(ck)
-! enddo
-! endif
-!***** Calculate 'theta_G_a*core_G*theta_G_b' ***************
+ ! if(cqa==1)then
+ ! do ck=0,nr12
+ ! rk = dk * dble(ck)
+ ! write((cqa+1)*35+cqb,*) rk,core_G(ck)
+ ! enddo
+ ! endif
+ !***** Calculate 'theta_G_a*core_G*theta_G_b' ***************
dk = maxk/dble(nk-1)
temp_c = (0.0,0.0)
Do cix = -(na/2-1),na/2
- Do ciy = -(nb/2-1),nb/2
- Do ciz = -(nc/2-1),nc/2
+ Do ciy = -(nb/2-1),nb/2
+ Do ciz = -(nc/2-1),nc/2
- rk = DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
- If(rk.LT.maxk) Then
- ck = DINT(rk/dk)
- phix = (rk - dk*DBLE(ck))/dk
- phiy = 1.0 - phix
- term = phiy*core_G(ck) + phix*core_G(ck+1)
- Else
- term = 0.0d0
- Endif
-
- temp_c = temp_c + &
-& DCONJG(theta_G_a(cix,ciy,ciz)) * &
-& theta_G_b(cix,ciy,ciz) * &
-& term
- Enddo
- Enddo
+ !rk = DSQRT((dble(cix)/Ta)**2 + (dble(ciy)/Tb)**2 + (dble(ciz)/Tc)**2)
+ rk = rkar(cix,ciy,ciz)
+ If(rk.LT.maxk) Then
+ ck = DINT(rk/dk)
+ phix = (rk - dk*DBLE(ck))/dk
+ phiy = 1.0 - phix
+ term = phiy*core_G(ck) + phix*core_G(ck+1)
+ Else
+ term = 0.0d0
+ Endif
+
+ temp_c = temp_c + &
+ & DCONJG(theta_G_a(cix,ciy,ciz)) * &
+ & theta_G_b(cix,ciy,ciz) * &
+ & term
+ Enddo
+ Enddo
Enddo
temp_c = temp_c * dv*nabc
Ecnl_12_ab = 0.5d0*DBLE(temp_c)
-!***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
+ !***** End Calculate 'theta_G_a*core_G*theta_G_b' ***********
deallocate(core_G)
deallocate(phiab_r)
End subroutine convolution_3d
-!** End SUBROUTINE convolution_3d *************************************************************
+ !** End SUBROUTINE convolution_3d *************************************************************
Subroutine d_q0(n,dn,q0min,q0max,q0,dqdn,dqddn)
Implicit None
-!************************ Note *********************************
-! This program calculates q0.
-!
-! Input
-! rho(nrxyz,nsipn) : Total density
-!
-! Output
-! q0 :
-!
-!
-!
-! Written by Youky Ono
-!***************************************************************
+ !************************ Note *********************************
+ ! This program calculates q0.
+ !
+ ! Input
+ ! rho(nrxyz,nsipn) : Total density
+ !
+ ! Output
+ ! q0 :
+ !
+ !
+ !
+ ! Written by Youky Ono
+ !***************************************************************
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
real(kind=DP), intent(in) :: n,dn,q0min,q0max
real(kind=DP), intent(out) :: q0,dqdn,dqddn
Double Precision rs,x,nn2,r,term1,term2,term3,rnn2
@@ -1307,17 +1750,17 @@ module m_vdWDF
integer :: i
real(kind=DP) :: s2,s,qq
real(kind=DP) :: drsdn,dxdn,dexcdn,dsdn,dkFdn
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
+ !---------------------- Calculation Start ----------------------
nn2 = dn*dn
rnn2 = dsqrt(nn2)
rs = (3.d0/(4.d0*pi*n))**(1.d0/3.d0)
-! Eq.(58), (59) (p.93-94) of Theory of the Inhomogeneous Electron gas.
-! S.Lundqvist and N.H.March 1983 Plenum Press, NY
+ ! Eq.(58), (59) (p.93-94) of Theory of the Inhomogeneous Electron gas.
+ ! S.Lundqvist and N.H.March 1983 Plenum Press, NY
x = rs/11.4d0
GxcLDA = 0.5d0*((1.d0+x**3)*DLog(1.d0+1.d0/x)-x**2+x/2.d0-1.d0/3.d0)
excLDA = -0.458d0/rs-0.0666d0*GxcLDA
@@ -1329,22 +1772,37 @@ module m_vdWDF
call hxxc(qq,q0max,q0,dq)
q0 = max(q0,q0min)
-
+
if(q0.eq.q0min)then
- dqdn = 0.d0;dqddn=0.d0
+ dqdn = 0.d0;dqddn=0.d0
else
- drsdn = -(3.d0/(4.d0*PAI))**(1.d0/3.d0)/3.d0*n**(-4.d0/3.d0)
- dxdn = drsdn/11.4d0
- dexcdn = (0.458d0/(rs*rs))*drsdn-0.0333d0*(3*x*x*dlog(1+1.d0/x)-(1+x**3)/(x*(x+1))-2*x+0.5d0)*dxdn
- dkFdn = (pi/kF)**2
- dsdn = -(rnn2/(4*kF*n*kF*n))*(dkFdn*n+kF)
- dqdn = -(4.d0*pi/3.d0)*dexcdn-(Zab/9.d0)*(2*s*dsdn*kF+s2*dkFdn)
- dqddn = -(Zab/9.d0)*s/n
- dqdn = dqdn*dq
- dqddn = dqddn*dq
+#if 0
+ drsdn = -(3.d0/(4.d0*PAI))**(1.d0/3.d0)/3.d0*n**(-4.d0/3.d0)
+ dxdn = drsdn/11.4d0
+ dexcdn = (0.458d0/(rs*rs))*drsdn &
+ & -0.0333d0*(3*x*x*dlog(1+1.d0/x)-(1+x**3)/(x*(x+1))-2*x+0.5d0)*dxdn
+ dkFdn = (pi/kF)**2
+!!! dsdn = -(rnn2/(4*kF*n*kF*n))*(dkFdn*n+kF)
+ dsdn = -(rnn2/(2*kF*n*kF*n))*(dkFdn*n+kF)
+ dqdn = -(4.d0*pi/3.d0)*dexcdn-(Zab/9.d0)*(2*s*dsdn*kF+s2*dkFdn)
+ dqddn = -(Zab/9.d0)*s/n
+
+#else
+ drsdn = -rs /3.0d0 /n
+ dxdn = drsdn/11.4d0
+ dexcdn = (0.458d0/(rs*rs))*drsdn &
+ & -0.0333d0*(3*x*x*dlog(1+1.d0/x)-(1+x**3)/(x*(x+1))-2*x+0.5d0)*dxdn
+ dkFdn = kF /3.0d0 /n
+ dsdn = -s /(kF*n) *(dkFdn*n+kF)
+ dqdn = -(4.d0*pi/3.d0)*dexcdn-(Zab/9.d0)*(2*s*dsdn*kF+s2*dkFdn)
+! dqddn = -(Zab/9.d0)*s2 *2.0 /dn *KF
+ dqddn = -(Zab/9.d0)*s/n
+#endif
+ dqdn = dqdn*dq
+ dqddn = dqddn*dq
endif
End Subroutine d_q0
-!** End SUBROUTINE d_q0 ***********************************************************************
+ !** End SUBROUTINE d_q0 ***********************************************************************
subroutine hxxc(x,xc,hx,dhx)
real(kind=DP), intent(in) :: x,xc
@@ -1362,62 +1820,59 @@ module m_vdWDF
dhx = xc*dexp(-summ)*dsumm
end subroutine hxxc
-!** SUBROUTINE derivation *********************************************************************
+ !** SUBROUTINE derivation *********************************************************************
Subroutine derivation(na,nb,nc,aa,rho,dv,grad)
Implicit none
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
-! The unit cell and the electron density information
+ ! The unit cell and the electron density information
integer,intent(in) :: na,nb,nc
real(kind=DP), intent(in) :: rho(na,nb,nc)
Real(kind=DP), intent(in) :: aa(3,3)
real(kind=DP), intent(in) :: dv
real(kind=DP), intent(out) :: grad(na,nb,nc)
-! Integers
+ ! Integers
Integer i,j,k,cx,cy,cz,nabc
-! Internal valuables
+ ! Internal valuables
Integer zx(-3:3),zy(-3:3),zz(-3:3)
Real(kind=DP) rn(3,-3:3),detr,bb(3,3)
Real(kind=DP),allocatable :: darho(:,:,:),dbrho(:,:,:),dcrho(:,:,:)
real(kind=DP) :: dx,dy,dz
-!+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
+ !+++++++++++++++++++++ End VARIABLES +++++++++++++++++++++++++++
allocate(darho(na,nb,nc));darho=0.d0
allocate(dbrho(na,nb,nc));dbrho=0.d0
allocate(dcrho(na,nb,nc));dcrho=0.d0
-! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
-!& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
-!& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
+ ! dv = aa(1,1)*(aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2)) &
+ !& + aa(1,2)*(aa(2,3)*aa(3,1)-aa(2,1)*aa(3,3)) &
+ !& + aa(1,3)*(aa(2,1)*aa(3,2)-aa(2,2)*aa(3,1))
Do cx = 1,na
- Do cy = 1,nb
- Do cz = 1,nc
+ Do cy = 1,nb
+ Do cz = 1,nc
- Do j = -3,3
- zx(j) = MOD(2*na+(cx+j)-1,na)+1
- zy(j) = MOD(2*nb+(cy+j)-1,nb)+1
- zz(j) = MOD(2*nc+(cz+j)-1,nc)+1
-
- rn(1,j) = rho(zx(j),cy,cz)
- rn(2,j) = rho(cx,zy(j),cz)
- rn(3,j) = rho(cx,cy,zz(j))
- Enddo
-
- darho(cx,cy,cz) = &
-& (rn(1,3)-9.d0*rn(1,2)+45.d0*rn(1,1)-45.d0*rn(1,-1)+9.d0*rn(1,-2)-rn(1,-3))/(60.d0)
- dbrho(cx,cy,cz) = &
-& (rn(2,3)-9.d0*rn(2,2)+45.d0*rn(2,1)-45.d0*rn(2,-1)+9.d0*rn(2,-2)-rn(2,-3))/(60.d0)
- dcrho(cx,cy,cz) = &
-& (rn(3,3)-9.d0*rn(3,2)+45.d0*rn(3,1)-45.d0*rn(3,-1)+9.d0*rn(3,-2)-rn(3,-3))/(60.d0)
- Enddo
- Enddo
+ Do j = -3,3
+ zx(j) = MOD(2*na+(cx+j)-1,na)+1
+ zy(j) = MOD(2*nb+(cy+j)-1,nb)+1
+ zz(j) = MOD(2*nc+(cz+j)-1,nc)+1
+
+ rn(1,j) = rho(zx(j),cy,cz)
+ rn(2,j) = rho(cx,zy(j),cz)
+ rn(3,j) = rho(cx,cy,zz(j))
+ Enddo
+
+ darho(cx,cy,cz) = (rn(1,3)-9.d0*rn(1,2)+45.d0*rn(1,1)-45.d0*rn(1,-1)+9.d0*rn(1,-2)-rn(1,-3))/(60.d0)
+ dbrho(cx,cy,cz) = (rn(2,3)-9.d0*rn(2,2)+45.d0*rn(2,1)-45.d0*rn(2,-1)+9.d0*rn(2,-2)-rn(2,-3))/(60.d0)
+ dcrho(cx,cy,cz) = (rn(3,3)-9.d0*rn(3,2)+45.d0*rn(3,1)-45.d0*rn(3,-1)+9.d0*rn(3,-2)-rn(3,-3))/(60.d0)
+ Enddo
+ Enddo
Enddo
detr = (aa(1,1)*aa(2,2)*aa(3,3)+aa(1,2)*aa(2,3)*aa(3,1)+aa(1,3)*aa(2,1)*aa(3,2)) &
-& - (aa(1,1)*aa(2,3)*aa(3,2)+aa(1,2)*aa(2,1)*aa(3,3)+aa(1,3)*aa(2,2)*aa(3,1))
+ &- (aa(1,1)*aa(2,3)*aa(3,2)+aa(1,2)*aa(2,1)*aa(3,3)+aa(1,3)*aa(2,2)*aa(3,1))
bb(1,1) = (aa(2,2)*aa(3,3)-aa(2,3)*aa(3,2))/detr
bb(2,1) = -(aa(2,1)*aa(3,3)-aa(2,3)*aa(3,1))/detr
@@ -1430,15 +1885,14 @@ module m_vdWDF
bb(3,3) = (aa(1,1)*aa(2,2)-aa(1,2)*aa(2,1))/detr
Do cx = 1,na
- Do cy = 1,nb
- Do cz = 1,nc
-
- dx = (bb(1,1)*darho(cx,cy,cz) + bb(1,2)*dbrho(cx,cy,cz) + bb(1,3)*dcrho(cx,cy,cz))
- dy = (bb(2,1)*darho(cx,cy,cz) + bb(2,2)*dbrho(cx,cy,cz) + bb(2,3)*dcrho(cx,cy,cz))
- dz = (bb(3,1)*darho(cx,cy,cz) + bb(3,2)*dbrho(cx,cy,cz) + bb(3,3)*dcrho(cx,cy,cz))
- grad(cx,cy,cz) = dsqrt(dx**2+dy**2+dz**2)
- Enddo
- Enddo
+ Do cy = 1,nb
+ Do cz = 1,nc
+ dx = (bb(1,1)*darho(cx,cy,cz) + bb(1,2)*dbrho(cx,cy,cz) + bb(1,3)*dcrho(cx,cy,cz))
+ dy = (bb(2,1)*darho(cx,cy,cz) + bb(2,2)*dbrho(cx,cy,cz) + bb(2,3)*dcrho(cx,cy,cz))
+ dz = (bb(3,1)*darho(cx,cy,cz) + bb(3,2)*dbrho(cx,cy,cz) + bb(3,3)*dcrho(cx,cy,cz))
+ grad(cx,cy,cz) = dsqrt(dx**2+dy**2+dz**2)
+ Enddo
+ Enddo
Enddo
deallocate(darho)
@@ -1446,7 +1900,7 @@ module m_vdWDF
deallocate(dcrho)
End subroutine derivation
-!** End SUBROUTINE derivation *****************************************************************
+ !** End SUBROUTINE derivation *****************************************************************
subroutine spline0(nq0,x,y2)
integer, intent(in) :: nq0
@@ -1483,8 +1937,8 @@ module m_vdWDF
real(kind=DP), intent(in) :: a,b
real(kind=DP) :: res
res = 2.d0*((3.d0-a*a)*b*DCOS(b)*DSIN(a) + (3.d0-b*b)*a*DCOS(a)*DSIN(b) &
-& + (a*a+b*b-3.d0)*DSIN(a)*DSIN(b) &
-& - 3.d0*a*b*DCOS(a)*DCOS(b))/((a*b)**3)
+ & + (a*a+b*b-3.d0)*DSIN(a)*DSIN(b) &
+ & - 3.d0*a*b*DCOS(a)*DCOS(b))/((a*b)**3)
end function Wab
function Twxyz(w,x,y,z) result (res)
@@ -1494,30 +1948,30 @@ module m_vdWDF
res = 0.5d0*(1.d0/(w+x)+1.d0/(y+z))*(1.d0/((w+y)*(x+z))+1.d0/((w+z)*(y+x)))
end function Twxyz
-!** SUBROUTINE kernel_phi *********************************************************************
+ !** SUBROUTINE kernel_phi *********************************************************************
Subroutine kernel_phi(di,dk,phi)
implicit none
-!************************ Note *********************************
-! This Algorism follows Dion's 1-shot method.
-!
-! This program is a subroutine.
-! This program calculates the kernel function phi.
-!
-! Input
-!
-!
-! Output
-! phi :
-!
-!
-!
-! Written by Youky Ono in 2013/Jan.
-!***************************************************************
+ !************************ Note *********************************
+ ! This Algorism follows Dion's 1-shot method.
+ !
+ ! This program is a subroutine.
+ ! This program calculates the kernel function phi.
+ !
+ ! Input
+ !
+ !
+ ! Output
+ ! phi :
+ !
+ !
+ !
+ ! Written by Youky Ono in 2013/Jan.
+ !***************************************************************
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
real(kind=DP), intent(in) :: di,dk
real(kind=DP), intent(out) :: phi
Integer ca,cb,nb
@@ -1527,75 +1981,75 @@ module m_vdWDF
real(kind=DP) :: dr
-! Gauss-Legendre integration
+ ! Gauss-Legendre integration
Real(kind=DP),allocatable, dimension(:) :: xi,wi
Real(kind=DP) :: fac
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
-! Call gauleg for Gauss-Legendre integral
- allocate(xi(na_gl));xi=0.d0
- allocate(wi(na_gl));wi=0.d0
- Call gauleg(a1,a2,na_gl,xi,wi)
-
- phi = 0.d0
- Do ca=1,na_gl
- Do cb=1,ca
- fac=2.d0
- if(ca.eq.cb) fac=1.d0
- a = xi(ca)
- b = xi(cb)
-
- v1 = (a**2)/(2*hofy(a,di))
- v2 = (b**2)/(2*hofy(b,di))
- v3 = (a**2)/(2*hofy(a,dk))
- v4 = (b**2)/(2*hofy(b,dk))
- phi = phi + fac*wi(ca)*wi(cb)*(a*a*b*b)*Wab(a,b)*Twxyz(v1,v2,v3,v4)
- End Do
- End Do
-
- phi = phi * 2*m*(e**4)/(pi**2)
- deallocate(xi)
- deallocate(wi)
+ !---------------------- Calculation Start ----------------------
+ ! Call gauleg for Gauss-Legendre integral
+ allocate(xi(na_gl));xi=0.d0
+ allocate(wi(na_gl));wi=0.d0
+ Call gauleg(a1,a2,na_gl,xi,wi)
+
+ phi = 0.d0
+ Do ca=1,na_gl
+ Do cb=1,ca
+ fac=2.d0
+ if(ca.eq.cb) fac=1.d0
+ a = xi(ca)
+ b = xi(cb)
+
+ v1 = (a**2)/(2.d0*hofy(a,di))
+ v2 = (b**2)/(2.d0*hofy(b,di))
+ v3 = (a**2)/(2.d0*hofy(a,dk))
+ v4 = (b**2)/(2.d0*hofy(b,dk))
+ phi = phi + fac*wi(ca)*wi(cb)*(a*a*b*b)*Wab(a,b)*Twxyz(v1,v2,v3,v4)
+ End Do
+ End Do
+
+ phi = phi * 2.d0 *m *(e**4)/(pi**2)
+ deallocate(xi)
+ deallocate(wi)
end Subroutine kernel_phi
-!** End SUBROUTINE kernel_phi *****************************************************************
+ !** End SUBROUTINE kernel_phi *****************************************************************
-!** SUBROUTINE gauleg **********************************************************************************
+ !** SUBROUTINE gauleg **********************************************************************************
Subroutine gauleg(x1,x2,n,xi,wi)
Implicit none
real(kind=DP), intent(in) :: x1,x2
integer, intent(in) :: n
real(kind=DP), intent(out) :: xi(n),wi(n)
-!++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
+ !++++++++++++++++++++++++++ VARIABLES ++++++++++++++++++++++++++
Integer m,j,i
REAL(kind=DP) z1,z,xm,xl,pp,p3,p2,p1,eta
Parameter (eta=0.0000000001d0)
-!++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
+ !++++++++++++++++++++++++ end VARIABLES ++++++++++++++++++++++++
-!---------------------- Calculation Start ----------------------
+ !---------------------- Calculation Start ----------------------
m=(n+1)/2
xm=0.5d0*(x2+x1)
xl=0.5d0*(x2-x1)
-! === DEBUG by tkato 2014/04/22 ================================================
+ ! === DEBUG by tkato 2014/04/22 ================================================
z1 = 0.0d0
-! ==============================================================================
+ ! ==============================================================================
Do i=1,m
z=DCOS(pi*(i-0.25d0)/(n+0.5d0))
Do While (ABS(z-z1).GT.eta)
p1=1.0d0
p2=0.0d0
-
+
Do j=1,n
p3=p2
P2=p1
p1=((2.0d0*j-1.d0)*z*p2-(j-1.d0)*p3)/dble(j)
Enddo
-
+
pp=n*(z*p1-p2)/(z*z-1.d0)
z1=z
z=z1-p1/pp
@@ -1607,50 +2061,52 @@ module m_vdWDF
wi(n+1-i) = wi(i)
Enddo
End Subroutine gauleg
-!** End SUBROUTINE gauleg ******************************************************************************
+ !** End SUBROUTINE gauleg ******************************************************************************
-!** SUBROUTINE outputs ************************************************************************
+ !** SUBROUTINE outputs ************************************************************************
Subroutine outputs()
Implicit none
Ecnl = Ecnl_12 + Ecnl_3 - Ecnl_3s
if(printable)then
- write(nfout,'(a)') 'Here are the results : '
- Write(nfout,*) ' '
- Write(nfout,11) ExGGA
- Write(nfout,*) ' '
- Write(nfout,12) EcLDA
- Write(nfout,13) Ecnl
- Write(nfout,14) EcLDA + Ecnl
- Write(nfout,*) ' '
- Write(nfout,15) EcLDA + Ecnl + ExGGA
- Write(nfout,*) ' '
-11 Format('E_total(GGA exchange) = ',F19.13)
-
-12 Format('Ec(LDA) = ',F19.13)
-13 Format('Ec(nl) = ',F19.13)
-14 Format('Ec (= Ec(LDA) + Ec(nl) ) = ',F19.13)
+ write(nfout,'(a)') 'Here are the results : '
+ Write(nfout,*) ' '
+ Write(nfout,11) ExGGA
+ Write(nfout,*) ' '
+ Write(nfout,12) EcLDA
+ Write(nfout,13) Ecnl
+ Write(nfout,14) EcLDA + Ecnl
+ Write(nfout,*) ' '
+ Write(nfout,15) EcLDA + Ecnl + ExGGA
+ Write(nfout,*) ' '
+11 Format('E_total(GGA exchange) = ',F19.13)
+
+12 Format('Ec(LDA) = ',F19.13)
+13 Format('Ec(nl) = ',F19.13)
+14 Format('Ec (= Ec(LDA) + Ec(nl) ) = ',F19.13)
-15 Format('E_total(vdW-DF) = ',F19.13)
+15 Format('E_total(vdW-DF) = ',F19.13)
- Write(nfout,*) ' Given in Hartree atomic units'
- Write(nfout,*) ' '
+ Write(nfout,*) ' Given in Hartree atomic units'
+ Write(nfout,*) ' '
endif
End Subroutine outputs
-!** End SUBROUTINE outputs ********************************************************************
+ !** End SUBROUTINE outputs ********************************************************************
- subroutine get_dFdrho_dFddrho(na,nb,nc,dFdrho,dFddrho)
+ subroutine get_dFdrho_dFddrho(na,nb,nc,dFdrho_,dFddrho_)
integer, intent(in) :: na,nb,nc
- real(kind=DP), dimension(na,nb,nc), intent(out) :: dFdrho,dFddrho
+ real(kind=DP), dimension(na,nb,nc), intent(out) :: dFdrho_,dFddrho_
integer :: i,i1,i2,i3
- dFdrho = 0.0d0;dFddrho = 0.0d0
- do i=1,nq0
- dFdrho (:,:,:) = dFdrho (:,:,:) + dble(ualpha_r(i,:,:,:))*dtheta_R (i,:,:,:)/(univol*rinplw)
- dFddrho(:,:,:) = dFddrho(:,:,:) + dble(ualpha_r(i,:,:,:))*ddtheta_R(i,:,:,:)/(univol*rinplw)
- enddo
-
+ dFdrho_ = dFdrho
+ dFddrho_ = dFddrho
+ ! dFdrho = 0.0d0;dFddrho = 0.0d0 ! this can be calculated on the fly!!
+ ! do i=1,nq0
+ ! dFdrho (:,:,:) = dFdrho (:,:,:) + dble(ualpha_r(i,:,:,:))*dtheta_R (i,:,:,:)/(univol*rinplw)
+ ! dFddrho(:,:,:) = dFddrho(:,:,:) + dble(ualpha_r(i,:,:,:))*ddtheta_R(i,:,:,:)/(univol*rinplw)
+ ! enddo
+
end subroutine get_dFdrho_dFddrho
diff -uprN phase0_2015.01/src_phase_3d/mdmain.F90 phase0_2015.01.01/src_phase_3d/mdmain.F90
--- phase0_2015.01/src_phase_3d/mdmain.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/mdmain.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,4 +1,4 @@
-!#define POST3D
+#define POST3D
!=======================================================================
!
! PROGRAM PHASE/0 2015.01 ($Rev: 440 $)
diff -uprN phase0_2015.01/src_phase_3d/mdmain0.F90 phase0_2015.01.01/src_phase_3d/mdmain0.F90
--- phase0_2015.01/src_phase_3d/mdmain0.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/mdmain0.F90 2016-07-12 12:51:53.000000000 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2015.01 ($Rev: 443 $)
+! PROGRAM PHASE/0 2015.01 ($Rev: 482 $)
!
! MAIN PROGRAM: PHASE
!
@@ -32,7 +32,7 @@
! Consortium.
! The activity of development of this program set has been supervised by Takahisa Ohno.
!
-! $Id: mdmain0.F90 443 2015-08-03 13:03:48Z ktagami $
+! $Id: mdmain0.F90 482 2016-04-08 08:40:45Z jkoga $
!
program PHASE
#ifdef NEC_TIMER
@@ -48,7 +48,7 @@ program PHASE
implicit none
logical :: ChargeDensity_is_Converged, TotalEnergy_is_Divergent
logical :: Already_Converged, Already_Converged2
- logical :: Positron_bulk, Positron_defect
+ logical :: Positron_scf, Positron_nonscf
logical :: Hubbard_model
logical :: Forces_are_Converged, Ending_Time, Force_errors_are_tolerable,UnitCell_Converged
!!$ logical :: ChargeDensity_is_Fixed
@@ -110,6 +110,8 @@ program PHASE
#endif
call Ewald_and_Structure_Factor
+ if ( Positron_scf() ) call Initial_pWaveFunctions()
+
call Initial_Electronic_Structure
if(ChargeDensity_is_Fixed() .and. One_by_one_in_each_rank_k()) then ! icond=2, 3
@@ -142,6 +144,8 @@ program PHASE
! ============================================================ 5.0
call Renewal_of_WaveFunctions
+ if ( Positron_scf() ) call Renewal_of_pWaveFunctions
+
call ChargeDensity_Construction(0)
call Potential_Construction
@@ -158,7 +162,8 @@ program PHASE
if ( PotentialMix() ) then
else
call Renewal_of_Potential
- if(Hubbard_model()) then
+ if ( Positron_scf() ) call Renewal_of_pPotential
+ if (Hubbard_model() ) then
call Renewal_of_Hubbard_Parameters
call Renewal_of_Hubbard_Potential
end if
@@ -176,6 +181,10 @@ program PHASE
call Move_Ions
call MDIterationNumber_Setting
call Ewald_and_Structure_Factor
+ if ( Hubbard_model() ) then
+ call Renewal_of_Hubbard_Parameters
+ call Renewal_of_Hubbard_Potential
+ end if
!!$ call MDIterationNumber_Setting
end if
if(BreakMD(force_conv))then
@@ -194,16 +203,21 @@ program PHASE
#endif
end if
- if(Already_Converged2() .and. .not.Positron_defect() .and. Positron_bulk()) then
+ if ( Already_Converged2() ) then
+ if ( Positron_nonscf() ) then
#ifdef NEC_ITER_REG
- call FTRACE_REGION_BEGIN("POSITRON")
+ call FTRACE_REGION_BEGIN("POSITRON")
#endif
- call Renewal_of_pPotential()
- call Solve_pWaveFunctions()
+ call Initial_pWaveFunctions()
+ call Renewal_of_pPotential()
+ call Solve_pWaveFunctions()
#ifdef NEC_ITER_REG
- call FTRACE_REGION_END("POSITRON")
+ call FTRACE_REGION_END("POSITRON")
#endif
- end if
+ else if ( Positron_scf() ) then
+ call Write_Positron_LifeTime
+ end if
+ endif
#ifdef NEC_ITER_REG
call FTRACE_REGION_BEGIN("FINAL")
@@ -470,4 +484,11 @@ contains
#endif
call m_CtrlP_set_init_status(.true.)
end subroutine Array_Deallocate
+
+ subroutine Write_Positron_LifeTime
+ use m_Positron_Wave_Functions, only : m_pWF_wlifetime
+
+ call m_pWF_wlifetime()
+ end subroutine Write_Positron_LifeTime
+
end program PHASE
diff -uprN phase0_2015.01/src_phase_3d/mpi_dummy.F90 phase0_2015.01.01/src_phase_3d/mpi_dummy.F90
--- phase0_2015.01/src_phase_3d/mpi_dummy.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/mpi_dummy.F90 2016-07-12 12:51:53.000000000 +0900
@@ -169,6 +169,12 @@ subroutine mpi_copy( send_buf, recv_buf,
end if
end
+subroutine mpi_sendrecv(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf,recvcount,recvtype,source,recvtag,comm,status,ierr)
+ integer :: sendcount,sendtype,dest,sendtag,recvcount,recvtype,source,recvtag,comm,status,ierr
+ logical(4) :: sendbuf(sendcount*2),recvbuf(recvcount*2)
+ call mpi_copy( sendbuf, recvbuf, sendcount, sendtype, ierr )
+end
+
#ifndef _NO_ARG_DUMMY_
function iargc()
iargc = 0
diff -uprN phase0_2015.01/src_phase_3d/vdW.F90 phase0_2015.01.01/src_phase_3d/vdW.F90
--- phase0_2015.01/src_phase_3d/vdW.F90 2015-08-05 14:58:03.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/vdW.F90 2016-07-12 12:51:53.000000000 +0900
@@ -48,7 +48,7 @@ subroutine vdW_scf(nspin,ispin,na,nb,nc,
call build_theta()
call vdWdf_core()
call corrections()
- ecnl = (Ecnl_12 + Ecnl_3 - Ecnl_3s)/(univol*rinplw)
+ ecnl = Ecnl_12 + Ecnl_3 - Ecnl_3s
call get_dFdrho_dFddrho(na,nb,nc,dFdrho,dFddrho)
call finalize_vdwdf()
call tstatc0_end(id_sname)
diff -uprN phase0_2015.01/src_phase_3d/version.h phase0_2015.01.01/src_phase_3d/version.h
--- phase0_2015.01/src_phase_3d/version.h 2015-09-15 12:16:46.000000000 +0900
+++ phase0_2015.01.01/src_phase_3d/version.h 2016-07-12 12:51:53.000000000 +0900
@@ -1 +1 @@
-integer, parameter :: svn_revision = 460
+integer, parameter :: svn_revision = 511