phase0_2023.01.01.patch
phase0_2023.01.01.patch
—
differences between files,
366 KB (375340 bytes)
ファイルコンテンツ
diff -ruN phase0_2023.01/src_phase/ChargeDensity_Mixing.F90 phase0_2023.01.01/src_phase/ChargeDensity_Mixing.F90
--- phase0_2023.01/src_phase/ChargeDensity_Mixing.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/ChargeDensity_Mixing.F90 2023-11-09 12:02:31.631099539 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2016.01 ($Rev: 615 $)
+! PROGRAM PHASE/0 2023.01
!
! SUBROUINE: ChargeDensity_Mixing
!
@@ -34,10 +34,10 @@
! $Id: ChargeDensity_Mixing.F90 615 2020-05-08 13:58:30Z ktagami $
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, hsro
+ use m_Charge_Density, only : m_CD_check
use m_CD_mixing, only : m_CD_simple_mixing, m_CD_prepare_precon &
& ,m_CD_mix_broyden1,m_CD_mix_broyden2,m_CD_mix_DFP &
- & ,m_CD_mix_pulay, m_CD_simple_mixing_hsr
+ & ,m_CD_mix_pulay, m_CD_simple_mixing_hsr, m_CD_mixing_write_DEFINITION
use m_Ionic_System, only : natm
use m_Total_Energy, only : m_TE_what_is_edeltb_now, m_TE_wd_total_energy_with_solvers
use m_Control_Parameters, only : c_precon,waymix,intzaj,icond &
@@ -123,6 +123,7 @@
integer :: waymix_at_CDmix
logical :: ini = .false., mixer_changed
real(kind=DP) :: rmxt_tot, rmxt_hard, rmxt_occmat
+ integer,save :: definition_check_in_m_CD_mixing = 0
#ifdef __TIMER_SUB__
call timer_sta(1101)
#endif
@@ -133,6 +134,13 @@
return
endif
+ if(iprichargemixing>=1) then
+ if(definition_check_in_m_CD_mixing == 0) then
+ call m_CD_mixing_write_DEFINITION(nfout)
+ definition_check_in_m_CD_mixing = 1
+ end if
+ end if
+
edeltb_per_atom = m_TE_what_is_edeltb_now()/natm
waymix_at_CDmix = m_CtrlP_waymix_now(iteration_electronic, iteration_ionic &
& , edeltb_per_atom,mixer_changed)
@@ -281,8 +289,7 @@
case (PULAY)
call m_CD_mix_pulay(nfout,rmxt_tot)
case default
- !stop ' ! waymix is invalid'
- call phase_error_with_msg(nfout,' waymix is invalid',__LINE__,__FILE__)
+ call phase_error_with_msg(nfout,' ! waymix is invalid',__LINE__,__FILE__)
end select mixing_way
end subroutine mix_charge_total
@@ -304,8 +311,7 @@
case (PULAY)
call m_OP_mix_Pulay(rmxt_occmat)
case default
- !stop ' ! waymix is invalid'
- call phase_error_with_msg(nfout,' waymix is invalid',__LINE__,__FILE__)
+ call phase_error_with_msg(nfout,' ! waymix is invalid',__LINE__,__FILE__)
end select mixing_way
end subroutine mix_charge_only_occmat
@@ -331,7 +337,6 @@
case (BROYD1)
! call m_CD_mix_broyden1_with_hsr(rmxt_tot)
write(*,*) 'Not supported '
- !stop
call phase_error_with_msg(nfout,' broyd1 unsupported',__LINE__,__FILE__)
case (BROYD2)
@@ -352,8 +357,7 @@
endif
if(sw_hubbard==ON) call m_OP_cp_om_to_ommix( nfout, rmxt_hard ) ! om --> ommix
case default
- !stop ' ! waymix is invalid'
- call phase_error_with_msg(nfout,' waymix is invalid ',__LINE__,__FILE__)
+ call phase_error_with_msg(nfout,' ! waymix is invalid',__LINE__,__FILE__)
end select mixing_way
end subroutine mix_charge_total_with_hsr
@@ -382,8 +386,7 @@
endif
case default
- !stop ' ! waymix is invalid'
- call phase_error_with_msg(nfout,' waymix is invalid ',__LINE__,__FILE__)
+ call phase_error_with_msg(nfout,' ! waymix is invalid',__LINE__,__FILE__)
end select mixing_way
end subroutine mix_charge_total_intg
@@ -394,13 +397,11 @@
case (SIMPLE)
call m_KE_simple_mixing(nfout,rmxt_tot)
case (BROYD2)
-!!! call m_KE_simple_mixing(nfout,rmxt_tot)
call m_KE_mix_broyden2(nfout,rmxt_tot)
case (PULAY)
call m_KE_mix_pulay(nfout,rmxt_tot)
case default
- !stop ' ! waymix is invalid'
- call phase_error_with_msg(nfout,' waymix is invalid ',__LINE__,__FILE__)
+ call phase_error_with_msg(nfout,' ! waymix is invalid',__LINE__,__FILE__)
end select mixing_way
end subroutine mix_kinetic_energy_density
diff -ruN phase0_2023.01/src_phase/Convergence_Check.F90 phase0_2023.01.01/src_phase/Convergence_Check.F90
--- phase0_2023.01/src_phase/Convergence_Check.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/Convergence_Check.F90 2023-11-09 12:02:31.607099414 +0900
@@ -511,7 +511,7 @@
return
endif
- call Checkpoint_File(STREVL_ITERATION)
+! call Checkpoint_File(STREVL_ITERATION)
if(sw_displace_atom == ON) then
Forces_are_Converged = .true.
!return
@@ -622,6 +622,7 @@
end if
end if
end if
+ if(.not. Forces_are_Converged) call Checkpoint_File(STREVL_ITERATION)
write(nfout,'(" <<Forces_are_Converged>>, Forces_are_Converged = ",L4)') Forces_are_Converged
call flush(nfout)
diff -ruN phase0_2023.01/src_phase/EsmPack/Esm.F90 phase0_2023.01.01/src_phase/EsmPack/Esm.F90
--- phase0_2023.01/src_phase/EsmPack/Esm.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/EsmPack/Esm.F90 2023-11-09 12:02:31.639099581 +0900
@@ -1284,7 +1284,7 @@
agauss(it,1)=1.d0
bgauss(it,1)=1.d0
enddo
- call esm_force_lc_(nrxx,aux,forcelc,nat,1,agauss,bgauss)
+ call esm_force_lc_(nrxx,aux,nat,forcelc,1,agauss,bgauss)
deallocate(agauss,bgauss)
end subroutine esm_force_lc
diff -ruN phase0_2023.01/src_phase/Initialization.F90 phase0_2023.01.01/src_phase/Initialization.F90
--- phase0_2023.01/src_phase/Initialization.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/Initialization.F90 2023-11-09 12:02:31.606099409 +0900
@@ -194,7 +194,7 @@
character(len=81) :: vers, system, codename
!write(vers,'("Revision:",i5," -- ORG_Parallel --")') commit_id
! write(vers,'("phase/0 2021.01 Revision:",i5," -- ORG_Parallel --")') commit_id
- vers = "phase/0 2023.01 Revision:"//commit_id//" -- ORG_Parallel --"
+ vers = "phase/0 2023.01.01 Revision:"//commit_id//" -- ORG_Parallel --"
codename = 'phaseUnif'
system = ''
@@ -436,7 +436,7 @@
character(len=81) :: vers, system, codename
!write(vers,'("Revision:",i5," -- ORG_Parallel --")') commit_id
! write(vers,'("phase/0 2021.02 Revision:",i5," -- ORG_Parallel --")') commit_id
- vers = "phase/0 2023.01 Revision:"//commit_id//" -- ORG_Parallel --"
+ vers = "phase/0 2023.01.01 Revision:"//commit_id//" -- ORG_Parallel --"
codename = 'phaseUnif'
system = ''
diff -ruN phase0_2023.01/src_phase/IterationNumbers_Setting.F90 phase0_2023.01.01/src_phase/IterationNumbers_Setting.F90
--- phase0_2023.01/src_phase/IterationNumbers_Setting.F90 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2023.01.01/src_phase/IterationNumbers_Setting.F90 2023-11-09 12:02:31.628099524 +0900
@@ -0,0 +1,322 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!=======================================================================
+!
+! PROGRAM PHASE/0 2016.01 ($Rev: 614 $)
+!
+! SUBROUINE: MDiterationNumber_Setting, MDiterationNumber_Setting_ep,
+! IterationNumber_Setting, IterationNumber_Setting_g,
+! KpointNumber_Setting, KpointNumber_Setting2
+!
+! AUTHOR(S): T. Yamasaki August/20/2003
+! Further modification by T. Yamasaki May 2004
+!
+! Contact address : Phase System Consortium
+! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
+!
+!
+!
+!=======================================================================
+!
+! The original version of this set of the computer programs "PHASE"
+! was developed by the members of the Theory Group of Joint Research
+! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
+! 1993-2001.
+!
+! Since 2002, this set has been tuned and new functions have been
+! added to it as a part of the national project "Frontier Simulation
+! Software for Industrial Science (FSIS)", which is supported by
+! the IT program of the Ministry of Education, Culture, Sports,
+! Science and Technology (MEXT) of Japan.
+! Since 2006, this program set has been developed as a part of the
+! national project "Revolutionary Simulation Software (RSS21)", which
+! is supported by the next-generation IT program of MEXT of Japan.
+! Since 2013, this program set has been further developed centering on PHASE System
+! Consortium.
+! The activity of development of this program set has been supervised by Takahisa Ohno.
+!
+! $Id: IterationNumbers_Setting.f90 614 2020-05-07 03:24:24Z jkoga $
+subroutine MDiterationNumber_Setting
+ use m_IterationNumbers, only : m_Iter_mdIterN_increment&
+ &, m_Iter_electronic_reset
+ use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch
+ use m_Files, only : nfout
+ implicit none
+
+ call m_CtrlP_reset_dtim_1Dsearch()
+ call m_Iter_mdIterN_increment(nfout)
+ call m_Iter_electronic_reset
+end subroutine MDiterationNumber_Setting
+
+subroutine SCDFTiterationNumber_Setting
+ use m_IterationNumbers, only : m_Iter_scdftIterN_increment &
+ &, m_Iter_electronic_reset, m_Iter_reset_iter_ionic
+ use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, m_CtrlP_reset_iconvergence
+ use m_Files, only : nfout
+ implicit none
+
+ call m_CtrlP_reset_dtim_1Dsearch()
+ call m_Iter_scdftIterN_increment(nfout)
+ call m_Iter_electronic_reset
+ call m_Iter_reset_iter_ionic()
+ call m_CtrlP_reset_iconvergence()
+end subroutine SCDFTiterationNumber_Setting
+
+subroutine MDiterationNumber_Setting2
+ use m_IterationNumbers, only : m_Iter_mdIterN_increment&
+ &, m_Iter_electronic_reset,iteration_electronic,m_Iter_reset_iter_ionic &
+ &, m_Iter_unitcell_increment &
+ &, m_Iter_stress_correction_incre
+ use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, sw_optimize_lattice &
+ &, m_CtrlP_reset_iconvergence,imdalg, sw_stress_correction
+ use m_Const_Parameters, only : ON, PT_CONTROL, P_CONTROL
+ use m_Stress, only : m_Stress_in_correction, m_Stress_correction
+ use m_Files, only : nfout
+ implicit none
+ logical :: Rightafter_stress_correction
+ if(sw_optimize_lattice==ON .or. imdalg == PT_CONTROL .or. imdalg == P_CONTROL)then
+ call m_Iter_electronic_reset
+ if(sw_optimize_lattice == ON) call m_Iter_reset_iter_ionic()
+ if(.not.m_Stress_in_correction(2)) call m_Iter_unitcell_increment()
+ call m_CtrlP_reset_iconvergence()
+ endif
+end subroutine MDiterationNumber_Setting2
+
+logical function Rightafter_stress_correction()
+ use m_IterationNumbers, only : iteration_stress_correction
+ implicit none
+ Rightafter_stress_correction = iteration_stress_correction == 4
+end function
+
+subroutine MDiterationNumber_Setting_pre
+ use m_IterationNumbers, only : m_Iter_electronic_reset, m_Iter_stress_correction_incre
+ use m_Control_Parameters, only : m_CtrlP_reset_iconvergence, sw_stress_correction
+ use m_Const_Parameters, only : ON
+ use m_Stress, only : m_Stress_in_correction, m_Stress_correction
+ use m_Files, only : nfout
+ implicit none
+ if(sw_stress_correction == ON .and. m_Stress_in_correction(4)) then
+ call m_Stress_correction(nfout)
+ call m_Iter_electronic_reset
+ call m_Iter_stress_correction_incre()
+ call m_CtrlP_reset_iconvergence()
+ endif
+end subroutine MDiterationNumber_Setting_pre
+
+subroutine MDiterationNumber_Setting3
+ use m_Const_Parameters, only : DRIVER_URAMP
+ use m_Control_Parameters, only : driver
+ use m_IterationNumbers, only : m_Iter_electronic_reset,m_Iter_reset_iter_ionic &
+ &, m_Iter_uramp_increment
+ use m_Control_Parameters, only : driver, m_CtrlP_reset_iconvergence
+ implicit none
+ if(driver == DRIVER_URAMP)then
+ call m_Iter_electronic_reset
+ call m_Iter_reset_iter_ionic()
+ call m_Iter_uramp_increment()
+ call m_CtrlP_reset_iconvergence()
+ endif
+end subroutine MDiterationNumber_Setting3
+
+subroutine MDiterationNumber_Setting_ep
+ use m_IterationNumbers, only : m_Iter_mdIterN_increment&
+ & , m_Iter_total_increment
+ use m_Files, only : nfout
+ implicit none
+ call m_Iter_mdIterN_increment(nfout)
+ call m_Iter_total_increment()
+end subroutine MDiterationNumber_Setting_ep
+
+subroutine IterationNumber_Setting
+ use m_Control_Parameters,only: icond, ipritiming0&
+ & , iprijobstatus, jobstatus_series, jobstatus_format, driver
+ use m_IterationNumbers, only : m_Iter_electronic_incre &
+ & , m_Iter_total_increment &
+ & , iteration, first_iteration_of_this_job &
+ & , iteration_electronic, iteration_ionic &
+ & , iteration_unit_cell, iteration_uramp, iteration_scdft
+ use m_Timing, only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter &
+ & , m_Timing_wd_status
+ use m_Const_Parameters, only : INITIAL, CONTINUATION &
+ & , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION &
+ & , START, ITERATIVE, ON, OFF, DRIVER_URAMP
+ use m_Files, only : nfstatus,nfout &
+ & , m_Files_open_nfstatus &
+ & , m_Files_close_nfstatus &
+ & , m_Files_skiptoend
+ implicit none
+ integer :: it, status_wdmode
+ logical :: unitcell_can_change,Uramping,isSCDFT
+
+ call tstatc_iter(iteration, first_iteration_of_this_job)
+ it = iteration
+ if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
+ if(iteration == first_iteration_of_this_job) then
+ call tstatc_wd0
+ call flush(nfout)
+ else
+ if(ipritiming0 >= 1) call tstatc_wd(it)
+ end if
+ call tstatc_init
+
+ if(iprijobstatus >=1 ) then
+ call m_Files_open_nfstatus()
+ if(iteration == first_iteration_of_this_job) then
+ status_wdmode = START
+ else
+ status_wdmode = ITERATIVE
+ if(jobstatus_series == ON) then
+ call m_Files_skiptoend(nfstatus)
+ else
+ end if
+ end if
+ call m_Timing_wd_status(nfstatus,jobstatus_format,jobstatus_series,status_wdmode &
+ & ,iteration,iteration_ionic,iteration_electronic)
+ call m_Files_close_nfstatus()
+ end if
+
+ call m_Iter_electronic_incre()
+ call m_Iter_total_increment()
+
+#ifndef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(iprijobstatus >=1 ) then
+#endif
+ if(.not.unitcell_can_change()) then
+ if(Uramping()) then
+ write(nfout,'(" ---- iteration(total, uramp, ionic, electronic) = ",4i8," ----")') &
+ & iteration, iteration_uramp, iteration_ionic, iteration_electronic
+ else if (isSCDFT()) then
+ write(nfout,'(" ---- iteration(total, scdft, ionic, electronic) = ",4i8," ----")') &
+ & iteration, iteration_scdft, iteration_ionic, iteration_electronic
+ else
+ write(nfout,'(" ---- iteration(total, ionic, electronic) = ",3i8," ----")') &
+ & iteration, iteration_ionic, iteration_electronic
+ endif
+ else
+ write(nfout,'(" ---- iteration(total, unitcell, ionic, electronic) = ",4i8," ----")') &
+ & iteration, iteration_unit_cell,iteration_ionic, iteration_electronic
+ endif
+#ifndef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ end if
+#endif
+
+end subroutine IterationNumber_Setting
+
+subroutine IterationNumber_Setting_g()
+ use m_Control_Parameters,only: icond,ipritiming0
+ use m_IterationNumbers, only : iteration, first_iteration_of_this_job &
+ & , iteration_electronic &
+ & , m_Iter_total_increment &
+ & , m_Iter_electronic_incre
+ use m_Timing , only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter
+ use m_Const_Parameters, only : INITIAL, CONTINUATION, FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
+ implicit none
+ integer :: it
+
+ call tstatc_iter(iteration, first_iteration_of_this_job)
+ it = iteration
+ if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
+ if(iteration_electronic == 0) then
+ call tstatc_wd0()
+ else
+ if(ipritiming0 >= 1) call tstatc_wd(it)
+ end if
+ call tstatc_init()
+
+ call m_Iter_electronic_incre()
+ call m_Iter_total_increment()
+
+end subroutine IterationNumber_Setting_g
+
+subroutine IterationNumber_reset()
+ use m_Timing , only : tstatc_init
+ use m_IterationNumbers, only : m_Iter_electronic_reset
+
+ call m_Iter_electronic_reset()
+ call tstatc_init()
+end subroutine IterationNumber_reset
+
+subroutine KpointNumber_Setting()
+ use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
+ & , iteration_electronic, first_iteration_electronic &
+ & , m_Iter_nk_incre &
+ & , m_Iter_wd_electronic &
+ & , m_Iter_wd_nk &
+ & , m_Iter_electronic_reset &
+ & , m_Iter_electronic_set
+ use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
+ use m_Files,only : nfout
+
+! ===================== added by K. Tagami ================== 11.0
+ use m_Control_Parameters, only : noncol, ndim_spinor
+
+ implicit none
+! =========================================================== 11.0
+
+ call m_CtrlP_ntcnvg_reset()
+! =================================== modified by K. Tagami ======== 11.0
+!! call m_Iter_nk_incre(nspin)
+ if ( noncol ) then
+ call m_Iter_nk_incre(ndim_spinor)
+ else
+ call m_Iter_nk_incre(nspin)
+ endif
+! ================================================================== 11.0
+
+ if(nk_in_the_process == first_kpoint_in_this_job) then
+ call m_Iter_electronic_set()
+ else
+ call m_Iter_electronic_reset()
+ end if
+ if(ipriekzaj <= 0) call m_Iter_electronic_reset()
+ call m_Iter_wd_nk(nfout)
+ call m_Iter_wd_electronic(nfout)
+
+end subroutine KpointNumber_Setting
+
+subroutine KpointNumber_Setting2()
+ use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
+ & , iteration_electronic, first_iteration_electronic &
+ & , m_Iter_nk_incre2 &
+ & , m_Iter_wd_electronic &
+ & , m_Iter_wd_nk2 &
+ & , m_Iter_electronic_reset &
+ & , m_Iter_electronic_set
+!!$ & , m_Iter_nkgroup_set
+ use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
+ use m_Kpoints, only : kv3, kv3_ek
+ use m_Files,only : nfout
+
+! ===================== added by K. Tagami ================== 11.0
+ use m_Control_Parameters, only : noncol, ndim_spinor
+
+ implicit none
+! =========================================================== 11.0
+
+ call m_CtrlP_ntcnvg_reset()
+
+! ======================================= added by K. Tagami ============ 11.0
+! call m_Iter_nk_incre2(nspin,kv3_ek)
+ if ( noncol ) then
+ call m_Iter_nk_incre2( ndim_spinor,kv3_ek )
+ else
+ call m_Iter_nk_incre2( nspin,kv3_ek )
+ endif
+! ====================================================================== 11.0
+
+ if(nk_in_the_process == first_kpoint_in_this_job) then
+ call m_Iter_electronic_set()
+!!$ call m_Iter_nkgroup_set(kv3)
+ else
+ call m_Iter_electronic_reset()
+ end if
+ if(ipriekzaj <= 0) call m_Iter_electronic_reset()
+ call m_Iter_wd_nk2(nfout,kv3)
+ call m_Iter_wd_electronic(nfout)
+
+end subroutine KpointNumber_Setting2
+
+!!$subroutine pIterationNumber_Setting()
+!!$ use m_IterationNumbers, only : m_Iter_positron_set()
+!!$ implicit none
+!!$ call m_Iter_positron_set()
+!!$end subroutine pIterationNumber_Setting
diff -ruN phase0_2023.01/src_phase/IterationNumbers_Setting.f90 phase0_2023.01.01/src_phase/IterationNumbers_Setting.f90
--- phase0_2023.01/src_phase/IterationNumbers_Setting.f90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/IterationNumbers_Setting.f90 1970-01-01 09:00:00.000000000 +0900
@@ -1,317 +0,0 @@
-!=======================================================================
-!
-! PROGRAM PHASE/0 2016.01 ($Rev: 614 $)
-!
-! SUBROUINE: MDiterationNumber_Setting, MDiterationNumber_Setting_ep,
-! IterationNumber_Setting, IterationNumber_Setting_g,
-! KpointNumber_Setting, KpointNumber_Setting2
-!
-! AUTHOR(S): T. Yamasaki August/20/2003
-! Further modification by T. Yamasaki May 2004
-!
-! Contact address : Phase System Consortium
-! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
-!
-!
-!
-!=======================================================================
-!
-! The original version of this set of the computer programs "PHASE"
-! was developed by the members of the Theory Group of Joint Research
-! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
-! 1993-2001.
-!
-! Since 2002, this set has been tuned and new functions have been
-! added to it as a part of the national project "Frontier Simulation
-! Software for Industrial Science (FSIS)", which is supported by
-! the IT program of the Ministry of Education, Culture, Sports,
-! Science and Technology (MEXT) of Japan.
-! Since 2006, this program set has been developed as a part of the
-! national project "Revolutionary Simulation Software (RSS21)", which
-! is supported by the next-generation IT program of MEXT of Japan.
-! Since 2013, this program set has been further developed centering on PHASE System
-! Consortium.
-! The activity of development of this program set has been supervised by Takahisa Ohno.
-!
-! $Id: IterationNumbers_Setting.f90 614 2020-05-07 03:24:24Z jkoga $
-subroutine MDiterationNumber_Setting
- use m_IterationNumbers, only : m_Iter_mdIterN_increment&
- &, m_Iter_electronic_reset
- use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch
- use m_Files, only : nfout
- implicit none
-
- call m_CtrlP_reset_dtim_1Dsearch()
- call m_Iter_mdIterN_increment(nfout)
- call m_Iter_electronic_reset
-end subroutine MDiterationNumber_Setting
-
-subroutine SCDFTiterationNumber_Setting
- use m_IterationNumbers, only : m_Iter_scdftIterN_increment &
- &, m_Iter_electronic_reset, m_Iter_reset_iter_ionic
- use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, m_CtrlP_reset_iconvergence
- use m_Files, only : nfout
- implicit none
-
- call m_CtrlP_reset_dtim_1Dsearch()
- call m_Iter_scdftIterN_increment(nfout)
- call m_Iter_electronic_reset
- call m_Iter_reset_iter_ionic()
- call m_CtrlP_reset_iconvergence()
-end subroutine SCDFTiterationNumber_Setting
-
-subroutine MDiterationNumber_Setting2
- use m_IterationNumbers, only : m_Iter_mdIterN_increment&
- &, m_Iter_electronic_reset,iteration_electronic,m_Iter_reset_iter_ionic &
- &, m_Iter_unitcell_increment &
- &, m_Iter_stress_correction_incre
- use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, sw_optimize_lattice &
- &, m_CtrlP_reset_iconvergence,imdalg, sw_stress_correction
- use m_Const_Parameters, only : ON, PT_CONTROL, P_CONTROL
- use m_Stress, only : m_Stress_in_correction, m_Stress_correction
- use m_Files, only : nfout
- implicit none
- logical :: Rightafter_stress_correction
- if(sw_optimize_lattice==ON .or. imdalg == PT_CONTROL .or. imdalg == P_CONTROL)then
- call m_Iter_electronic_reset
- if(sw_optimize_lattice == ON) call m_Iter_reset_iter_ionic()
- if(.not.m_Stress_in_correction(2)) call m_Iter_unitcell_increment()
- call m_CtrlP_reset_iconvergence()
- endif
-end subroutine MDiterationNumber_Setting2
-
-logical function Rightafter_stress_correction()
- use m_IterationNumbers, only : iteration_stress_correction
- implicit none
- Rightafter_stress_correction = iteration_stress_correction == 4
-end function
-
-subroutine MDiterationNumber_Setting_pre
- use m_IterationNumbers, only : m_Iter_electronic_reset, m_Iter_stress_correction_incre
- use m_Control_Parameters, only : m_CtrlP_reset_iconvergence, sw_stress_correction
- use m_Const_Parameters, only : ON
- use m_Stress, only : m_Stress_in_correction, m_Stress_correction
- use m_Files, only : nfout
- implicit none
- if(sw_stress_correction == ON .and. m_Stress_in_correction(4)) then
- call m_Stress_correction(nfout)
- call m_Iter_electronic_reset
- call m_Iter_stress_correction_incre()
- call m_CtrlP_reset_iconvergence()
- endif
-end subroutine MDiterationNumber_Setting_pre
-
-subroutine MDiterationNumber_Setting3
- use m_Const_Parameters, only : DRIVER_URAMP
- use m_Control_Parameters, only : driver
- use m_IterationNumbers, only : m_Iter_electronic_reset,m_Iter_reset_iter_ionic &
- &, m_Iter_uramp_increment
- use m_Control_Parameters, only : driver, m_CtrlP_reset_iconvergence
- implicit none
- if(driver == DRIVER_URAMP)then
- call m_Iter_electronic_reset
- call m_Iter_reset_iter_ionic()
- call m_Iter_uramp_increment()
- call m_CtrlP_reset_iconvergence()
- endif
-end subroutine MDiterationNumber_Setting3
-
-subroutine MDiterationNumber_Setting_ep
- use m_IterationNumbers, only : m_Iter_mdIterN_increment&
- & , m_Iter_total_increment
- use m_Files, only : nfout
- implicit none
- call m_Iter_mdIterN_increment(nfout)
- call m_Iter_total_increment()
-end subroutine MDiterationNumber_Setting_ep
-
-subroutine IterationNumber_Setting
- use m_Control_Parameters,only: icond, ipritiming0&
- & , iprijobstatus, jobstatus_series, jobstatus_format, driver
- use m_IterationNumbers, only : m_Iter_electronic_incre &
- & , m_Iter_total_increment &
- & , iteration, first_iteration_of_this_job &
- & , iteration_electronic, iteration_ionic &
- & , iteration_unit_cell, iteration_uramp, iteration_scdft
- use m_Timing, only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter &
- & , m_Timing_wd_status
- use m_Const_Parameters, only : INITIAL, CONTINUATION &
- & , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION &
- & , START, ITERATIVE, ON, OFF, DRIVER_URAMP
- use m_Files, only : nfstatus,nfout &
- & , m_Files_open_nfstatus &
- & , m_Files_close_nfstatus &
- & , m_Files_skiptoend
- implicit none
- integer :: it, status_wdmode
- logical :: unitcell_can_change,Uramping,isSCDFT
-
- call tstatc_iter(iteration, first_iteration_of_this_job)
- it = iteration
- if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
- if(iteration == first_iteration_of_this_job) then
- call tstatc_wd0
- call flush(nfout)
- else
- if(ipritiming0 >= 1) call tstatc_wd(it)
- end if
- call tstatc_init
-
- if(iprijobstatus >=1 ) then
- call m_Files_open_nfstatus()
- if(iteration == first_iteration_of_this_job) then
- status_wdmode = START
- else
- status_wdmode = ITERATIVE
- if(jobstatus_series == ON) then
- call m_Files_skiptoend(nfstatus)
- else
- end if
- end if
- call m_Timing_wd_status(nfstatus,jobstatus_format,jobstatus_series,status_wdmode &
- & ,iteration,iteration_ionic,iteration_electronic)
- call m_Files_close_nfstatus()
- end if
-
- call m_Iter_electronic_incre()
- call m_Iter_total_increment()
-
- if(iprijobstatus >=1 ) then
- if(.not.unitcell_can_change()) then
- if(Uramping()) then
- write(nfout,'(" ---- iteration(total, uramp, ionic, electronic) = ",4i8," ----")') &
- & iteration, iteration_uramp, iteration_ionic, iteration_electronic
- else if (isSCDFT()) then
- write(nfout,'(" ---- iteration(total, scdft, ionic, electronic) = ",4i8," ----")') &
- & iteration, iteration_scdft, iteration_ionic, iteration_electronic
- else
- write(nfout,'(" ---- iteration(total, ionic, electronic) = ",3i8," ----")') &
- & iteration, iteration_ionic, iteration_electronic
- endif
- else
- write(nfout,'(" ---- iteration(total, unitcell, ionic, electronic) = ",4i8," ----")') &
- & iteration, iteration_unit_cell,iteration_ionic, iteration_electronic
- endif
- end if
-
-end subroutine IterationNumber_Setting
-
-subroutine IterationNumber_Setting_g()
- use m_Control_Parameters,only: icond,ipritiming0
- use m_IterationNumbers, only : iteration, first_iteration_of_this_job &
- & , iteration_electronic &
- & , m_Iter_total_increment &
- & , m_Iter_electronic_incre
- use m_Timing , only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter
- use m_Const_Parameters, only : INITIAL, CONTINUATION, FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
- implicit none
- integer :: it
-
- call tstatc_iter(iteration, first_iteration_of_this_job)
- it = iteration
- if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
- if(iteration_electronic == 0) then
- call tstatc_wd0()
- else
- if(ipritiming0 >= 1) call tstatc_wd(it)
- end if
- call tstatc_init()
-
- call m_Iter_electronic_incre()
- call m_Iter_total_increment()
-
-end subroutine IterationNumber_Setting_g
-
-subroutine IterationNumber_reset()
- use m_Timing , only : tstatc_init
- use m_IterationNumbers, only : m_Iter_electronic_reset
-
- call m_Iter_electronic_reset()
- call tstatc_init()
-end subroutine IterationNumber_reset
-
-subroutine KpointNumber_Setting()
- use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
- & , iteration_electronic, first_iteration_electronic &
- & , m_Iter_nk_incre &
- & , m_Iter_wd_electronic &
- & , m_Iter_wd_nk &
- & , m_Iter_electronic_reset &
- & , m_Iter_electronic_set
- use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
- use m_Files,only : nfout
-
-! ===================== added by K. Tagami ================== 11.0
- use m_Control_Parameters, only : noncol, ndim_spinor
-
- implicit none
-! =========================================================== 11.0
-
- call m_CtrlP_ntcnvg_reset()
-! =================================== modified by K. Tagami ======== 11.0
-!! call m_Iter_nk_incre(nspin)
- if ( noncol ) then
- call m_Iter_nk_incre(ndim_spinor)
- else
- call m_Iter_nk_incre(nspin)
- endif
-! ================================================================== 11.0
-
- if(nk_in_the_process == first_kpoint_in_this_job) then
- call m_Iter_electronic_set()
- else
- call m_Iter_electronic_reset()
- end if
- if(ipriekzaj <= 0) call m_Iter_electronic_reset()
- call m_Iter_wd_nk(nfout)
- call m_Iter_wd_electronic(nfout)
-
-end subroutine KpointNumber_Setting
-
-subroutine KpointNumber_Setting2()
- use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
- & , iteration_electronic, first_iteration_electronic &
- & , m_Iter_nk_incre2 &
- & , m_Iter_wd_electronic &
- & , m_Iter_wd_nk2 &
- & , m_Iter_electronic_reset &
- & , m_Iter_electronic_set
-!!$ & , m_Iter_nkgroup_set
- use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
- use m_Kpoints, only : kv3, kv3_ek
- use m_Files,only : nfout
-
-! ===================== added by K. Tagami ================== 11.0
- use m_Control_Parameters, only : noncol, ndim_spinor
-
- implicit none
-! =========================================================== 11.0
-
- call m_CtrlP_ntcnvg_reset()
-
-! ======================================= added by K. Tagami ============ 11.0
-! call m_Iter_nk_incre2(nspin,kv3_ek)
- if ( noncol ) then
- call m_Iter_nk_incre2( ndim_spinor,kv3_ek )
- else
- call m_Iter_nk_incre2( nspin,kv3_ek )
- endif
-! ====================================================================== 11.0
-
- if(nk_in_the_process == first_kpoint_in_this_job) then
- call m_Iter_electronic_set()
-!!$ call m_Iter_nkgroup_set(kv3)
- else
- call m_Iter_electronic_reset()
- end if
- if(ipriekzaj <= 0) call m_Iter_electronic_reset()
- call m_Iter_wd_nk2(nfout,kv3)
- call m_Iter_wd_electronic(nfout)
-
-end subroutine KpointNumber_Setting2
-
-!!$subroutine pIterationNumber_Setting()
-!!$ use m_IterationNumbers, only : m_Iter_positron_set()
-!!$ implicit none
-!!$ call m_Iter_positron_set()
-!!$end subroutine pIterationNumber_Setting
diff -ruN phase0_2023.01/src_phase/Makefile.Linux_generic phase0_2023.01.01/src_phase/Makefile.Linux_generic
--- phase0_2023.01/src_phase/Makefile.Linux_generic 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/Makefile.Linux_generic 2023-11-09 12:02:31.636099566 +0900
@@ -9,7 +9,9 @@
###########################################################################
###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
+ifndef F90
F90 = mpif90 -m64
+endif
CC = gcc -m64
CPP =
AR = ar -vq
diff -ruN phase0_2023.01/src_phase/Makefile.M1Mac phase0_2023.01.01/src_phase/Makefile.M1Mac
--- phase0_2023.01/src_phase/Makefile.M1Mac 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/Makefile.M1Mac 2023-11-09 12:02:31.610099430 +0900
@@ -9,14 +9,14 @@
###########################################################################
###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
-F90 = mpif90
+F90 = mpifort -fallow-argument-mismatch
CC = gcc
CPP =
AR = ar -vq
-LINK = mpif90
-F90FLAGS = -O2 -ffree-form -fallow-argument-mismatch #-ffree-line-length-none
-F77FLAGS = -O2 -ffixed-form -fallow-argument-mismatch -ffixed-line-length-72 #-ffree-line-length-none
-CFLAGS = -DINTEL -DDARWIN
+LINK = mpifort
+F90FLAGS = -O2 -ffree-form #-ffree-line-length-none
+F77FLAGS = -O2 -ffixed-form -ffixed-line-length-72 #-ffree-line-length-none
+CFLAGS = -DINTEL
ESM = yes
ifdef ESM
@@ -98,7 +98,7 @@
cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="" AR="$(AR)"
else
libesm.a:
- cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90) -fallow-argument-mismatch" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
endif
liblapack.a:
diff -ruN phase0_2023.01/src_phase/Renewal_of_Hubbard_Potential.f90 phase0_2023.01.01/src_phase/Renewal_of_Hubbard_Potential.f90
--- phase0_2023.01/src_phase/Renewal_of_Hubbard_Potential.f90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/Renewal_of_Hubbard_Potential.f90 2023-11-09 12:02:31.642099597 +0900
@@ -38,9 +38,9 @@
! $Id: Renewal_of_Hubbard_Potential.f90 376 2014-06-17 07:48:31Z jkoga $
use m_ES_Intgr_VlhxcQlm, only : m_ESiVQ_add_dhub_to_vlhxcQ
use m_Files, only : nfout
- use m_Hubbard, only : m_Hubbard_Potential
- use m_Control_Parameters, only : icond
- use m_Const_Parameters, only : FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
+!!$ use m_Hubbard, only : m_Hubbard_Potential
+!!$ use m_Control_Parameters, only : icond
+!!$ use m_Const_Parameters, only : FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
! ================================== K. Tagami ================== 5.0
use m_Hubbard, only : m_Hubbard_Potential2
@@ -50,8 +50,9 @@
use m_Control_Parameters, only : noncol
use m_ES_NonCollinear, only : m_ES_set_Mat_dion_scr_noncl
use m_Electronic_Structure, only : vlhxcQ, dhub_aimag
- use m_Hubbard, only : m_Hubbard_Potential2_noncl, &
- & m_Hubbard_Potential3_noncl
+ use m_Hubbard, only : m_Hubbard_Potential3_noncl
+!!$ use m_Hubbard, only : m_Hubbard_Potential2_noncl, &
+!!$ & m_Hubbard_Potential3_noncl
! ===================================================================== 11.0
diff -ruN phase0_2023.01/src_phase/b_Crystal_Structure.F90 phase0_2023.01.01/src_phase/b_Crystal_Structure.F90
--- phase0_2023.01/src_phase/b_Crystal_Structure.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/b_Crystal_Structure.F90 2023-11-09 12:02:31.644099607 +0900
@@ -1040,13 +1040,15 @@
end subroutine primitive2bravais
-logical function is_hexagonal(ca,cb,cc)
+logical function is_hexagonal(a,b,ca,cb,cc)
use m_Const_Parameters, only : DP
implicit none
+ real(kind=DP), intent(in) :: a,b
real(kind=DP), intent(in) :: ca,cb,cc
real(kind=DP), parameter :: epsilon = 1.d-10
is_hexagonal = .false.
- if (abs(ca)<epsilon .and. abs(cb)<epsilon .and. abs(abs(cc)-0.5d0)<epsilon) is_hexagonal=.true.
+ if (abs(ca)<epsilon .and. abs(cb)<epsilon .and. abs(abs(cc)-0.5d0)<epsilon .and. abs(a-b)<epsilon) &
+ & is_hexagonal=.true.
end function is_hexagonal
diff -ruN phase0_2023.01/src_phase/ekmain.F90 phase0_2023.01.01/src_phase/ekmain.F90
--- phase0_2023.01/src_phase/ekmain.F90 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2023.01.01/src_phase/ekmain.F90 2023-11-09 12:02:31.612099440 +0900
@@ -0,0 +1,88 @@
+!=======================================================================
+!
+! PROGRAM PHASE/0 2016.01 ($Rev: 606 $)
+!
+! PROGRAM: EK
+!
+! AUTHOR(S): T. Yamasaki August/20/2003
+! Further modification by T. Yamasaki Feb. 2004
+!
+! Contact address : Phase System Consortium
+! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
+!
+!
+!
+!=======================================================================
+!
+! The original version of this set of the computer programs "PHASE"
+! was developed by the members of the Theory Group of Joint Research
+! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
+! 1993-2001.
+!
+! Since 2002, this set has been tuned and new functions have been
+! added to it as a part of the national project "Frontier Simulation
+! Software for Industrial Science (FSIS)", which is supported by
+! the IT program of the Ministry of Education, Culture, Sports,
+! Science and Technology (MEXT) of Japan.
+! Since 2006, this program set has been developed as a part of the
+! national project "Revolutionary Simulation Software (RSS21)", which
+! is supported by the next-generation IT program of MEXT of Japan.
+! Since 2013, this program set has been further developed centering on PHASE System
+! Consortium.
+! The activity of development of this program set has been supervised by Takahisa Ohno.
+!
+!
+! $Id: ekmain.f90 606 2020-04-15 06:45:49Z ktagami $
+!
+program EK
+! This program was coded by T. Yamasaki(FUJITSU Laboratories Ltd.), 17th Feb. 2003.
+!
+ implicit none
+ logical :: EigenValues_are_Converged, AllKpoints_are_Calculated
+ logical :: Already_Converged
+ logical :: Ending_Time
+
+ call Initialization_set_ekmode_ON ! set `ekmode' ON in m_Control_Parameters
+ call Initialization(1) ! Initialization of mpi and file-setting
+ call InputData_Analysis
+ call Preparation(0) ! Basis set, symmetry check etc.
+ call Preparation_for_mpi(1) ! mpi
+ call PseudoPotential_Construction
+#ifdef ENABLE_ESM_PACK
+ call Preparation_for_ESM
+#endif
+ call Ewald_and_Structure_Factor ! Calculate Structure Factor
+ call Initial_Electronic_Structure()! read Charge Density, (lclchh)
+
+ KPOINTS: do
+! call KpointNumber_Setting()
+ call KpointNumber_Setting2()
+ call Preparation_ek ! (basnum)
+ call Preparation_for_mpi_ek ! mpi -> np_g1k, mp_g1k
+ call PseudoPotential_ek ! (kbint)
+ call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
+ if(.not.Already_Converged()) then
+ SolveWaveFunctions: do
+ if(Ending_Time()) exit KPOINTS
+ call IterationNumber_Setting()
+ call Renewal_of_WaveFunctions()
+ if(EigenValues_are_Converged()) exit SolveWaveFunctions
+ enddo SolveWaveFunctions
+ call Postprocessing_k()
+ if(AllKpoints_are_Calculated()) exit KPOINTS
+ else
+ exit KPOINTS
+ end if
+ enddo KPOINTS
+!!$ else
+!!$ write(6,'(" Already_Converged")')
+!!$ call KpointNumber_Setting()
+!!$ call Preparation_ek ! (basnum)
+!!$ call PseudoPotential_ek ! (kbint)
+!!$ call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
+!!$ end if
+
+ call Postprocessing(.false.)
+ call WriteDownData_onto_Files_ek()
+ call Finalization_of_mpi ! mpi
+end program EK
diff -ruN phase0_2023.01/src_phase/ekmain.f90 phase0_2023.01.01/src_phase/ekmain.f90
--- phase0_2023.01/src_phase/ekmain.f90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/ekmain.f90 1970-01-01 09:00:00.000000000 +0900
@@ -1,88 +0,0 @@
-!=======================================================================
-!
-! PROGRAM PHASE/0 2016.01 ($Rev: 606 $)
-!
-! PROGRAM: EK
-!
-! AUTHOR(S): T. Yamasaki August/20/2003
-! Further modification by T. Yamasaki Feb. 2004
-!
-! Contact address : Phase System Consortium
-! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
-!
-!
-!
-!=======================================================================
-!
-! The original version of this set of the computer programs "PHASE"
-! was developed by the members of the Theory Group of Joint Research
-! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
-! 1993-2001.
-!
-! Since 2002, this set has been tuned and new functions have been
-! added to it as a part of the national project "Frontier Simulation
-! Software for Industrial Science (FSIS)", which is supported by
-! the IT program of the Ministry of Education, Culture, Sports,
-! Science and Technology (MEXT) of Japan.
-! Since 2006, this program set has been developed as a part of the
-! national project "Revolutionary Simulation Software (RSS21)", which
-! is supported by the next-generation IT program of MEXT of Japan.
-! Since 2013, this program set has been further developed centering on PHASE System
-! Consortium.
-! The activity of development of this program set has been supervised by Takahisa Ohno.
-!
-!
-! $Id: ekmain.f90 606 2020-04-15 06:45:49Z ktagami $
-!
-program EK
-! This program was coded by T. Yamasaki(FUJITSU Laboratories Ltd.), 17th Feb. 2003.
-!
- implicit none
- logical :: EigenValues_are_Converged, AllKpoints_are_Calculated
- logical :: Already_Converged
- logical :: Ending_Time
-
- call Initialization_set_ekmode_ON ! set `ekmode' ON in m_Control_Parameters
- call Initialization(1) ! Initialization of mpi and file-setting
- call InputData_Analysis
- call Preparation(0) ! Basis set, symmetry check etc.
- call Preparation_for_mpi(1) ! mpi
- call PseudoPotential_Construction
-#ifdef ENABLE_ESM_PACK
- call Preparation_for_ESM
-#endif
- call Ewald_and_Structure_Factor ! Calculate Structure Factor
- call Initial_Electronic_Structure()! read Charge Density, (lclchh)
-
- KPOINTS: do
-! call KpointNumber_Setting()
- call KpointNumber_Setting2()
- call Preparation_ek ! (basnum)
- call Preparation_for_mpi_ek ! mpi -> np_g1k, mp_g1k
- call PseudoPotential_ek ! (kbint)
- call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
- if(.not.Already_Converged()) then
- SolveWaveFunctions: do
- if(Ending_Time()) exit KPOINTS
- call IterationNumber_Setting()
- call Renewal_of_WaveFunctions()
- if(EigenValues_are_Converged()) exit SolveWaveFunctions
- enddo SolveWaveFunctions
- call Postprocessing_k()
- if(AllKpoints_are_Calculated()) exit KPOINTS
- else
- exit KPOINTS
- end if
- enddo KPOINTS
-!!$ else
-!!$ write(6,'(" Already_Converged")')
-!!$ call KpointNumber_Setting()
-!!$ call Preparation_ek ! (basnum)
-!!$ call PseudoPotential_ek ! (kbint)
-!!$ call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
-!!$ end if
-
- call Postprocessing(.false.)
- call WriteDownData_onto_Files_ek()
- call Finalization_of_mpi ! mpi
-end program EK
diff -ruN phase0_2023.01/src_phase/input_interface.F90 phase0_2023.01.01/src_phase/input_interface.F90
--- phase0_2023.01/src_phase/input_interface.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/input_interface.F90 2023-11-09 12:02:31.643099602 +0900
@@ -556,7 +556,7 @@
logical, intent(in) :: is_hex, printable
character(FMAXUNITLEN) :: readunit
- real(DP) :: s, al, be, ga, sin_be, sin_ga, wk, alpha, beta,gamma
+ real(DP) :: s, al, be, ga, sin_be, sin_ga, wk, wkbuf, alpha, beta,gamma
real(DP), dimension(3) :: wvec
integer getRealVectorValue, realConvByUnit
integer getRealValue
@@ -608,13 +608,14 @@
ucinptype = 1
else if( getRealValue( trim(TAG_A)//char(0), wk, readunit ) == 0 ) then
!!$ if(printable) write(6,'(" !!! readunit = ",a15)') trim(readunit)
+ wkbuf = wk
if( realConvByUnit( wk, a, readunit, unit ) < 0 ) then
return;
end if
if( getRealValue( trim(TAG_B)//char(0), wk, readunit ) /= 0 ) then
!return;
- wk = a
+ wk = wkbuf
end if
if( realConvByUnit( wk, b, readunit, unit ) < 0 ) then
return;
@@ -622,7 +623,7 @@
if( getRealValue( trim(TAG_C)//char(0), wk, readunit ) /= 0 ) then
!return;
- wk = a
+ wk = wkbuf
end if
if( realConvByUnit( wk, c, readunit, unit ) < 0 ) then
return;
diff -ruN phase0_2023.01/src_phase/input_parse.h phase0_2023.01.01/src_phase/input_parse.h
--- phase0_2023.01/src_phase/input_parse.h 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/input_parse.h 2023-11-09 12:02:31.594099347 +0900
@@ -22,7 +22,7 @@
/*#include <fcntl.h>*/
/*#include <memory.h>*/
#include <stdlib.h>
-#ifndef DARWIN
+#ifndef __APPLE__
#include <malloc.h>
#else
#include <malloc/malloc.h>
diff -ruN phase0_2023.01/src_phase/m_BP_Properties.F90 phase0_2023.01.01/src_phase/m_BP_Properties.F90
--- phase0_2023.01/src_phase/m_BP_Properties.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_BP_Properties.F90 2023-11-09 12:02:31.607099414 +0900
@@ -806,7 +806,7 @@
real(kind=DP) :: eps0,eps1
real(kind=DP) :: pos0(natm,3),pos1(natm,3)
logical :: exists
- real(kind=DP) :: dphi_ion
+ real(kind=DP) :: dphi_ion, dphi_0, dphi_1
! === KT_add === 2015/03/23
ismax = nspin /ndim_spinor
@@ -822,39 +822,56 @@
call m_BP_get_Berry_phase_strain(ig,ist,cphi1,wgh1,nkp1,eps1,pos1,exists)
if(.not.exists) cycle STRAIN
present_strain(ist) = .true.
- if(nkp0.ne.nkp1) then
- if(printable) then
- write(nfout,*) 'nkp0=',nkp0
- write(nfout,*) 'nkp1=',nkp1
- end if
- call phase_error_with_msg(nfout,'nkp0 and nkp1 are different in <<<m_BP_calc_diff_Berry_strain>>', &
- __LINE__,__FILE__)
- end if
- ! debug
- ! write(nfout,*) 'ig,ist =',ig,ist
- ! end debug
+
+! <<< ASMS 2023.10.31
+! if(nkp0.ne.nkp1) then
+! if(printable) then
+! write(nfout,*) 'nkp0=',nkp0
+! write(nfout,*) 'nkp1=',nkp1
+! end if
+! call phase_error_with_msg(nfout,'nkp0 and nkp1 are different in <<<m_BP_calc_diff_Berry_strain>>', &
+! __LINE__,__FILE__)
+! end if
+! ! debug
+! ! write(nfout,*) 'ig,ist =',ig,ist
+! ! end debug
+! ASMS 2023.10.31 >>>
dphi(ig,ist) = 0.d0
- do is=1, ismax
- do k=1,nkp0
- if(wgh0(k).ne.wgh1(k)) then
- if(printable) then
- write(nfout,*) 'wgh0=',wgh0(k)
- write(nfout,*) 'wgh1=',wgh1(k)
- end if
- call phase_error_with_msg(nfout,'wgh0 and wgh1 are different in <<<m_BP_calc_diff_Berry_strain>>'&
- ,__LINE__,__FILE__)
- end if
- phi(k,is) = dimag(log(cphi1(k,is)/cphi0(k,is)))
-
- ! debug
- if(printable) write(nfout,*) 'k=',k,' is=',is,' phi=',phi(k,is)
- ! end debug
+! <<< ASMS 2023.10.31
+! do is=1, ismax
+! do k=1,nkp0
+! if(wgh0(k).ne.wgh1(k)) then
+! if(printable) then
+! write(nfout,*) 'wgh0=',wgh0(k)
+! write(nfout,*) 'wgh1=',wgh1(k)
+! end if
+! call phase_error_with_msg(nfout,'wgh0 and wgh1 are different in <<<m_BP_calc_diff_Berry_strain>>'&
+! ,__LINE__,__FILE__)
+! end if
+! phi(k,is) = dimag(log(cphi1(k,is)/cphi0(k,is)))
+!
+! ! debug
+! if(printable) write(nfout,*) 'k=',k,' is=',is,' phi=',phi(k,is)
+! ! end debug
+!
+! dphi(ig,ist) = dphi(ig,ist) + phi(k,is)*wgh0(k)
+! end do
+! end do
- dphi(ig,ist) = dphi(ig,ist) + phi(k,is)*wgh0(k)
+ dphi_0 = 0.0d0; dphi_1 = 0.0d0
+ do is=1, ismax
+ do k=1, nkp0
+ dphi_0 = dphi_0 +dimag(log(cphi0(k,is))) *wgh0(k)
+ end do
+ do k=1, nkp1
+ dphi_1 = dphi_1 +dimag(log(cphi1(k,is))) *wgh1(k)
end do
end do
+ dphi(ig,ist) = dphi_1 -dphi_0
+! ASMS 2023.10.31 >>>
+
dphi(ig,ist) = 2.d0*dphi(ig,ist)
! debug
@@ -915,7 +932,7 @@
integer :: i,ia,ist
real(kind=DP) :: dphi(3,6)
real(kind=DP) :: fac
- logical :: present_strain(natm)
+ logical :: present_strain(6)
if(.not.allocated(piezo)) allocate(piezo(3,6))
piezo = 0.d0
diff -ruN phase0_2023.01/src_phase/m_CD_mixing.F90 phase0_2023.01.01/src_phase/m_CD_mixing.F90
--- phase0_2023.01/src_phase/m_CD_mixing.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_CD_mixing.F90 2023-11-09 12:02:31.591099331 +0900
@@ -1,6 +1,9 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!#define _DUPLICATION_HSR_DOTPRODUCT_
+#define _PARALLEL_HSR_
!=======================================================================
!
-! SOFTWARE NAME : PHASE (ver. 900)
+! SOFTWARE NAME : PHASE/0 2023.01
!
! MODULE: m_Charge_Density
!
@@ -63,35 +66,29 @@
module m_CD_mixing
! $Id: m_CD_mixing.F90 593 2019-06-20 03:47:31Z jkoga $
- use m_Const_Parameters, only : BUCS, DP, OFF &
- & , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
- & , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
- & , OLD, NEXT, PAI, VTK &
- & , DELTA10 &
- & , unit_conv_byname, UMICRO, GAMMA, DELTA, ELECTRON, INVERSE, YES
+ use m_Const_Parameters, only : DP, OFF, BOHR,NO,YES,ANTIFERRO &
+ & , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY
use m_IterationNumbers, only : iteration,iteration_for_cmix
- use m_Parallelization, only : mpi_comm_group &
+ use m_Parallelization, only : m_Parallel_init_mpi_urec_hsr, mpi_comm_group &
& , ista_kngp,iend_kngp,is_kngp,ie_kngp,np_kngp,mp_kngp &
& , npes,mype,ierr &
& , is_kgpm,ie_kgpm,ista_kgpm,iend_kgpm,mp_kgpm &
- & , nis_fftp, nie_fftp, myrank_g, nrank_g
+ & , nis_fftp, nie_fftp, myrank_g, nrank_g, ista_atm, iend_atm &
+ & , ista_urec_hsr,iend_urec_hsr, ista_and_iend_urec_hsr_set
use m_Timing, only : tstatc0_begin, tstatc0_end
- use m_Control_Parameters, only : nspin,ipri,ipriwf,iprichargedensity,c_precon &
+ use m_Control_Parameters, only : nspin,ipri,c_precon &
& , amix,bmix,hownew,nbxmix,istrbr &
- & , kimg,af,neg,ipripulay &
- & , charge_filetype, charge_title, initial_chg &
- & , iprichargemixing, ipritotalcharge &
+ & , kimg,af,neg,ipripulay,iprichargemixing &
& , sw_recomposing, spin_density_mixfactor &
& , amin, sw_precon_diff, sw_metric_diff,metric_ratio &
& , sw_force_simple_mixing,printable, sw_control_stepsize, max_stepsize &
& , m_CtrlP_set_rmx, ommix_factor
use m_Crystal_Structure, only : univol,nopr
- use m_PlaneWaveBasisSet, only : kg,kgp,ngpt_l,ngabc,gr_l,kgpm
+ use m_PlaneWaveBasisSet, only : kg,kgp,gr_l,kgpm
use m_Charge_Density, only : chgq_l, chgqo_l ,symmtrz_of_ff
use m_Charge_Density, only : charge_average
-! === DEBUG by tkato 2011/09/09 ================================================
- use m_Charge_Density, only : work
-! ==============================================================================
+ use m_Charge_Density, only : work ! === DEBUG by tkato 2011/09/09 ===
+
! === Added by tkato 2011/11/09 ================================================
use m_Control_Parameters, only : sw_mix_bothspins_sametime &
, sw_recomposing_hsr, sw_force_simple_mixing_hsr &
@@ -110,22 +107,20 @@
use m_Control_Parameters, only : sw_gradient_simplex, alpha_pulay, alpha_pulay_damp, alpha_pulay_org, alpha_pulay_damp_thres
-! ===== KT_add ===== 13.0U3
- use m_Control_Parameters, only : precon_mode
-! ================== 13.0U3
-! ==== KT_Add === 2014/09/16
- use m_Control_Parameters, only : sw_mix_charge_hardpart, sw_mix_charge_with_ekindens
-! =============== 2014/09/16
+ use m_Control_Parameters, only : precon_mode ! ===== KT_add ===== 13.0U3
+ use m_Control_Parameters, only : sw_mix_charge_hardpart, sw_mix_charge_with_ekindens ! ==== KT_Add === 2014/09/16
use m_Charge_Density, only : m_CD_symmtrz_of_ff_noncl_C
use m_Orbital_Population, only : om, omold, ommix, om_aimag, omold_aimag, ommix_aimag
+!!$#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!!$ use m_Files, only : nfout
+!!$#endif
implicit none
-! --> 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), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
+ real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
real(kind=DP),private,pointer, dimension(:,:,:) :: rho,rhoo ! MPI
! rho => chgq_l, rhoo => chgqo_l ( when kgpm == kgp)
@@ -181,6 +176,8 @@
real(DP),private,pointer,dimension(:,:,:) :: urec_l_3_2
#endif
+ logical, save :: is_and_ie_hsr_set = .false.
+
logical :: force_dealloc = .false.
integer, private :: previous_waymix = 0
@@ -195,8 +192,7 @@
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)
+ real(kind=DP),private,allocatable, dimension(:,:) :: rho_hsr, rhoo_hsr ! d(nsize_rho_hsr,nspin)
real(DP),private,allocatable,dimension(:,:) :: d0_hsr, u_hsr, v_hsr, w_hsr, &
& dout_hsr, dd_hsr
@@ -221,7 +217,7 @@
! ========================== adde by K. Tagami ========================== 11.0
integer :: nsize_rho_hsr_realpart
-integer :: nsize_rho_om_realpart
+ integer :: nsize_rho_om_realpart
! integer :: sw_mix_imaginary_hardpart = OFF
! integer :: sw_mix_imaginary_hardpart = ON
! ======================================================================= 11.0
@@ -321,6 +317,31 @@
contains
+ subroutine m_CD_mixing_write_DEFINITION(nfout)
+ ! coded by T. Yamasaki, 2023/07/08
+ integer, intent(in) :: nfout
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(ipri>=1) then
+#endif
+ write(nfout,'(" !!")')
+ write(nfout,'(" !! <<m_CD_mixing_write_DEFINITION>>")')
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ write(nfout,'(" !! Compiler Defintion in (m_CD_mixing.F90) is _DUPLICATION_HSR_DOTPRODUCT_ ,", &
+ & "namely asis in HSR related dotproduction")')
+#else
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" !! Compiler Defintion in (m_CD_mixing.F90) is _PARALLEL_HSR__ ,",&
+ & "namely parallelized HSR related dotproduct")')
+#else
+ write(nfout,'(" !! Compiler Defintion in (m_CD_mixing.F90) is nothing, namely mpi_bcast after HSR related dotproduct")')
+#endif
+#endif
+ write(nfout,'(" !!")')
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ endif
+#endif
+ end subroutine m_CD_mixing_write_DEFINITION
+
subroutine alloc_chgqstore_recompose_chgq(rmxt,rmxtrc)
real(kind=DP),intent(in) :: rmxt
real(kind=DP),intent(out),dimension(nspin_m) :: rmxtrc
@@ -473,45 +494,25 @@
real(kind=DP) :: rmxtt
integer :: id_sname = -1
__TIMER_SUB_START(1103)
+ call tstatc0_begin('m_CD_simple_mixing ',id_sname,1)
-! ================================ modified by K. Tagami =============== 11.0
-!!! --> T. Yamasaki 03 Aug. 2009
-!! nspin_m = nspin/(af+1)
-!!! <--
-!
- if ( noncol ) then
+
+
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
nspin_m = ndim_magmom
else
nspin_m = nspin/(af+1)
endif
-! ====================================================================== 11.0
- call tstatc0_begin('m_CD_simple_mixing ',id_sname,1)
if(previous_waymix /= SIMPLE.or.force_dealloc) then
call mix_dealloc_previous()
-! ------------------------------ ktDEBUG -------------------- 20121030
- call mix_dealloc_previous_hsr()
-! ------------------------------ ktDEBUG -------------------- 20121030
+ call mix_dealloc_previous_hsr() ! --- ktDEBUG ---------------- 20121030
force_dealloc = .false.
end if
-! ================================ modified by K. Tagami =============== 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-!
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmxt,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc = rmxt
-! end if
-! if(ipri >= 2) write(nfout,'(" rmxt = ",d20.8)') rmxt
-!! --> T. Yamasaki 03 Aug. 2009
-!
-!
allocate(rmxtrc(nspin_m))
-
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc = rmxt
rmxtrc(2:nspin_m) = min( rmxt *spin_density_mixfactor, rmx_max )
else
@@ -523,57 +524,33 @@
end if
if(ipri >= 2) write(nfout,'(" rmxt = ",d20.8)') rmxt
-! ====================================================================== 11.0
-
-!!$ allocate(c_p(ista_kngp:iend_kngp))
- allocate(c_p(ista_kngp:iend_kngp,nspin_m))
- c_p = 0.0d0 ! ===== Adde by K. Tagami =========
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0.d0 ! =================== 11.0
! ================================ modified by K. Tagami =============== 11.0
!! call precon_4_charge_mix(rmxtrc,c_p)
!
if ( noncol ) then
call precon_4_charge_mix_noncl(rmxtrc,c_p)
-! write(*,*) 'rmxtrc = ', rmxtrc
-! write(*,*) 'cp = ', c_p
-! stop
else
call precon_4_charge_mix(rmxtrc,c_p)
-! write(*,*) 'rmxtrc = ', rmxtrc
-! write(*,*) 'cp = ', c_p
-! stop
endif
! ======================================================================= 11.0
__TIMER_DO_START(1148)
-! ================================ modified by K. Tagami ================ 11.0
-!! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 !! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
chgq_l(:,k,is) = c_p(:,is)*chgq_l(:,k,is) + (1.0d0-c_p(:,is))*chgqo_l(:,k,is)
end do
end do
__TIMER_DO_STOP(1148)
deallocate(c_p)
-
-! ================================ modified by K. Tagami ============= 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call compose_chgq_dealloc_chgqstore()
-! end if
-! deallocate(rmxtrc)
-!! <--
-
-!
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami ========= 11.0
if (sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call compose_chgq_dealloc_chgqstore()
end if
endif
deallocate(rmxtrc)
-! ==================================================================== 11.0
if(af /= 0) then
allocate(work(kgp,kimg))
@@ -752,6 +729,109 @@
endif
end function icrspd_is
+ subroutine mult_urec_hsr(nfout,u_hsr,v_hsr,fdpsum)
+ ! Coded by T. Yamasaki, 2023/07/07
+ integer :: nfout
+ real(DP), intent(in), dimension(nsize_rho_hsr,nspin_m) :: u_hsr, v_hsr
+ real(DP), intent(inout), dimension(nspin_m) :: fdpsum
+ real(DP), dimension(nspin_m) :: fmult
+ integer :: is, k
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(DP) :: time0, time1
+#endif
+
+#ifdef _PARALLEL_HSR_
+ if(.not.ista_and_iend_urec_hsr_set) &
+ & call m_Parallel_init_mpi_urec_hsr(nfout,nsize_rho_hsr) !-> ista_urec_hsr, iend_urec_hsr
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_comm_group,ierr)
+ time0 = MPI_Wtime()
+#endif
+ fmult = 0.d0
+#ifdef _PARALLEL_HSR_
+ do is = 1, ndim_magmom, af+1
+ do k = ista_urec_hsr, iend_urec_hsr
+ fmult(is) = fmult(is) + u_hsr(k,is) * v_hsr(k,is)
+ end do
+ end do
+ if(npes>=2) then
+ call mpi_allreduce(MPI_IN_PLACE, fmult, nspin_m, mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ end if
+#else
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ write(nfout,'(" not _PARALLEL_HSR_")')
+#endif
+ do is = 1, ndim_magmom, af+1
+ fmult(is) = fmult(is) + sum( u_hsr(:,is)*v_hsr(:,is) )
+ end do
+ call mpi_bcast(fmult, nspin_m, mpi_double_precision, 0, mpi_comm_group,ierr)
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_comm_group,ierr)
+ time1 = MPI_Wtime()
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" time in <<mult_urec_hsr>> = ",f20.8, " (mpi_allreduce)")') time1-time0
+#else
+ write(nfout,'(" time in <<mult_urec_hsr>> = ",f20.8, " (mpi_bcast)")') time1-time0
+#endif
+#endif
+ fdpsum = fdpsum + fmult
+ end subroutine mult_urec_hsr
+
+ subroutine mult_urec_hsr5(nfout,u_hsr,mb,muv,j,iuv,v_hsr,fdpsum)
+ ! Coded by T. Yamasaki, 2023/07/07
+ integer, intent(in) :: nfout,mb,muv,j,iuv
+ real(DP), intent(in), dimension(nsize_rho_hsr,nspin_m,mb,muv) :: u_hsr
+ real(DP), intent(in), dimension(nsize_rho_hsr,nspin_m) :: v_hsr
+ real(DP), intent(out), dimension(nspin_m) :: fdpsum
+ real(DP), dimension(nspin_m) :: fmult
+ integer :: is, k
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(DP) :: time0, time1
+#endif
+
+#ifdef _PARALLEL_HSR_
+ if(.not.is_and_ie_hsr_set) then
+ call m_Parallel_init_mpi_urec_hsr(nfout,nsize_rho_hsr) !-> ista_urec_hsr, iend_urec_hsr
+ is_and_ie_hsr_set = .true.
+ end if
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_comm_group,ierr)
+ time0 = MPI_Wtime()
+#endif
+ fmult = 0.d0
+#ifdef _PARALLEL_HSR_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
+ do k = ista_urec_hsr, iend_urec_hsr
+ fmult(is) = fmult(is) + u_hsr(k,is,j,iuv) * v_hsr(k,is)
+ end do
+ end do
+ if(npes>=2) then
+ call mpi_allreduce(MPI_IN_PLACE, fmult, nspin_m, mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
+ end if
+#else
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ write(nfout,'(" not _PARALLEL_HSR_")')
+#endif
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
+ fmult(is) = fmult(is) + sum( u_hsr(:,is,j,iuv)*v_hsr(:,is) )
+ end do
+ call mpi_bcast(fmult, nspin_m, mpi_double_precision, 0, mpi_comm_group,ierr)
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_comm_group,ierr)
+ time1 = MPI_Wtime()
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" time in <<mult_urec_hsr5>> = ",f20.8, " (mpi_allreduce)")') time1-time0
+#else
+ write(nfout,'(" time in <<mult_urec_hsr5>> = ",f20.8, " (mpi_bcast)")') time1-time0
+#endif
+#endif
+ fdpsum = fdpsum + fmult
+ end subroutine mult_urec_hsr5
+
subroutine mult1s(u,v,f_q,fmult)
real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m) :: u,v
real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
@@ -1103,6 +1183,11 @@
mxiter = (iter-istrbr+1) - 1
ncrspd(iter-istrbr+1) = iter-istrbr+1
endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ write(nfout,'(" mxiter = ",i5," <<set_ncrspd_mxiter_etc>>")') mxiter
+ write(nfout,'(" ncrspd = ",15i5)') ncrspd(1:mxiter)
+ call flush(nfout)
+#endif
__TIMER_SUB_STOP(1111)
contains
subroutine rotate_cmix_arrays
@@ -1853,10 +1938,9 @@
subroutine renew_d_br(j)
integer, intent(in) :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ====
+
__TIMER_SUB_START(1118)
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
@@ -1864,10 +1948,8 @@
#else
call mult1s5(urec_l,nbxmix,2,j,iV,F_l,f_p,vF) !-(m_CD);<v|F> ->vF
#endif
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! nspin==2 --> nspin_m==2 ! === DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
@@ -1887,18 +1969,13 @@
subroutine renew_d_last_br(p)
real(DP), intent(in), dimension(ista_kngp:iend_kngp) :: p
integer :: is, ik, i, ns
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1120)
call mult1s(v_l,F_l,f_p,vF) !-(m_CD) <v|F> ->vF
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! nspin==2 --> nspin_m==2 ! === DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
@@ -1912,10 +1989,8 @@
if(kgpm == kgp .or. npes == 1) then
__TIMER_DO_START(1166)
-! ===================================== modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din (:,:,is) = chgqo_l(ista_kgpm:iend_kgpm,:,is)
dout(:,:,is) = chgq_l (ista_kgpm:iend_kgpm,:,is)
end do
@@ -1955,18 +2030,46 @@
__TIMER_SUB_STOP(1120)
end subroutine renew_d_last_br
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ subroutine printvF(aorb,title,n,vF,j,i)
+ integer, intent(in) :: n
+ character(len=1), intent(in) :: aorb
+ character(len=n), intent(in) :: title
+ real(DP), intent(in) :: vF(nspin_m)
+ integer, intent(in), optional :: j,i
+!!$ character(len=80) :: fmt = ''
+!!$ write(fmt,*) "(a",n,")"
+ if(present(i) .and. present(j)) then
+ if(nspin_m == 1) then
+ write(nfout,'(" (",a1,") (j,i) = (",i2,",",i2,") ",a4,"(1) = ",f20.12)') aorb,j,i, title, vF(1)
+ else
+ write(nfout,'(" (",a1,") (j,i) = (",i2,",",i2,") ",a4,"(1) = ",f20.12, 2x,a4,"(2) = ",f20.12)') &
+ & aorb,j,i, title, vF(1), title, vF(2)
+ end if
+ else if(present(j)) then
+ if(nspin_m == 1) then
+ write(nfout,'(" (",a1,") j = ",i2,1x,a2,"(1) = ",f20.12)') aorb, j, title, vF(1)
+ else
+ write(nfout,'(" (",a1,") j = ",i2,1x,a2,"(1) = ",f20.12, 2x,a4,"(2) = ",f20.12)') aorb, j, title, vF(1), title, vF(2)
+ end if
+ else
+ if(nspin_m == 1) then
+ write(nfout,'(" (",a1,") ",a2,"(1) = ",f20.12)') aorb, title, vF(1)
+ else
+ write(nfout,'(" (",a1,") ",a2,"(1) = ",f20.12,2x, a4,"(2) = ",f20.12)') aorb, title, vF(1),title, vF(2)
+ end if
+ end if
+ end subroutine printvF
+#endif
+
! =========================== added by K. Tagami ================================== 5.0
- subroutine renew_u_br_with_hsr(j,i)
- integer, intent(in) :: j,i
+ subroutine renew_u_br_with_hsr(nfout,j,i)
+ integer, intent(in) :: nfout,j,i
integer :: is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: v_dF(nspin)
- real(DP) :: v_dF(nspin_m)
-! ==============================================================================
-
+ real(DP) :: v_dF(nspin_m) ! v_dF(nspin), revised by tkato 2011/11/24
+
v_dF = 0.d0
-
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
call mult1s(urec_l_3,dF_l,f_p,v_dF)!-(m_CD);<v|dF> ->v_dF
@@ -1974,50 +2077,47 @@
call mult1s5(urec_l,nbxmix,2,j,iV,dF_l,f_p,v_dF)
#endif
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"a","v_dF",4,v_dF,j,i)
+ write(nfout,'(" nsize_rho_hsr = ",i8)') nsize_rho_hsr
+#endif
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
v_dF(is) = v_dF(is) + sum( urec_hsr(:,is,j,iV)*dF_hsr(:,is) )
- End do
-!
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ end do
+#else
+ call mult_urec_hsr5(nfout,urec_hsr,nbxmix,2,j,iV,dF_hsr,v_dF) ! -(m_CD_mixing) <v_hsr|FF_hsr> -> v_dF_hsr by T. Yamasaki 2023/07/07
+#endif
+
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! nspin==2 --> nspin_m==2, by tkato 2011/11/24
v_dF(1) = v_dF(1) + v_dF(2)
v_df(2) = v_dF(1)
endif
-!
-! ======================== added by K. Tagami ==================== 11.0
- if ( noncol ) then
+
+ if ( noncol ) then ! === added by K. Tagami === 11.0
v_dF(1) = sum( v_dF(:) )
v_dF(:) = v_dF(1)
endif
-! ================================================================ 11.0
-
+
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"b","v_dF",4,v_dF,j,i)
+#endif
+
call subtr_j_th_term(v_dF,iU,j,urec_l,u_l) !-(m_CD)
! |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
u_hsr(:,is) = u_hsr(:,is) - v_dF(is) *urec_hsr(:,is,j,iU)
- End do
-! === DEBUG by tkato 2011/11/24 ================================================
-! if(hownew == RENEW) f(j,i,1:nspin) = v_dF(1:nspin)
- if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m)
-! ==============================================================================
+ end do
+
+ if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m) ! nspin --> nspin_m ! === DEBUG by tkato 2011/11/24 ===
end subroutine renew_u_br_with_hsr
- subroutine renew_d_br_with_hsr(j)
- integer, intent(in) :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+ subroutine renew_d_br_with_hsr(nfout,j)
+ integer, intent(in) :: nfout,j
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
+
integer :: is
vF = 0.d0
@@ -2029,17 +2129,19 @@
call mult1s5(urec_l,nbxmix,2,j,iV,F_l,f_p,vF) !-(m_CD);<v|F> ->vF
#endif
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
- vF(is) = vF(is) + sum( urec_hsr(:,is,j,iV)*FF_hsr(:,is) )
- End do
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"a","vF",2,vF,j)
+#endif
+
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 === modified by K. Tagami === 11.0
+ vF(is) = vF(is) + sum( urec_hsr(:,is,j,iV)*FF_hsr(:,is) )
+ end do
+#else
+ call mult_urec_hsr5(nfout,urec_hsr,nbxmix,2,j,iV,FF_hsr, vF) ! by T. Yamasaki 2023/07/07
+#endif
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! nspin --> nspin_m, ! === DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
@@ -2050,58 +2152,54 @@
vF(:) = vF(1)
endif
! ================================================================ 11.0
-
+
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"b","vF",2,vF,j)
+#endif
call subtr_j_th_term(vF,iU,j,urec_l,d0_l) !-(m_CD)
! |d(m)> = |d(m)> - <v(j)|F(m)>|u(j)>
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
d0_hsr(:,is) = d0_hsr(:,is) - vF(is) *urec_hsr(:,is,j,iU)
end do
end subroutine renew_d_br_with_hsr
- subroutine renew_d_last_br_with_hsr( p, rmxtrc_hsr )
+ subroutine renew_d_last_br_with_hsr(nfout, p, rmxtrc_hsr )
+ integer, intent(in) :: nfout
real(DP), intent(in), dimension(ista_kngp:iend_kngp) :: p
real(DP), intent(in) :: rmxtrc_hsr(nspin_m)
integer :: is, ik, i, ns
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
vF = 0.0d0
call mult1s(v_l,F_l,f_p,vF) !-(m_CD) <v|F> ->vF
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"a","vF",2,vF)
+#endif
+
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ do is = 1, ndim_magmom, af+1
vF(is) = vF(is) + sum( v_hsr(:,is)*FF_hsr(:,is) )
End do
+#else
+ call mult_urec_hsr(nfout,v_hsr,FF_hsr,vF) ! -(m_CD_mixing) <v_hsr|FF_hsr> -> vF_hsr, by T. Yamasaki 2023/07/07
+#endif
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! from nspin to nspin_m !== DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
-! ========================== added by K. Tagami =============== 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami ========= 11.0
vF(1) = sum( vF(:) )
vF(:) = vF(1)
endif
-! ============================================================= 11.0
if(kgpm == kgp .or. npes == 1) then
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din (:,:,is) = chgqo_l(ista_kgpm:iend_kgpm,:,is)
dout(:,:,is) = chgq_l (ista_kgpm:iend_kgpm,:,is)
end do
@@ -2110,15 +2208,14 @@
call scatter_chg_onto_d(chgq_l, dout) ! -(m_C.D.)
end if
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din_hsr (:,is) = rhoo_hsr(:,is) ! chgqo
dout_hsr(:,is) = rho_hsr (:,is) ! chgq
end do
-!!$ do is = 1, nspin, af+1
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"b","vF",2,vF)
+#endif
ns = nspin_for_qnewton()
do is = 1, ns,af+1
do ik = 1, kimg
@@ -2398,9 +2495,7 @@
if(af /= 0) then
allocate(work(kgp,kimg))
-! =============================================== Added by K. Tagami ========
- work = 0
-! ===========================================================================
+ work = 0 ! === Added by K. Tagami ===
call charge_average(ANTIFERRO,chgq_l)
deallocate(work)
endif
@@ -2420,10 +2515,9 @@
integer :: is,k,i
__TIMER_SUB_START(1110)
__TIMER_DO_START(1156)
-! ==================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ====================================================================== 11.0
+
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -2442,11 +2536,8 @@
end do
__TIMER_DO_STOP(1156)
__TIMER_DO_START(1157)
-! ================================= modified by K. Tagami =============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
v_l(:,k,is) = c_pm(:,is)*dd_l(:,k,is)
end do
@@ -2457,10 +2548,8 @@
subroutine renew_v(j)
integer, intent(in) :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: u_dd(nspin)
- real(DP) :: u_dd(nspin_m)
-! ==============================================================================
+
+ real(DP) :: u_dd(nspin_m) ! real(DP) :: u_dd(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1117)
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iU)
@@ -2579,9 +2668,7 @@
if(af /= 0) then
allocate(work(kgp,kimg))
-! ============================================== Added by K. Tagami =======
- work = 0
-! ========================================================================
+ work = 0 ! === Added by K. Tagami ===
call charge_average(ANTIFERRO,chgq_l)
deallocate(work)
endif
@@ -2600,11 +2687,7 @@
real(DP), dimension(nspin_m) :: fff
__TIMER_SUB_START(1125)
__TIMER_DO_START(1175)
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
-
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ==== modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -2625,10 +2708,7 @@
call mult1s(dF_l,dF_l,f_p,fff)
if(sum(fff) < 1.d-40) call phase_error_with_msg(nfout, ' fmult is too small',__LINE__,__FILE__)
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin == 2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin == 2 .and. ...) ! === DEBUG by tkato 2011/11/24 ===
fff(1) = fff(1) + fff(2)
fff(2) = fff(1)
endif
@@ -2641,10 +2721,7 @@
! ======================================================================== 11.0
__TIMER_DO_START(1176)
-! ========================================= modified by K. Tagami ========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
v_l(:,:,is) = dF_l(:,:,is)/fff(is)
end do
__TIMER_DO_STOP(1176)
@@ -2660,7 +2737,6 @@
logical, intent(in) :: mixocc
integer :: iter,j,mxiter,icr,jcr
-!!$ real(DP) :: v_dF(nspin),vF(nspin)
integer :: id_sname = -1
! --> T. Yamasaki 03 Aug. 2009
real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
@@ -2746,13 +2822,7 @@
endif
! ========================================================================== 11.0
-! ====================== Modified by K. Tagami =========
-! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-! =======================================================
-
! ============================= modiifed by K. Tagami =================== 11.0
! call precon_4_charge_mix(rmxtrc,c_p)
@@ -2783,8 +2853,8 @@
icr = icrspd_is(iter) !-(m_CD) function
do j = 2, mxiter
jcr = ncrspd(j)
- call renew_u_br_with_hsr(jcr,icr) !-(m_CD) |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
- call renew_d_br_with_hsr(jcr) !-(m_CD) |d(m)> = |d(m)> - <v(j)|F(m)> |u(j)>
+ call renew_u_br_with_hsr(nfout,jcr,icr) !-(m_CD) |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
+ call renew_d_br_with_hsr(nfout,jcr) !-(m_CD) |d(m)> = |d(m)> - <v(j)|F(m)> |u(j)>
enddo!j-loop
urec_l(:,:,:,icr,iU) = u_l(:,:,:) ! storing
@@ -2793,7 +2863,7 @@
urec_hsr(:,:,icr,iU) = u_hsr(:,:) ! storing
urec_hsr(:,:,icr,iV) = v_hsr(:,:) ! storing
- call renew_d_last_br_with_hsr( c_p, rmxtrc )
+ call renew_d_last_br_with_hsr(nfout, c_p, rmxtrc ) ! u_l, v_l, u_hsr, v_hsr --> rho, rho_hsr using vF(nspin_m)
!-(m_CD) chgq_l(|d(m)>) = |d(m)>-<v(m)|F(m)>|u(m)>
call mix_broyden_dealloc2 !-(m_CD)
@@ -2852,10 +2922,7 @@
integer :: is,k,i
real(DP), dimension(nspin_m) :: fff
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -2871,11 +2938,8 @@
if(mype == 0) u_l(1,k,is) = 0.d0
end do
end do
-!
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
dF_hsr(:,is) = ( rho_hsr(:,is)-rhoo_hsr(:,is)) - ( dout_hsr(:,is)-FF_hsr(:,is))
d0_hsr(:,is) = rhoo_hsr(:,is) + rmxtrc(is) *( rho_hsr(:,is) - rhoo_hsr(:,is))
u_hsr(:,is) = rmxtrc(is) *dF_hsr(:,is) + ( rhoo_hsr(:,is) - FF_hsr(:,is) )
@@ -2884,42 +2948,27 @@
call mult1s(dF_l,dF_l,f_p,fff)
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
fff(is) = fff(is) + sum( dF_hsr(:,is)*dF_hsr(:,is) )
end do
if(sum(fff) < 1.d-40) call phase_error_with_msg(nfout,' fmult is too small',__LINE__,__FILE__)
-!!!!!!!!
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin == 2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin == 2 .and. ...) then ! === DEBUG by tkato 2011/11/24 ===
fff(1) = fff(1) + fff(2)
fff(2) = fff(1)
endif
-! ========================= added by K. Tagami =========================== 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
fff(1) = sum( fff(:) )
fff(:) = fff(1)
endif
-! ======================================================================== 11.0
-! ========================================= modified by K. Tagami ========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
v_l(:,:,is) = dF_l(:,:,is)/fff(is)
end do
-! ========================================= modified by K. Tagami ========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do i=1,nsize_rho_hsr
v_hsr(i,is) = dF_hsr(i,is)/fff(is)
end do
@@ -2934,9 +2983,8 @@
real(DP),intent(in) :: rmx
integer :: iter,j,mxiter,icr,jcr
real(DP), pointer, dimension(:,:,:) :: F_l
-! === DEBUG by tkato 2011/11/24 ================================================
- real(DP) :: udF(nspin_m),wdF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: udF(nspin_m),wdF(nspin_m) ! === DEBUG by tkato 2011/11/24 ===
! --> T. Yamasaki 03 Aug. 2009
real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
! real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
@@ -3041,9 +3089,7 @@
if(af /= 0) then
allocate(work(kgp,kimg))
-! ================================================ Added by K. Tagami ========
- work = 0
-! =========================================================================
+ work = 0 ! === Added by K. Tagami ===
call charge_average(ANTIFERRO,chgq_l)
deallocate(work)
endif
@@ -3061,11 +3107,8 @@
integer :: is,k,i
__TIMER_SUB_START(1127)
__TIMER_DO_START(1177)
-! =============================== modified by K. Tagami ================ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -3085,10 +3128,8 @@
subroutine renew_w(j)
integer :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: y_dF(nspin),v_dF(nspin)
- real(DP) :: y_dF(nspin_m),v_dF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: y_dF(nspin_m),v_dF(nspin_m) ! real(DP) :: y_dF(nspin),v_dF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1128)
#ifdef _CDMIX_USE_POINTER_
@@ -3115,10 +3156,7 @@
subroutine renew_d(j)
integer :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: yF(nspin),vF(nspin)
- real(DP) :: yF(nspin_m),vF(nspin_m)
-! ==============================================================================
+ real(DP) :: yF(nspin_m),vF(nspin_m) ! real(DP) :: yF(nspin),vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1129)
#ifdef _CDMIX_USE_POINTER_
@@ -3143,16 +3181,10 @@
end subroutine renew_d
subroutine renew_d_last(udF,wdF)
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP),intent(in) :: udF(nspin),wdF(nspin)
- real(DP),intent(in) :: udF(nspin_m),wdF(nspin_m)
-! ==============================================================================
+ real(DP),intent(in) :: udF(nspin_m),wdF(nspin_m) ! real(DP),intent(in) :: udF(nspin),wdF(nspin) ! === DEBUG by tkato 2011/11/24 ===
integer :: is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: uF(nspin),wF(nspin)
- real(DP) :: uF(nspin_m),wF(nspin_m)
-! ==============================================================================
+ real(DP) :: uF(nspin_m),wF(nspin_m) ! real(DP) :: uF(nspin),wF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1130)
call mult1s(F_l,u_l,f_p,uF) ! ->uF = <u(m)|F(m)>
@@ -3164,10 +3196,8 @@
din = rhoo
dout = rho
__TIMER_DO_START(1178)
-! =================================== modified by K. Tagami ========= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
rho(:,:,is) = d0_l(:,:,is)-uF(is)*u_l(:,:,is)-wF(is)*w_l(:,:,is)
enddo
__TIMER_DO_STOP(1178)
@@ -3182,7 +3212,6 @@
end subroutine m_CD_mix_DFP
subroutine mix_pulay_allocate
-!!$ if(allocated(f_p)) return
! =============================== modified by K. Tagami ========== 11.0
! nspin_m = nspin/(af+1)
@@ -3194,10 +3223,8 @@
endif
! ================================================================= 11.0
-! =========================================== Modified by K. Tagami =========
-! allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_CD)
- allocate(f_p(ista_kgpm:iend_kgpm)); f_p = 0; call precon_4_mult(f_p) !-(m_CD)
-! ============================================================================
+! allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_CD)
+ allocate(f_p(ista_kgpm:iend_kgpm)); f_p = 0; call precon_4_mult(f_p) !-(m_CD), === Modified by K. Tagami ===
allocate(din(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(dout(ista_kgpm:iend_kgpm,kimg,nspin_m))
@@ -3244,9 +3271,7 @@
subroutine mix_pulay_alloc2
allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
-! =========================================== Added by K. Tagami ========
- d0_l = 0.0d0
-! =======================================================================
+ d0_l = 0.0d0 ! === Added by K. Tagami ===
call alloc_rho_rhoo_and_cpm
end subroutine mix_pulay_alloc2
@@ -3310,15 +3335,8 @@
! ====================================== Modified by K. Tagami =========
! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-! ========================================================================
-
-! =================================== modified by K. Tagami =============== 11.0
-! call precon_4_charge_mix(rmxtrc,c_p)
-!
if ( noncol ) then
call precon_4_charge_mix_noncl(rmxtrc,c_p)
else
@@ -3376,9 +3394,7 @@
if(af /= 0) then
allocate(work(kgp,kimg))
-! ==================================================== Added by K. Tagami ===
- work = 0
-! ==========================================================================
+ work = 0 ! === Added by K. Tagami ===
call charge_average(ANTIFERRO,chgq_l)
deallocate(work)
endif
@@ -3676,10 +3692,7 @@
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
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
div = 1.d0/f(1,1,is)
icount = 1
__TIMER_DO_START(1180)
@@ -3986,9 +3999,7 @@
if(af /= 0) then
allocate(work(kgp,kimg))
-! ==================================================== Added by K. Tagami ===
- work = 0
-! ==========================================================================
+ work = 0 ! === Added by K. Tagami ===
call charge_average(ANTIFERRO,chgq_l)
deallocate(work)
endif
@@ -4001,9 +4012,7 @@
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
-! =====================================================================
+ e_wk = 0; f_wk = 0; ww1 = 0; finv = 0; ip = 0 ! === Added by K. Tagami ===
end subroutine mix_pulay_alloc3
subroutine set_ncrspd_mxiter(n,iter,m)
@@ -4162,10 +4171,8 @@
subroutine Ri_dot_Rj_with_hsr(n)
integer, intent(in) :: n
integer :: it,jt,itc,jtc,is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: ff1(nspin),ff2(nspin),ff1tmp
- real(DP) :: ff1(nspin_m),ff2(nspin_m),ff1tmp
-! ==============================================================================
+ real(DP) :: ff1(nspin_m),ff2(nspin_m),ff1tmp ! real(DP) :: ff1(nspin),ff2(nspin),ff1tmp ! === DEBUG by tkato 2011/11/24 ===
+
do it = 1, n
itc = ncrspd(it)
do jt = it, n
@@ -4210,10 +4217,7 @@
subroutine Rj_dot_d_with_hsr(n)
integer, intent(in) :: n
integer :: jt, jtc, is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: ff1(nspin),ff2(nspin)
- real(DP) :: ff1(nspin_m),ff2(nspin_m)
-! ==============================================================================
+ real(DP) :: ff1(nspin_m),ff2(nspin_m) ! real(DP) :: ff1(nspin),ff2(nspin) ! === DEBUG by tkato 2011/11/24 ===
real(DP) :: ff1tmp
do jt = 1, n
jtc = ncrspd(jt)
@@ -4263,9 +4267,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
do is=1,nnspin
if(ipripulay >= 2) then
@@ -4324,9 +4326,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
g_p = 0.d0
do is = 1, nnspin
@@ -4524,10 +4524,7 @@
subroutine set_i2lp_max2lp()
integer :: it,ip
integer, parameter :: ntau0=2
-
-! =========================== added by K. Tagami ====================== 11.0
- integer :: nsize
-! ===================================================================== 11.0
+ integer :: nsize ! === added by K. Tagami === 11.0
allocate(i2lp(num_projectors))
do ip=1,num_projectors
@@ -4810,25 +4807,15 @@
integer :: is
-! =============================== modified by K.Tagami ================ 11.0
-! nspin_m = nspin/(af+1)
- if ( noncol ) then
+ if ( noncol ) then ! nspin_m = nspin/(af+1) ! === modified by K.Tagami === 11.0
nspin_m = ndim_magmom
else
- nspin_m = nspin/(af+1)
+ nspin_m = nspin/(af+1)
endif
-! ====================================================================== 11.0
allocate( rmxtrc(nspin_m) )
-! ============================= modified by K. Tagami =============== 11.0
-! if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
-! call alloc_hsrstore_recomp( rmxt, rmxtrc )
-! else
-! rmxtrc = rmxt
-! endif
-
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc = rmxt
rmxtrc(2:nspin_m) = min( rmxt *spin_density_mixfactor, rmx_max )
else
@@ -4838,12 +4825,8 @@
rmxtrc = rmxt
endif
end if
-! ==================================================================== 11.0
-! ====================== modified by K. Tagami ================ 11.0
-! Do is=1, nspin, af+1
- Do is=1, ndim_magmom, af+1
-! ============================================================= 11.0
+ Do is=1, ndim_magmom, af+1 ! Do is=1, nspin, af+1 ! === modified by K. Tagami === 11.0
hsr(:,:,:,is) = rmxtrc(is) *hsr(:,:,:,is) &
& + ( 1.d0-rmxtrc(is) )*hsro(:,:,:,is)
End do
@@ -4857,16 +4840,11 @@
endif
! ================================================================== 11.0
-! ================================= modified by K. Tagami ============= 11.0
-! if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
-! call compose_hsr_dealloc_store
-! end if
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2) then
call compose_hsr_dealloc_store
end if
endif
-! ===================================================================== 11.0
deallocate(rmxtrc)
end subroutine m_CD_simple_mixing_hard
@@ -4882,47 +4860,38 @@
do ia = 1, natm
it = ityp(ia)
if(ipaw(it)/=1) cycle
-! ==================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
-! do lmt1 = 1, ilmt(it)
-! do lmt2 = lmt1, ilmt(it)
-! hsr(ia,lmt1,lmt2,is) = rmxt*hsr(ia,lmt1,lmt2,is) + &
-! (1-rmxt)*hsro(ia,lmt1,lmt2,is)
-! end do! lmt2
-! end do! lmt1
-! end do! is
- if ( noncol ) then
- do is = 1, ndim_magmom
- do lmt1 = 1, ilmt(it)
- do lmt2 = lmt1, ilmt(it)
- hsr(ia,lmt1,lmt2,is) = rmxt*hsr(ia,lmt1,lmt2,is) + &
- (1-rmxt)*hsro(ia,lmt1,lmt2,is)
- end do! lmt2
- end do! lmt1
- end do! is
+
+ if ( noncol ) then ! ==================================== modified by K. Tagami ============ 11.0
+ do is = 1, ndim_magmom ! do is = 1, nspin, af+1
+ do lmt1 = 1, ilmt(it)
+ do lmt2 = lmt1, ilmt(it)
+ hsr(ia,lmt1,lmt2,is) = rmxt*hsr(ia,lmt1,lmt2,is) + &
+ & (1-rmxt)*hsro(ia,lmt1,lmt2,is)
+ end do! lmt2
+ end do! lmt1
+ end do! is
! --
- if ( sw_mix_imaginary_hardpart == ON ) then
- do is = 1, ndim_magmom
- do lmt1 = 1, ilmt(it)
- do lmt2 = lmt1, ilmt(it)
- hsi(ia,lmt1,lmt2,is) = rmxt*hsi(ia,lmt1,lmt2,is) &
- & +(1-rmxt)*hsio(ia,lmt1,lmt2,is)
- end do! lmt2
- end do! lmt1
- end do
- end if
+ if ( sw_mix_imaginary_hardpart == ON ) then
+ do is = 1, ndim_magmom ! do is = 1, nspin, af+1
+ do lmt1 = 1, ilmt(it)
+ do lmt2 = lmt1, ilmt(it)
+ hsi(ia,lmt1,lmt2,is) = rmxt*hsi(ia,lmt1,lmt2,is) &
+ & +(1-rmxt)*hsio(ia,lmt1,lmt2,is)
+ end do! lmt2
+ end do! lmt1
+ end do
+ end if
! -----
else
- do is = 1, nspin, af+1
- do lmt1 = 1, ilmt(it)
- do lmt2 = lmt1, ilmt(it)
- hsr(ia,lmt1,lmt2,is) = rmxt*hsr(ia,lmt1,lmt2,is) + &
- (1-rmxt)*hsro(ia,lmt1,lmt2,is)
+ do is = 1, nspin, af+1
+ do lmt1 = 1, ilmt(it)
+ do lmt2 = lmt1, ilmt(it)
+ hsr(ia,lmt1,lmt2,is) = rmxt*hsr(ia,lmt1,lmt2,is) &
+ & +(1-rmxt)*hsro(ia,lmt1,lmt2,is)
end do! lmt2
end do! lmt1
end do! is
- endif
-! ========================================================================== 11.0
+ endif ! ========================================================================== 11.0
end do! ia
__TIMER_DO_STOP(1192)
@@ -6366,9 +6335,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
do is=1,nnspin
if(ipripulay >= 2) then
@@ -6427,9 +6394,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
g_p = 0.d0
do is = 1, nnspin
diff -ruN phase0_2023.01/src_phase/m_CLS_dipquad.F90 phase0_2023.01.01/src_phase/m_CLS_dipquad.F90
--- phase0_2023.01/src_phase/m_CLS_dipquad.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_CLS_dipquad.F90 2023-11-09 12:02:31.643099602 +0900
@@ -438,9 +438,9 @@
fac1 = PAI4 *PAI ! latter : i pi delta
- Spectr_E1_E1 = Spectr_E1_E1 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E2_E2 = Spectr_E2_E2 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E1_E2 = Spectr_E1_E2 /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E1(:) = Spectr_E1_E1(:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E2_E2(:) = Spectr_E2_E2(:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E2(:) = Spectr_E1_E2(:) /dble(kv3_fbz/nspin) /univol *fac1
if ( nspin == 1 ) then
Spectr_E1_E1 = Spectr_E1_E1 *2.0d0
Spectr_E2_E2 = Spectr_E2_E2 *2.0d0
@@ -675,9 +675,9 @@
fac1 = PAI4 *PAI ! latter : i pi delta
- Spectr_E1_E1 = Spectr_E1_E1 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E2_E2 = Spectr_E2_E2 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E1_E2 = Spectr_E1_E2 /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E1(:,:) = Spectr_E1_E1(:,:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E2_E2(:,:) = Spectr_E2_E2(:,:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E2(:,:) = Spectr_E1_E2(:,:) /dble(kv3_fbz/nspin) /univol *fac1
if ( nspin == 1 ) then
Spectr_E1_E1 = Spectr_E1_E1 *2.0d0
Spectr_E2_E2 = Spectr_E2_E2 *2.0d0
diff -ruN phase0_2023.01/src_phase/m_Crystal_Structure.F90 phase0_2023.01.01/src_phase/m_Crystal_Structure.F90
--- phase0_2023.01/src_phase/m_Crystal_Structure.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Crystal_Structure.F90 2023-11-09 12:02:31.646099618 +0900
@@ -920,7 +920,7 @@
call m_CS_gnrt_tmatrices(il)
if ( sw_strained_cell == OFF ) then
- if(is_hexagonal(ca,cb,cc).and. il==1 .and. symmetry_method == AUTOMATIC) then
+ if(is_hexagonal(a,b,ca,cb,cc).and. il==1 .and. symmetry_method == AUTOMATIC) then
if(printable) then
write(nfout,'(" !** lattice_system is converted to hexagonal")')
endif
diff -ruN phase0_2023.01/src_phase/m_ES_WF_by_submat.F90 phase0_2023.01.01/src_phase/m_ES_WF_by_submat.F90
--- phase0_2023.01/src_phase/m_ES_WF_by_submat.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_ES_WF_by_submat.F90 2023-11-09 12:02:31.639099581 +0900
@@ -1,3 +1,4 @@
+!!$#define DEBUG_WRITE
!=======================================================================
!
! PROGRAM PHASE/0 2016.01 ($Rev: 597 $)
@@ -178,6 +179,13 @@
integer :: ierr
include 'mpif.h'
+
+#ifdef DEBUG_WRITE
+ integer, parameter :: DEBUGPRINTLEVEL = 1
+#else
+ integer, parameter :: DEBUGPRINTLEVEL = 2
+#endif
+
contains
subroutine m_ESsubmat_alloc()
if(.not.allocated(non_diagonal_part_is_small)) then
@@ -217,7 +225,7 @@
n_all_kpoints = 0
n_submat = 0
!!$ if(m_CtrlP_ntcnvg_clear()) non_diagonal_part_is_small = .false.
- if(iprisubmat >= 2) write(nfout,'(" !! <<m_ESsubmat_Renew_WF>>")')
+ if(iprisubmat >=DEBUGPRINTLEVEL) write(nfout,'(" !! <<m_ESsubmat_Renew_WF>>")')
call get_ipri0(iprisubmat,ipri0)
if(ipri0 >= 2) call m_ES_wd_eko(nfout,mode=SCF)
@@ -231,10 +239,10 @@
if(map_k(ik) /= myrank_k) cycle ! MPI
n_all_kpoints = n_all_kpoints + 1
if(non_diagonal_part_is_small(ik)) then
- if(iprisubmat >= 2) write(nfout,'(" !!! submat is not done for ik=",i4)') ik
+ if(iprisubmat >=DEBUGPRINTLEVEL) write(nfout,'(" !!! submat is not done for ik=",i4)') ik
cycle
else
- if(iprisubmat >= 2) write(nfout,'(" !!! submat is done for ik=",i4)') ik
+ if(iprisubmat >=DEBUGPRINTLEVEL) write(nfout,'(" !!! submat is done for ik=",i4)') ik
n_submat = n_submat + 1
submat_is_done = .true.
end if
diff -ruN phase0_2023.01/src_phase/m_ES_nonlocal.F90 phase0_2023.01.01/src_phase/m_ES_nonlocal.F90
--- phase0_2023.01/src_phase/m_ES_nonlocal.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_ES_nonlocal.F90 2023-11-09 12:02:31.595099352 +0900
@@ -1254,7 +1254,7 @@
complex(kind=DP), allocatable, dimension(:,:) :: wkexp
integer :: ia,it,ig,iksnl,ik,lmt1,lmt2,im1,im2,lmtt1,lmtt2,lmta1,lmta2,il1,il2,mil
integer :: ispin
- complex(kind=DP) :: ctmp,i1=(0.d0,1.d0)
+ complex(kind=DP) :: ctmp,cfac,i1=(0.d0,1.d0)
real(kind=DP) :: tmp
integer :: mdvdb
integer :: icount
@@ -1299,6 +1299,7 @@
il1 = ltp(lmt1,it)
im1 = mtp(lmt1,it)
mil = mod(il1-1,4)
+ cfac = i1**(-mil)
if(il1 == il2 .and. im1 == im2) then
!!$ tmp = dion(lmt1,lmt2,it) + vlhxcQ(lmt1,lmt2,ia,ispin)
if(ipaw(it)==0) then
@@ -1317,7 +1318,7 @@
tmp = tmp * iwei(ia)
! do ig=1,iba(ik)
do ig=ibl1,ibl2
- ctmp = (i1**-(mil))*wkexp(ig,ia)*snl(ig,lmtt1,iksnl)
+ ctmp = cfac*wkexp(ig,ia)*snl(ig,lmtt1,iksnl)
AtaulmaG(ig,lmta2,ik,1) = AtaulmaG(ig,lmta2,ik,1) + tmp * real(ctmp)
AtaulmaG(ig,lmta2,ik,2) = AtaulmaG(ig,lmta2,ik,2) + tmp * dimag(ctmp)
enddo
@@ -1325,7 +1326,7 @@
tmp = q(lmt1,lmt2,it)*iwei(ia)
! do ig=1,iba(ik)
do ig=ibl1,ibl2
- ctmp = (i1**-(mil))*wkexp(ig,ia)*snl(ig,lmtt1,iksnl)
+ ctmp = cfac*wkexp(ig,ia)*snl(ig,lmtt1,iksnl)
BtaulmaG(ig,icount,ik,1) = BtaulmaG(ig,icount,ik,1) + tmp * real(ctmp)
BtaulmaG(ig,icount,ik,2) = BtaulmaG(ig,icount,ik,2) + tmp * dimag(ctmp)
enddo
diff -ruN phase0_2023.01/src_phase/m_Epsilon_ek.F90 phase0_2023.01.01/src_phase/m_Epsilon_ek.F90
--- phase0_2023.01/src_phase/m_Epsilon_ek.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Epsilon_ek.F90 2023-11-09 12:02:31.626099513 +0900
@@ -103,7 +103,7 @@
& , GENERAL, GENERAL_LARGER, NONAME, MESH, MONKHORST_PACK &
& , SKPS_DIRECT_IN, GAMMA, FILE,NODATA, TETRAHEDRON &
& , NEW_, FMAXVALLEN,LOWER, PARABOLIC, PARA, ANTIFERRO, FERRO, INITIAL, CONTINUATION &
- & , ONE_BY_ONE, har => Hartree, BOHR, bohr_r => BOHR_RADIUS
+ & , ONE_BY_ONE, har => Hartree, BOHR, bohr_r => BOHR_RADIUS, FIXED_CHARGE
use m_IterationNumbers, only : nk_in_the_process,nk_converged,iteration &
& , first_iteration_of_this_job,iteration_scdft,nkgroup
use m_Parallelization, only : is_kngp,ie_kngp,npes,mype,ierr,map_k &
@@ -1108,7 +1108,8 @@
kpt_file_mode = 0
kpt_data_mode = 0
crystal=SINGLE_CRYSTAL
- nrd_efermi=2
+! nrd_efermi=2
+ nrd_efermi=0
Dirac_point_option = 0
active_space_option = 0
n_check_ts=1
@@ -2093,7 +2094,9 @@
allocate(refi(nstep)); refi=0.0d0
allocate(absc(nstep)); absc=0.0d0
allocate(reflc(nstep)); reflc=0.0d0
- if(OPL/=0.0d0) allocate(absb(nstep)); absb = 0.0d0
+ if(OPL/=0.0d0) then
+ allocate(absb(nstep)); absb = 0.0d0
+ endif
allocate(ocr(nstep)); ocr =0.0d0
allocate(oci(nstep)); oci = 0.0d0
end subroutine alloc_arrays_for_optics
@@ -7167,7 +7170,7 @@
end do
if(.not.trm_rptrans_allocated) then
- if(icond == 2) then
+ if(icond == INITIAL .or. icond == FIXED_CHARGE) then
num_vb = nvb
num_cb = neg-nvb
if(active_space_option == 1) then
@@ -8877,6 +8880,10 @@
endif
! =================== 2014/09/22
+ if(allocated(n_filled)) deallocate(n_filled)
+ if(allocated(n_unfilled)) deallocate(n_unfilled)
+ if(allocated(n_half_filled)) deallocate(n_half_filled)
+
allocate(n_filled(nspin_kt)) ; n_filled = 0
allocate(n_unfilled(nspin_kt)); n_unfilled = 0
allocate(n_half_filled(nspin_kt)); n_half_filled = 0
@@ -8979,6 +8986,7 @@
if( (.not.noncol) .and. (nspin_kt==1) .and. (.not.metalic_system) ) then
nfband = int(totch*0.5d0)
do ib = 1, neg
+ if(map_e(ib) == myrank_e) then
if ( icond == INITIAL .or. icond == CONTINUATION ) then
else
band_type(ib,1)=UNFILLED_BAND
@@ -8988,11 +8996,13 @@
band_type(ib,1) = FILLED_BAND
band_ch(ib,1) = 1.0d0
end if
+ endif
end do
! else if(noncol .eqv. .false. .and. nspin_kt == 1 .and. metalic_system .eqv. .true.) then
else if ( (.not.noncol) .and. (nspin_kt==1) .and. metalic_system ) then
nfband = int(totch*0.5d0)
do ib = 1, neg
+ if(map_e(ib) == myrank_e) then
if ( icond == INITIAL .or. icond == CONTINUATION ) then
else
band_type(ib,1)=UNFILLED_BAND
@@ -9002,6 +9012,7 @@
band_type(ib,1) = FILLED_BAND
band_ch(ib,1) = 1.0d0
end if
+ endif
end do
do ib = 1, neg
if(map_e(ib) == myrank_e) then
@@ -11558,7 +11569,7 @@
write(nfout,'(1x," nstep_l0 = ",i6,3x,"nstep_l = ",i6)') nstep_l0, nstep_l
write(nfout,'(1x," nst = ",i6)') nst
write(nfout,'(1x," nstep_min = ",i6,3x," nstep_max = ",i6)') nstep_min, nstep_max
- write(nfout,'(1x," emin for impes = ",f10.5,1x,"eV")') (e_low + (nstep_min - 1)*e_step)*hartree_in_eV
+ write(nfout,'(1x," emin for imeps = ",f10.5,1x,"eV")') (e_low + (nstep_min - 1)*e_step)*hartree_in_eV
write(nfout,'(1x," emax for imeps = ",f10.5,1x,"eV")') (e_low + (nstep_max - 1)*e_step)*hartree_in_eV
write(nfout,'(1x," n_start = ",i6,1x," : photon energy =",f10.5)') n_start, (e_low + (n_start-1)*e_step)*hartree_in_eV
write(nfout,'(1x," n_end = ",i6,1x," : photon energy =",f10.5)') n_end, (e_low + (n_end-1)*e_step)*hartree_in_eV
@@ -12222,7 +12233,7 @@
integer :: ispin,ip2
allocate(eko_t(neg))
allocate(neordr_t(neg))
- if(icond==2) then
+ if(icond==INITIAL .or. icond==FIXED_CHARGE) then
if(np2*nspin/=nk_converged) then
if(printable) then
write(nfout,*) nspin
diff -ruN phase0_2023.01/src_phase/m_Files.F90 phase0_2023.01.01/src_phase/m_Files.F90
--- phase0_2023.01/src_phase/m_Files.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Files.F90 2023-11-09 12:02:31.640099586 +0900
@@ -1,3 +1,4 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
!=======================================================================
!
! SOFTWARE NAME : PHASE ($Revision: 633 $)
@@ -2439,8 +2440,10 @@
subroutine m_Files_close_logfile()
if(mype == 0) then
close(nfout, status='keep')
+#ifndef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
else if(ipriparadeb == 0) then
close(nfout, status='delete')
+#endif
else
close(nfout, status='keep')
end if
diff -ruN phase0_2023.01/src_phase/m_Ionic_System.F90 phase0_2023.01.01/src_phase/m_Ionic_System.F90
--- phase0_2023.01/src_phase/m_Ionic_System.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Ionic_System.F90 2023-11-09 12:02:31.645099612 +0900
@@ -16098,7 +16098,6 @@
racov = dftd3par%covrad(iaelem)
do i=1,nnei(ia)
itmp = indlist(i,ia)
- if(itmp == ia) cycle
ielem = nint(iatomn(ityp_full(itmp)))
rbcov = dftd3par%covrad(ielem)
rinv = 1.d0/rlist(i,ia)
@@ -18823,7 +18822,7 @@
character(len=256) :: idstr
n = 0
- if(f_getStringValue(tag_target_element,rstr)==0) then
+ if(f_getStringValue(tag_target_element,rstr, LOWER)==0) then
found = .false.
do j=1,ntyp
if(rstr == speciesname(j)) then
diff -ruN phase0_2023.01/src_phase/m_Orbital_Population.F90 phase0_2023.01.01/src_phase/m_Orbital_Population.F90
--- phase0_2023.01/src_phase/m_Orbital_Population.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Orbital_Population.F90 2023-11-09 12:02:31.631099539 +0900
@@ -1,3 +1,4 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
!=======================================================================
!
! SOFTWARE NAME : PHASE (ver. 7.01)
@@ -538,6 +539,10 @@
integer :: ig,ip,i
integer :: ilp
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(kind=DP) :: om2_sum, hsr2_sum
+ om2_sum = 0.d0
+#endif
#ifdef __TIMER_SUB__
call timer_sta(737)
@@ -625,6 +630,32 @@
call wd_occ_mat(om)
end if
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ om2_sum = 0.d0
+ hsr2_sum = 0.d0
+ do is = 1, nspin
+ do ia = 1, natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+ do i = 1, num_proj_elems(ig)
+ do m2 = 1, max2lp
+ do m1 = 1, max2lp
+ om2_sum = om2_sum + om(m1,m2,i,ia,is)*om(m1,m2,i,ia,is)
+ end do
+ end do
+ end do
+ end do
+ do ia = 1, natm
+ it = ityp(ia)
+ do ilmt1 = 1, ilmt(it)
+ do ilmt2 = 1, ilmt(it)
+ hsr2_sum = hsr2_sum + hsr(ia,ilmt2,ilmt1,is)*hsr(ia,ilmt2,ilmt1,is)
+ end do
+ end do
+ end do
+ end do
+ write(nfout,'(" om2_sum = ",f20.10, " hsr2_sum = ",f20.10, " <<m_OP_occ_mat_ylm>>")') om2_sum, hsr2_sum
+#endif
if ( sw_mix_charge_hardpart == OFF ) call symmetrize_occ_mat(om)
! call symmetrize_occ_mat(om)
if( pmode==1 .and. iprihubbard > 1) then
diff -ruN phase0_2023.01/src_phase/m_Parallelization.F90 phase0_2023.01.01/src_phase/m_Parallelization.F90
--- phase0_2023.01/src_phase/m_Parallelization.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Parallelization.F90 2023-11-09 12:02:31.629099529 +0900
@@ -150,6 +150,8 @@
! BROYDEN or DFP MIXING METHOD
integer :: ista_kgpm,iend_kgpm, np_kgpm, mp_kgpm
integer, allocatable, dimension(:) :: is_kgpm, ie_kgpm, nel_kgpm
+ integer :: ista_urec_hsr, iend_urec_hsr
+ logical, save :: ista_and_iend_urec_hsr_set = .false.
! FFT BOX
integer :: npes_cdfft, nrank_ggacmp, nrest_cdfft
@@ -639,6 +641,7 @@
!!!!!!!!!!!!!!!!! modified by mizouchi@adv 2003.02.27 !!!!!!!!!!!!!!
integer :: nn , neflag, nkflag
!!!!!!!!!!!!!!!!! modified by mizouchi@adv 2003.02.27 !!!!!!!!!!!!!!
+ logical :: wrong_ne, wrong_nk
if(printable) then
if(conf_para) then
@@ -666,7 +669,8 @@
!!!!!!!!!!!!!!!!! modified by mizouchi@adv 2003.02.27 !!!!!!!!!!!!!!
read_from_args = .false.
if(mype==0) then
-
+ wrong_ne = .false.
+ wrong_nk = .false.
neflag=0
nkflag=0
narg = iargc()
@@ -691,8 +695,7 @@
read(q1,*) n1
else
if(printable) write(6,*) 'wrong ne'
- !stop "wrong ne "
- call phase_error_with_msg(6,'wrong ne',__LINE__,__FILE__)
+ wrong_ne = .true.
end if
else if(q1(3:3) == "=".or. q1(3:3) == ":") then
call getarg(nn+1,q1)
@@ -700,8 +703,7 @@
read(q1,*) n1
else
if(printable) write(6,*) 'wrong ne'
- !stop "wrong ne "
- call phase_error_with_msg(6,'wrong ne',__LINE__,__FILE__)
+ wrong_ne = .true.
end if
else
call getarg(nn+1,q1)
@@ -711,8 +713,7 @@
read(q1,*) n1
else
if(printable) write(6,*) 'wrong ne'
- !stop "wrong ne "
- call phase_error_with_msg(6,'wrong ne',__LINE__,__FILE__)
+ wrong_ne = .true.
end if
else if((q1(1:1) == "=".or.q1(1:1) == ":").and. len_trim(q1(2:)).eq.0) then
call getarg(nn+2,q1)
@@ -720,13 +721,11 @@
read(q1,*) n1
else
if(printable) write(6,*) 'wrong ne'
- !stop "wrong ne "
- call phase_error_with_msg(6,'wrong ne',__LINE__,__FILE__)
+ wrong_ne = .true.
end if
else
if(printable) write(6,*) 'wrong ne'
- !stop "wrong ne "
- call phase_error_with_msg(6,'wrong ne',__LINE__,__FILE__)
+ wrong_ne = .true.
end if
end if
end if
@@ -744,8 +743,7 @@
read(q1,*) n2
else
if(printable) write(6,*) 'wrong nk'
- !stop "wrong nk "
- call phase_error_with_msg(6,'wrong nk',__LINE__,__FILE__)
+ wrong_nk = .true.
end if
else if(q1(3:3) == "=".or.q1(3:3) == ":") then
call getarg(nn+1,q1)
@@ -753,8 +751,7 @@
read(q1,*) n2
else
if(printable) write(6,*) 'wrong nk'
- !stop "wrong nk "
- call phase_error_with_msg(6,'wrong nk',__LINE__,__FILE__)
+ wrong_nk = .true.
end if
else
call getarg(nn+1,q1)
@@ -764,8 +761,7 @@
read(q1,*) n2
else
if(printable) write(6,*) 'wrong nk'
- !stop "wrong nk "
- call phase_error_with_msg(6,'wrong nk',__LINE__,__FILE__)
+ wrong_nk = .true.
end if
else if((q1(1:1) == "=".or.q1(1:1) == ":").and. len_trim(q1(2:)).eq.0) then
call getarg(nn+2,q1)
@@ -773,13 +769,11 @@
read(q1,*) n2
else
if(printable) write(6,*) 'wrong nk'
- !stop "wrong nk "
- call phase_error_with_msg(6,'wrong nk',__LINE__,__FILE__)
+ wrong_nk = .true.
end if
else
if(printable) write(6,*) 'wrong nk'
- !stop "wrong nk "
- call phase_error_with_msg(6,'wrong nk',__LINE__,__FILE__)
+ wrong_nk = .true.
end if
end if
end if
@@ -787,21 +781,34 @@
end do
- if(neflag == 0 .or. nkflag == 0) then
-! if(printable) write(6,*) 'set default ne and nk'
- n1 = npes
- n2 = npes/n1
- else
- read_from_args = .true.
- end if
+ end if
- if(neflag >= 2 .or. nkflag >= 2) then
- !if(printable) write(6,*) 'wrong ne and nk'
- !stop "wrong ne and nk "
- call phase_error_with_msg(6,'wrong ne and nk',__LINE__,__FILE__)
- end if
+ if(npes>1) call mpi_bcast(neflag,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(nkflag,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(wrong_nk,1,mpi_logical,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(wrong_ne,1,mpi_logical,0,mpi_comm_group,ierr)
+
+ if(neflag == 0 .or. nkflag == 0) then
+! if(printable) write(6,*) 'set default ne and nk'
+ n1 = npes
+ n2 = npes/n1
+ else
+ read_from_args = .true.
+ end if
+ if(neflag >= 2 .or. nkflag >= 2 .or. (wrong_nk .and. wrong_ne)) then
+ !if(printable) write(6,*) 'wrong ne and nk'
+ call phase_error_with_msg(6,'wrong ne and nk',__LINE__,__FILE__)
end if
+
+ if(wrong_nk) then
+ call phase_error_with_msg(6,'wrong nk',__LINE__,__FILE__)
+ endif
+
+ if(wrong_ne) then
+ call phase_error_with_msg(6,'wrong ne',__LINE__,__FILE__)
+ endif
+
! <---- ! modified by mizouchi@adv 2003.02.27 !!!!!!!!!!!!!!
if(npes>1) call mpi_bcast(n1,1,mpi_integer,0,mpi_comm_group,ierr)
@@ -815,7 +822,8 @@
n2 = npes/n1
#endif
if(n1*n2 /= npes) then
- call phase_execution_error(PARALLELIZATION_INVALID_2D)
+ !call phase_execution_error(PARALLELIZATION_INVALID_2D)
+ call phase_error_with_msg(6,'npes /= ne * nk',__LINE__,__FILE__)
else
nrank_e = n1
nrank_k = n2
@@ -1024,6 +1032,25 @@
__TIMER_SUB_STOP(1235)
end subroutine m_Parallel_init_mpi_nbmx
+ subroutine m_Parallel_init_mpi_urec_hsr(nfout,nsize_rho_hsr)
+ ! Coded by T. Ymasaki, 2023/07/07
+ integer, intent(in) :: nfout, nsize_rho_hsr
+ integer, allocatable, dimension(:) :: is_hsr, ie_hsr
+ integer :: iwork, k
+ allocate(is_hsr(0:npes-1),ie_hsr(0:npes-1))
+ iwork = ( nsize_rho_hsr - 1)/npes + 1
+ do k = 0, npes-1
+ is_hsr(k) = min(k*iwork+1,nsize_rho_hsr+1)
+ ie_hsr(k) = min(is_hsr(k)+iwork-1,nsize_rho_hsr)
+ end do
+ ista_urec_hsr = is_hsr(mype)
+ iend_urec_hsr = ie_hsr(mype)
+ write(nfout,'(" ista_urec_hsr = ",i8, " iend_urec_hsr = ",i8)') ista_urec_hsr, iend_urec_hsr
+ call flush(nfout)
+ deallocate(is_hsr, ie_hsr)
+ ista_and_iend_urec_hsr_set = .true.
+ end subroutine m_Parallel_init_mpi_urec_hsr
+
subroutine set_block_range4allgather(ne,np,nel_p,nis_p,nie_p,idisp_p)
integer, intent(in) :: ne ! number of total elements
integer, intent(in) :: np ! number of ranks (or processors)
diff -ruN phase0_2023.01/src_phase/m_PseudoPotential.F90 phase0_2023.01.01/src_phase/m_PseudoPotential.F90
--- phase0_2023.01/src_phase/m_PseudoPotential.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_PseudoPotential.F90 2023-11-09 12:02:31.609099425 +0900
@@ -4622,10 +4622,10 @@
!
if ( mode == 0 ) then
if ( mype == 0 ) then
- allocate( flag(max_orb) ); flag = 0
- allocate( val_nl(max_orb) )
- allocate( val_l(max_orb) ); val_l = 0
- allocate( val_tau(max_orb) ); val_tau = 0
+ if(.not.allocated(flag)) allocate( flag(max_orb) ); flag = 0
+ if(.not.allocated(val_nl)) allocate( val_nl(max_orb) )
+ if(.not.allocated(val_l)) allocate( val_l(max_orb) ); val_l = 0
+ if(.not.allocated(val_tau)) allocate( val_tau(max_orb) ); val_tau = 0
count = 0
Do while ( .true. )
diff -ruN phase0_2023.01/src_phase/m_SpinOrbit_RadInt.F90 phase0_2023.01.01/src_phase/m_SpinOrbit_RadInt.F90
--- phase0_2023.01/src_phase/m_SpinOrbit_RadInt.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_SpinOrbit_RadInt.F90 2023-11-09 12:02:31.608099420 +0900
@@ -528,7 +528,7 @@
else
allocate( rho_work(mmesh,nspin,max_sph_expansion) ); rho_work = 0.0d0
-#if 0
+#if 1
nrmax = nrc
#else
nrmax = nmesh(it)
diff -ruN phase0_2023.01/src_phase/m_SpinOrbit_SecondVariation.F90 phase0_2023.01.01/src_phase/m_SpinOrbit_SecondVariation.F90
--- phase0_2023.01/src_phase/m_SpinOrbit_SecondVariation.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_SpinOrbit_SecondVariation.F90 2023-11-09 12:02:31.611099435 +0900
@@ -810,7 +810,7 @@
if(map_e(ie) /= myrank_e) cycle
ito = nrvf_ordr(ie,ik)
Do is=1, ndim_spinor_socsv
- a_all( (ito-1)*ndim_spinor_socsv +is,iktmp) = a_l(map_z(ie),ik)
+ a_all( (ito-1)*ndim_spinor_socsv +is,iktmp) = a_l(map_z(ie),ik+is-1)
End Do
end do
end do
diff -ruN phase0_2023.01/src_phase/m_Total_Energy.F90 phase0_2023.01.01/src_phase/m_Total_Energy.F90
--- phase0_2023.01/src_phase/m_Total_Energy.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_Total_Energy.F90 2023-11-09 12:02:31.626099513 +0900
@@ -1,3 +1,4 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
!=======================================================================
!
! PROGRAM PHASE/0 2016.01 ($Rev: 633 $)
@@ -1428,6 +1429,16 @@
if(sw_hubbard==ON) write(nfout,'(" !D EHUB1 = ",f12.5)') ehub1
if(sw_hybrid_functional == ON) write(nfout,'(" !D VEXX = ",f12.5)') vexx
endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(sw_hubbard==ON) then
+ write(nfout,'(" !D EBAND= ",F20.12," EOHXC= ",F20.12," ELOCA1= ",F20.12," ENONLC= ",F20.12, " EHUB1= ",F20.12)') &
+ & EBAND, EOHXC, ELOCA1, ENONLC, EHUB1
+ else
+ write(nfout,'(" !D EBAND= ",F20.12," EOHXC= ",F20.12," ELOCA1= ",F20.12," ENONLC= ",F20.12)') &
+ & EBAND, EOHXC, ELOCA1, ENONLC
+ end if
+#endif
+
#ifdef __TIMER_SUB__
call timer_end(747)
#endif
@@ -2415,7 +2426,11 @@
if(way_of_smearing == MP) &
& etotal0 = (1.d0/(dble(order_mp+2)))*(dble(order_mp+1)*etotal+etotal0)
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(display_on) then
+#else
if(display_on .and. ipri >= 1) then
+#endif
edel = cal_edeltb()
!!$ write(nfout,600) iteration,etotal,etotal
!!$ write(nfout,600) iteration,etotal,edel
diff -ruN phase0_2023.01/src_phase/m_constraints.F90 phase0_2023.01.01/src_phase/m_constraints.F90
--- phase0_2023.01/src_phase/m_constraints.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_constraints.F90 2023-11-09 12:02:31.597099362 +0900
@@ -821,16 +821,24 @@
endif
end subroutine parse_mobile_and_monitor
- subroutine prep_reac_coords_1D(constrainable_coord,uni)
+ subroutine prep_reac_coords_1D(constrainable_coord,uni,min_val)
type(constrainable_coords_t), intent(inout) :: constrainable_coord
integer, intent(in) :: uni
+ real(DP), intent(in), optional :: min_val
character(len=256) :: tag
integer :: f_getIntValue, f_getRealValue,f_selectBlock,f_selectParentBlock
integer :: i
integer :: iret
real(DP) :: dret
real(DP) :: factor
- real(DP) :: fval,incre
+ real(DP) :: fval,incre,val
+ logical :: has_minval
+ real(DP) :: mval
+ has_minval = .false.
+ if(present(min_val)) then
+ mval = min_val
+ has_minval = .true.
+ endif
tag=''
if( f_selectBlock(tag_reaction_coordinate)==0 ) then
factor = 1
@@ -866,6 +874,13 @@
allocate(constrainable_coord%finished(constrainable_coord%n_reaction_coords+1))
constrainable_coord%finished=.false.
do i=1,constrainable_coord%n_reaction_coords
+ val = constrainable_coord%value(1) + incre*i
+ if(has_minval) then
+ if (val<min_val) then
+ constrainable_coord%n_reaction_coords = constrainable_coord%n_reaction_coords-1
+ cycle
+ endif
+ endif
constrainable_coord%reaction_coords(i,1) = constrainable_coord%value(1) &
& + incre * i
enddo
@@ -1061,7 +1076,7 @@
iret = f_selectParentBlock()
endif
constrainable_coord%value(1) = get_curr_dfc(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_dfc_constraint
real(kind=DP) function get_curr_dfc(constrainable_coord)
@@ -1160,7 +1175,7 @@
endif
constrainable_coord%value(1) = get_curr_dfp(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,DISTANCE_FROM_POS)
+ call prep_reac_coords_1D(constrainable_coord,DISTANCE_FROM_POS,very_small)
end subroutine read_dfp_constraint
end module distance_from_pos_constraint
@@ -1294,7 +1309,7 @@
endif
constrainable_coord%value(1) = get_distance_between_com(1,2,constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_bl_constraint
@@ -1460,7 +1475,6 @@
'you must specify at least four atoms in order to define a '//trim(constrainable_coord%nam)//' constraint' &
,__LINE__,__FILE__)
endif
- constrainable_coord%n_associated_atoms = ntot
call alloc_constrainable_coord(constrainable_coord)
call parse_mobile_and_monitor(constrainable_coord)
if(f_selectBlock('dihedral')==0)then
@@ -2111,7 +2125,7 @@
constrainable_coord%value(1) = get_curr_coord_num(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,NO_UNIT)
+ call prep_reac_coords_1D(constrainable_coord,NO_UNIT,very_small)
end subroutine read_coord_num_constraint
@@ -2279,7 +2293,7 @@
call parse_mobile_and_monitor(constrainable_coord)
constrainable_coord%value(1) = get_curr_bl_sum(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_bl_sum_constraint
function get_indices(constrainable_coord)
@@ -2653,7 +2667,7 @@
call alloc_constrainable_coord(constrainable_coord,allocate_map = .false.)
call parse_mobile_and_monitor(constrainable_coord)
constrainable_coord%value(1) = get_curr_distance_from_ref(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_dref_constraint
diff -ruN phase0_2023.01/src_phase/m_dimer.F90 phase0_2023.01.01/src_phase/m_dimer.F90
--- phase0_2023.01/src_phase/m_dimer.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/m_dimer.F90 2023-11-09 12:02:31.611099435 +0900
@@ -108,8 +108,8 @@
end if
dimvars%for(i,:,:) = forc_l(:,:)
dimvars%ene(i) = etotal
- write(nfout,'(a,i8,f20.10)') '!** DIMER METHOD energy for atom ',i,dimvars%ene(i)
- write(nfout,'(a,i8)') '!** DIMER METHOD forces for atom ',i
+ write(nfout,'(a,i8,f20.10)') '!** dimer method energy for configuration ',i,dimvars%ene(i)
+ write(nfout,'(a,i8)') '!** dimer method forces for configuration ',i
do ia=1, dimvars%natm
write(nfout,'(i8,3f20.10)') ia,dimvars%for(i,ia,1:3)
enddo
@@ -190,7 +190,7 @@
pos(ia,1:3) = matmul(transpose(rltv),r(ia,1:3))/PAI2
end do
if(mype == 0) then
- write(nfout,'(a,i5)') '!** DIMER METHOD coordinates for dimer ',i
+ write(nfout,'(a,i5)') '!** dimer method coordinates for configuration ',i
do ia=1, dimvars%natm
write(nfout,'(i8,3f20.10)') ia,cps(ia,1:3)
enddo
@@ -220,7 +220,7 @@
call alloc_dimer(natm)
do i=1, dimvars%natm
dimvars%mobile(i) = imdtyp(i)
- if(mype==0) write(nfout,'(a,2i8)') '!** DIMER METHOD moblie',i,dimvars%mobile(i)
+ if(mype==0) write(nfout,'(a,2i8)') '!** dimer method moblie',i,dimvars%mobile(i)
enddo
dimvars%dR = delta_r
dimvars%dtheta = delta_theta
@@ -265,10 +265,13 @@
subroutine finalize_dimer_method()
use m_Files, only : nfdynm, nfenf, m_Files_close_all, m_Files_close_logfile
+ use m_Control_parameters, only : terminated_because
+ use m_Const_Parameters, only : FORCE_CONVERGENCE_REACHED
call dealloc_dimer()
close(nfdynm)
close(nfenf)
call m_Files_close_all()
+ terminated_because = FORCE_CONVERGENCE_REACHED
call PrintStatus()
call m_Files_close_logfile()
end subroutine finalize_dimer_method
@@ -304,7 +307,7 @@
dimvars%dt = neb_dt
dimvars%max_dimer_iteration = 2000
!pp_generated = .false.
- write(nfout,'(a,f15.5)') '!** DIMER METHOD dt',dimvars%dt
+ write(nfout,'(a,f15.5)') '!** dimer method dt',dimvars%dt
end subroutine alloc_dimer
subroutine set_r1_r2(natm, r1, r2)
@@ -319,7 +322,7 @@
if(mype==0) then
do i=1, dimvars%natm
! if (dimvars%mobile(i)==ON) then
- write(nfout,'(a,i10,3f10.5)') '!** DIMER METHOD vector N ',i,dimvars%N(i,1:3)
+ write(nfout,'(a,i10,3f10.5)') '!** dimer method vector N ',i,dimvars%N(i,1:3)
! endif
enddo
endif
@@ -370,7 +373,7 @@
enddo
dimvars%curvature = 0.5d0*dimvars%curvature/dimvars%dR
if(printable) then
- write(nfout,'(a,f15.5)') '!** DIMER METHOD curvature',dimvars%curvature
+ write(nfout,'(a,f15.5)') '!** dimer method curvature',dimvars%curvature
endif
end subroutine cal_curvature
@@ -378,7 +381,7 @@
integer :: i
real(kind=DP) :: fac
dimvars%e = dimvars%ene(1) + dimvars%ene(2)
- write(nfout,'(a,f15.5)') '!** DIMER METHOD dimer energy ',dimvars%e
+ write(nfout,'(a,f15.5)') '!** dimer method dimer energy ',dimvars%e
dimvars%e0 = dimvars%e*0.5d0
fac = 0.25d0*dimvars%dR
do i=1, dimvars%natm
@@ -387,7 +390,7 @@
! endif
enddo
if(printable) then
- write(nfout,'(a,f15.5)') '!** DIMER METHOD e0',dimvars%e0
+ write(nfout,'(a,f15.5)') '!** dimer method e0',dimvars%e0
endif
end subroutine cal_dimer_energies
@@ -411,7 +414,7 @@
if(mype==0) then
do i=1, dimvars%natm
! if(dimvars%mobile(i)) then
- write(nfout,'(a,i8,3f20.10)') '!** DIMER METHOD theta',i,dimvars%theta(i,1:3)
+ write(nfout,'(a,i8,3f20.10)') '!** dimer method theta',i,dimvars%theta(i,1:3)
! endif
enddo
endif
@@ -446,7 +449,7 @@
call normalize(dimvars%natm, dimvars%N)
if(printable) then
do i=1, dimvars%natm
- write(nfout,'(a,i10,3f10.5)') '!** DIMER METHOD vector N ',i,dimvars%N(i,1:3)
+ write(nfout,'(a,i10,3f10.5)') '!** dimer method vector N ',i,dimvars%N(i,1:3)
enddo
endif
end subroutine update_N
@@ -522,7 +525,7 @@
dimvars%max_force = fmax
deallocate(transfor)
- if(mype==0) write(nfout, '(a,f15.8)') '!** DIMER METHOD max translational force ',fmax
+ if(mype==0) write(nfout, '(a,f15.8)') '!** dimer method max translational force ',fmax
end subroutine translate_dimer
@@ -716,7 +719,7 @@
call write_result(idimer)
if(dimvars%max_force<dimvars%threshold) then
if(printable) write(nfout,'(a,f15.8)') &
- '!** DIMER METHOD reached convergence. max translational force : ',dimvars%max_force
+ '!** dimer method reached convergence. max translational force : ',dimvars%max_force
exit
endif
enddo
diff -ruN phase0_2023.01/src_phase/mdmain0.F90 phase0_2023.01.01/src_phase/mdmain0.F90
--- phase0_2023.01/src_phase/mdmain0.F90 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/mdmain0.F90 2023-11-09 12:02:31.645099612 +0900
@@ -443,7 +443,7 @@
if(iteration-first_iteration_of_this_job <= 0 .or. iteration_scdft<=1) then
Break_SC_DFT = .false.
else
- if(dabs(epsilon0 - epsilon0_previous) < max(0.0, delta_epsilon)) then
+ if(dabs(epsilon0 - epsilon0_previous) < max(0.d0, delta_epsilon)) then
Break_SC_DFT = .true.
else
if(iteration_scdft > max_scdft_iteration) then
diff -ruN phase0_2023.01/src_phase/update_version_h.sh phase0_2023.01.01/src_phase/update_version_h.sh
--- phase0_2023.01/src_phase/update_version_h.sh 2023-06-28 09:27:11.000000000 +0900
+++ phase0_2023.01.01/src_phase/update_version_h.sh 2023-11-09 12:02:31.632099545 +0900
@@ -1,6 +1,6 @@
#!/bin/sh
if [ -e ../.git ];then
-echo -n 'character(len=40), parameter :: commit_id = ' > version.h ; git rev-parse --sq HEAD >> version.h
+echo -n 'character(len=40), parameter :: commit_id = ' > version.h ; git rev-parse --sq HEAD >> version.h ; echo >> version.h
else
-echo -n "character(len=40), parameter :: commit_id = 'unknown'" > version.h
+echo "character(len=40), parameter :: commit_id = 'unknown'" > version.h
fi
diff -ruN phase0_2023.01/src_phase/version.h phase0_2023.01.01/src_phase/version.h
--- phase0_2023.01/src_phase/version.h 2023-06-28 09:27:57.000000000 +0900
+++ phase0_2023.01.01/src_phase/version.h 2023-11-09 12:02:31.590099326 +0900
@@ -1 +1 @@
-character(len=40), parameter :: commit_id = '297be2ee5c8c4fd395a4de15a7a54b0984ce518c'
\ ファイル末尾に改行がありません
+character(len=40), parameter :: commit_id = '4d1db69edbcf1176ee168b84fb4caad2e1e451c7'
diff -ruN phase0_2023.01/src_phase_3d/ChargeDensity_Mixing.F90 phase0_2023.01.01/src_phase_3d/ChargeDensity_Mixing.F90
--- phase0_2023.01/src_phase_3d/ChargeDensity_Mixing.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/ChargeDensity_Mixing.F90 2023-11-09 12:02:33.687110380 +0900
@@ -1,6 +1,6 @@
!=======================================================================
!
-! PROGRAM PHASE/0 2016.01 ($Rev: 615 $)
+! PROGRAM PHASE/0 2023.01
!
! SUBROUINE: ChargeDensity_Mixing
!
@@ -34,10 +34,10 @@
! $Id: ChargeDensity_Mixing.F90 615 2020-05-08 13:58:30Z ktagami $
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, hsro
+ use m_Charge_Density, only : m_CD_check
use m_CD_mixing, only : m_CD_simple_mixing, m_CD_prepare_precon &
& ,m_CD_mix_broyden1,m_CD_mix_broyden2,m_CD_mix_DFP &
- & ,m_CD_mix_pulay, m_CD_simple_mixing_hsr
+ & ,m_CD_mix_pulay, m_CD_simple_mixing_hsr, m_CD_mixing_write_DEFINITION
use m_Ionic_System, only : natm
use m_Total_Energy, only : m_TE_what_is_edeltb_now, m_TE_wd_total_energy_with_solvers
use m_Control_Parameters, only : c_precon,waymix,intzaj,icond &
@@ -69,15 +69,9 @@
use m_Orbital_Population, only : m_OP_cp_om_to_ommix
! ==================================================================== 5.0
-
use m_CD_Mag_Moment, only : m_CD_calc_ChgMagMom_in_sphere, m_CD_print_ChgMagmom_on_atom &
& , sw_monitor_atomcharge
-! ================================= added by K. Tagami ================== 11.0
- use m_Control_Parameters, only : noncol,hardpart_mixfactor
-!! use m_Charge_Density, only : m_CD_check_noncl, &
-!! & m_CD_estim_magmom_local
-! ======================================================================== 11.0
-
+ use m_Control_Parameters, only : hardpart_mixfactor ! === added by K. Tagami === 11.0
! === KT_add ==== 2014/09/19
use m_Control_Parameters, only : sw_calc_ekin_density, ekin_density_type, &
@@ -98,6 +92,7 @@
integer :: waymix_at_CDmix
logical :: ini = .false., mixer_changed
real(kind=DP) :: rmxt_tot, rmxt_hard, rmxt_occmat
+ integer,save :: definition_check_in_m_CD_mixing = 0
#ifdef __TIMER_SUB__
call timer_sta(1101)
#endif
@@ -105,6 +100,13 @@
if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) return
+ if(iprichargemixing>=1) then
+ if(definition_check_in_m_CD_mixing == 0) then
+ call m_CD_mixing_write_DEFINITION(nfout)
+ definition_check_in_m_CD_mixing = 1
+ end if
+ end if
+
edeltb_per_atom = m_TE_what_is_edeltb_now()/natm
waymix_at_CDmix = m_CtrlP_waymix_now(iteration_electronic, iteration_ionic &
& , edeltb_per_atom,mixer_changed)
@@ -168,7 +170,6 @@
endif
! ================================================================= 5.0
-
call m_CD_check(nfout)
if ( sw_monitor_atomcharge == ON ) then
call m_CD_calc_ChgMagMom_in_sphere
@@ -250,7 +251,7 @@
case (BROYD1)
! call m_CD_mix_broyden1_with_hsr(rmxt_tot)
write(*,*) 'Not supported '
- call phase_error_with_msg(nfout,'Not supported ',__LINE__,__FILE__)
+ call phase_error_with_msg(nfout,' broyd1 unsupported',__LINE__,__FILE__)
case (BROYD2)
call m_CD_mix_broyden2_with_hsr(nfout,rmxt_tot,sw_mix_occ_matrix==ON)
@@ -260,8 +261,9 @@
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 '
- call phase_error_with_msg(nfout,'Not supported ',__LINE__,__FILE__)
+ !write(*,*) 'Not supported '
+! stop
+ call phase_error_with_msg(nfout,' dfp unsupported',__LINE__,__FILE__)
case (PULAY)
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
diff -ruN phase0_2023.01/src_phase_3d/Convergence_Check.F90 phase0_2023.01.01/src_phase_3d/Convergence_Check.F90
--- phase0_2023.01/src_phase_3d/Convergence_Check.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/Convergence_Check.F90 2023-11-09 12:02:33.663110255 +0900
@@ -510,7 +510,6 @@
return
endif
- call Checkpoint_File(STREVL_ITERATION)
if(sw_displace_atom == ON) then
Forces_are_Converged = .true.
!return
@@ -621,6 +620,7 @@
end if
end if
end if
+ if(.not. Forces_are_Converged) call Checkpoint_File(STREVL_ITERATION)
write(nfout,'(" <<Forces_are_Converged>>, Forces_are_Converged = ",L4)') Forces_are_Converged
call flush(nfout)
diff -ruN phase0_2023.01/src_phase_3d/EsmPack/Esm.F90 phase0_2023.01.01/src_phase_3d/EsmPack/Esm.F90
--- phase0_2023.01/src_phase_3d/EsmPack/Esm.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/EsmPack/Esm.F90 2023-11-09 12:02:33.695110422 +0900
@@ -1284,7 +1284,7 @@
agauss(it,1)=1.d0
bgauss(it,1)=1.d0
enddo
- call esm_force_lc_(nrxx,aux,forcelc,nat,1,agauss,bgauss)
+ call esm_force_lc_(nrxx,aux,nat,forcelc,1,agauss,bgauss)
deallocate(agauss,bgauss)
end subroutine esm_force_lc
diff -ruN phase0_2023.01/src_phase_3d/Initialization.F90 phase0_2023.01.01/src_phase_3d/Initialization.F90
--- phase0_2023.01/src_phase_3d/Initialization.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/Initialization.F90 2023-11-09 12:02:33.663110255 +0900
@@ -192,7 +192,7 @@
character(len=80) :: vers, system, codename
!write(vers,'("Revision:",i5," -- 3D_Parallel --")') commit_id
! write(vers,'("phase/0 2021.01 Revision:",i5," -- 3D_Parallel --")') commit_id
- vers = "phase/0 2023.01 Revision:"//commit_id//" -- 3D_Parallel --"
+ vers = "phase/0 2023.01.01 Revision:"//commit_id//" -- 3D_Parallel --"
codename = 'phaseUnif'
system = ''
@@ -432,7 +432,7 @@
character(len=80) :: vers, system, codename
! write(vers,'("Revision:",i5, " --- 3D_Parallel --")') commit_id
! write(vers,'("phase/0 2021.02 Revision:",i5, " --- 3D_Parallel --")') commit_id
- vers = "phase/0 2023.01 Revision:"//commit_id//" -- 3D_Parallel --"
+ vers = "phase/0 2023.01.01 Revision:"//commit_id//" -- 3D_Parallel --"
codename = 'phaseUnif'
system = ''
diff -ruN phase0_2023.01/src_phase_3d/IterationNumbers_Setting.F90 phase0_2023.01.01/src_phase_3d/IterationNumbers_Setting.F90
--- phase0_2023.01/src_phase_3d/IterationNumbers_Setting.F90 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/IterationNumbers_Setting.F90 2023-11-09 12:02:33.684110365 +0900
@@ -0,0 +1,322 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!=======================================================================
+!
+! PROGRAM PHASE/0 2016.01 ($Rev: 614 $)
+!
+! SUBROUINE: MDiterationNumber_Setting, MDiterationNumber_Setting_ep,
+! IterationNumber_Setting, IterationNumber_Setting_g,
+! KpointNumber_Setting, KpointNumber_Setting2
+!
+! AUTHOR(S): T. Yamasaki August/20/2003
+! Further modification by T. Yamasaki May 2004
+!
+! Contact address : Phase System Consortium
+! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
+!
+!
+!
+!=======================================================================
+!
+! The original version of this set of the computer programs "PHASE"
+! was developed by the members of the Theory Group of Joint Research
+! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
+! 1993-2001.
+!
+! Since 2002, this set has been tuned and new functions have been
+! added to it as a part of the national project "Frontier Simulation
+! Software for Industrial Science (FSIS)", which is supported by
+! the IT program of the Ministry of Education, Culture, Sports,
+! Science and Technology (MEXT) of Japan.
+! Since 2006, this program set has been developed as a part of the
+! national project "Revolutionary Simulation Software (RSS21)", which
+! is supported by the next-generation IT program of MEXT of Japan.
+! Since 2013, this program set has been further developed centering on PHASE System
+! Consortium.
+! The activity of development of this program set has been supervised by Takahisa Ohno.
+!
+! $Id: IterationNumbers_Setting.f90 614 2020-05-07 03:24:24Z jkoga $
+subroutine MDiterationNumber_Setting
+ use m_IterationNumbers, only : m_Iter_mdIterN_increment&
+ &, m_Iter_electronic_reset
+ use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch
+ use m_Files, only : nfout
+ implicit none
+
+ call m_CtrlP_reset_dtim_1Dsearch()
+ call m_Iter_mdIterN_increment(nfout)
+ call m_Iter_electronic_reset
+end subroutine MDiterationNumber_Setting
+
+subroutine SCDFTiterationNumber_Setting
+ use m_IterationNumbers, only : m_Iter_scdftIterN_increment &
+ &, m_Iter_electronic_reset, m_Iter_reset_iter_ionic
+ use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, m_CtrlP_reset_iconvergence
+ use m_Files, only : nfout
+ implicit none
+
+ call m_CtrlP_reset_dtim_1Dsearch()
+ call m_Iter_scdftIterN_increment(nfout)
+ call m_Iter_electronic_reset
+ call m_Iter_reset_iter_ionic()
+ call m_CtrlP_reset_iconvergence()
+end subroutine SCDFTiterationNumber_Setting
+
+subroutine MDiterationNumber_Setting2
+ use m_IterationNumbers, only : m_Iter_mdIterN_increment&
+ &, m_Iter_electronic_reset,iteration_electronic,m_Iter_reset_iter_ionic &
+ &, m_Iter_unitcell_increment &
+ &, m_Iter_stress_correction_incre
+ use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, sw_optimize_lattice &
+ &, m_CtrlP_reset_iconvergence,imdalg, sw_stress_correction
+ use m_Const_Parameters, only : ON, PT_CONTROL, P_CONTROL
+ use m_Stress, only : m_Stress_in_correction, m_Stress_correction
+ use m_Files, only : nfout
+ implicit none
+ logical :: Rightafter_stress_correction
+ if(sw_optimize_lattice==ON .or. imdalg == PT_CONTROL .or. imdalg == P_CONTROL)then
+ call m_Iter_electronic_reset
+ if(sw_optimize_lattice == ON) call m_Iter_reset_iter_ionic()
+ if(.not.m_Stress_in_correction(2)) call m_Iter_unitcell_increment()
+ call m_CtrlP_reset_iconvergence()
+ endif
+end subroutine MDiterationNumber_Setting2
+
+logical function Rightafter_stress_correction()
+ use m_IterationNumbers, only : iteration_stress_correction
+ implicit none
+ Rightafter_stress_correction = iteration_stress_correction == 4
+end function
+
+subroutine MDiterationNumber_Setting_pre
+ use m_IterationNumbers, only : m_Iter_electronic_reset, m_Iter_stress_correction_incre
+ use m_Control_Parameters, only : m_CtrlP_reset_iconvergence, sw_stress_correction
+ use m_Const_Parameters, only : ON
+ use m_Stress, only : m_Stress_in_correction, m_Stress_correction
+ use m_Files, only : nfout
+ implicit none
+ if(sw_stress_correction == ON .and. m_Stress_in_correction(4)) then
+ call m_Stress_correction(nfout)
+ call m_Iter_electronic_reset
+ call m_Iter_stress_correction_incre()
+ call m_CtrlP_reset_iconvergence()
+ endif
+end subroutine MDiterationNumber_Setting_pre
+
+subroutine MDiterationNumber_Setting3
+ use m_Const_Parameters, only : DRIVER_URAMP
+ use m_Control_Parameters, only : driver
+ use m_IterationNumbers, only : m_Iter_electronic_reset,m_Iter_reset_iter_ionic &
+ &, m_Iter_uramp_increment
+ use m_Control_Parameters, only : driver, m_CtrlP_reset_iconvergence
+ implicit none
+ if(driver == DRIVER_URAMP)then
+ call m_Iter_electronic_reset
+ call m_Iter_reset_iter_ionic()
+ call m_Iter_uramp_increment()
+ call m_CtrlP_reset_iconvergence()
+ endif
+end subroutine MDiterationNumber_Setting3
+
+subroutine MDiterationNumber_Setting_ep
+ use m_IterationNumbers, only : m_Iter_mdIterN_increment&
+ & , m_Iter_total_increment
+ use m_Files, only : nfout
+ implicit none
+ call m_Iter_mdIterN_increment(nfout)
+ call m_Iter_total_increment()
+end subroutine MDiterationNumber_Setting_ep
+
+subroutine IterationNumber_Setting
+ use m_Control_Parameters,only: icond, ipritiming0&
+ & , iprijobstatus, jobstatus_series, jobstatus_format, driver
+ use m_IterationNumbers, only : m_Iter_electronic_incre &
+ & , m_Iter_total_increment &
+ & , iteration, first_iteration_of_this_job &
+ & , iteration_electronic, iteration_ionic &
+ & , iteration_unit_cell, iteration_uramp, iteration_scdft
+ use m_Timing, only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter &
+ & , m_Timing_wd_status
+ use m_Const_Parameters, only : INITIAL, CONTINUATION &
+ & , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION &
+ & , START, ITERATIVE, ON, OFF, DRIVER_URAMP
+ use m_Files, only : nfstatus,nfout &
+ & , m_Files_open_nfstatus &
+ & , m_Files_close_nfstatus &
+ & , m_Files_skiptoend
+ implicit none
+ integer :: it, status_wdmode
+ logical :: unitcell_can_change,Uramping,isSCDFT
+
+ call tstatc_iter(iteration, first_iteration_of_this_job)
+ it = iteration
+ if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
+ if(iteration == first_iteration_of_this_job) then
+ call tstatc_wd0
+ call flush(nfout)
+ else
+ if(ipritiming0 >= 1) call tstatc_wd(it)
+ end if
+ call tstatc_init
+
+ if(iprijobstatus >=1 ) then
+ call m_Files_open_nfstatus()
+ if(iteration == first_iteration_of_this_job) then
+ status_wdmode = START
+ else
+ status_wdmode = ITERATIVE
+ if(jobstatus_series == ON) then
+ call m_Files_skiptoend(nfstatus)
+ else
+ end if
+ end if
+ call m_Timing_wd_status(nfstatus,jobstatus_format,jobstatus_series,status_wdmode &
+ & ,iteration,iteration_ionic,iteration_electronic)
+ call m_Files_close_nfstatus()
+ end if
+
+ call m_Iter_electronic_incre()
+ call m_Iter_total_increment()
+
+#ifndef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(iprijobstatus >=1 ) then
+#endif
+ if(.not.unitcell_can_change()) then
+ if(Uramping()) then
+ write(nfout,'(" ---- iteration(total, uramp, ionic, electronic) = ",4i8," ----")') &
+ & iteration, iteration_uramp, iteration_ionic, iteration_electronic
+ else if (isSCDFT()) then
+ write(nfout,'(" ---- iteration(total, scdft, ionic, electronic) = ",4i8," ----")') &
+ & iteration, iteration_scdft, iteration_ionic, iteration_electronic
+ else
+ write(nfout,'(" ---- iteration(total, ionic, electronic) = ",3i8," ----")') &
+ & iteration, iteration_ionic, iteration_electronic
+ endif
+ else
+ write(nfout,'(" ---- iteration(total, unitcell, ionic, electronic) = ",4i8," ----")') &
+ & iteration, iteration_unit_cell,iteration_ionic, iteration_electronic
+ endif
+#ifndef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ end if
+#endif
+
+end subroutine IterationNumber_Setting
+
+subroutine IterationNumber_Setting_g()
+ use m_Control_Parameters,only: icond,ipritiming0
+ use m_IterationNumbers, only : iteration, first_iteration_of_this_job &
+ & , iteration_electronic &
+ & , m_Iter_total_increment &
+ & , m_Iter_electronic_incre
+ use m_Timing , only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter
+ use m_Const_Parameters, only : INITIAL, CONTINUATION, FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
+ implicit none
+ integer :: it
+
+ call tstatc_iter(iteration, first_iteration_of_this_job)
+ it = iteration
+ if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
+ if(iteration_electronic == 0) then
+ call tstatc_wd0()
+ else
+ if(ipritiming0 >= 1) call tstatc_wd(it)
+ end if
+ call tstatc_init()
+
+ call m_Iter_electronic_incre()
+ call m_Iter_total_increment()
+
+end subroutine IterationNumber_Setting_g
+
+subroutine IterationNumber_reset()
+ use m_Timing , only : tstatc_init
+ use m_IterationNumbers, only : m_Iter_electronic_reset
+
+ call m_Iter_electronic_reset()
+ call tstatc_init()
+end subroutine IterationNumber_reset
+
+subroutine KpointNumber_Setting()
+ use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
+ & , iteration_electronic, first_iteration_electronic &
+ & , m_Iter_nk_incre &
+ & , m_Iter_wd_electronic &
+ & , m_Iter_wd_nk &
+ & , m_Iter_electronic_reset &
+ & , m_Iter_electronic_set
+ use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
+ use m_Files,only : nfout
+
+! ===================== added by K. Tagami ================== 11.0
+ use m_Control_Parameters, only : noncol, ndim_spinor
+
+ implicit none
+! =========================================================== 11.0
+
+ call m_CtrlP_ntcnvg_reset()
+! =================================== modified by K. Tagami ======== 11.0
+!! call m_Iter_nk_incre(nspin)
+ if ( noncol ) then
+ call m_Iter_nk_incre(ndim_spinor)
+ else
+ call m_Iter_nk_incre(nspin)
+ endif
+! ================================================================== 11.0
+
+ if(nk_in_the_process == first_kpoint_in_this_job) then
+ call m_Iter_electronic_set()
+ else
+ call m_Iter_electronic_reset()
+ end if
+ if(ipriekzaj <= 0) call m_Iter_electronic_reset()
+ call m_Iter_wd_nk(nfout)
+ call m_Iter_wd_electronic(nfout)
+
+end subroutine KpointNumber_Setting
+
+subroutine KpointNumber_Setting2()
+ use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
+ & , iteration_electronic, first_iteration_electronic &
+ & , m_Iter_nk_incre2 &
+ & , m_Iter_wd_electronic &
+ & , m_Iter_wd_nk2 &
+ & , m_Iter_electronic_reset &
+ & , m_Iter_electronic_set
+!!$ & , m_Iter_nkgroup_set
+ use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
+ use m_Kpoints, only : kv3, kv3_ek
+ use m_Files,only : nfout
+
+! ===================== added by K. Tagami ================== 11.0
+ use m_Control_Parameters, only : noncol, ndim_spinor
+
+ implicit none
+! =========================================================== 11.0
+
+ call m_CtrlP_ntcnvg_reset()
+
+! ======================================= added by K. Tagami ============ 11.0
+! call m_Iter_nk_incre2(nspin,kv3_ek)
+ if ( noncol ) then
+ call m_Iter_nk_incre2( ndim_spinor,kv3_ek )
+ else
+ call m_Iter_nk_incre2( nspin,kv3_ek )
+ endif
+! ====================================================================== 11.0
+
+ if(nk_in_the_process == first_kpoint_in_this_job) then
+ call m_Iter_electronic_set()
+!!$ call m_Iter_nkgroup_set(kv3)
+ else
+ call m_Iter_electronic_reset()
+ end if
+ if(ipriekzaj <= 0) call m_Iter_electronic_reset()
+ call m_Iter_wd_nk2(nfout,kv3)
+ call m_Iter_wd_electronic(nfout)
+
+end subroutine KpointNumber_Setting2
+
+!!$subroutine pIterationNumber_Setting()
+!!$ use m_IterationNumbers, only : m_Iter_positron_set()
+!!$ implicit none
+!!$ call m_Iter_positron_set()
+!!$end subroutine pIterationNumber_Setting
diff -ruN phase0_2023.01/src_phase_3d/IterationNumbers_Setting.f90 phase0_2023.01.01/src_phase_3d/IterationNumbers_Setting.f90
--- phase0_2023.01/src_phase_3d/IterationNumbers_Setting.f90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/IterationNumbers_Setting.f90 1970-01-01 09:00:00.000000000 +0900
@@ -1,317 +0,0 @@
-!=======================================================================
-!
-! PROGRAM PHASE/0 2016.01 ($Rev: 614 $)
-!
-! SUBROUINE: MDiterationNumber_Setting, MDiterationNumber_Setting_ep,
-! IterationNumber_Setting, IterationNumber_Setting_g,
-! KpointNumber_Setting, KpointNumber_Setting2
-!
-! AUTHOR(S): T. Yamasaki August/20/2003
-! Further modification by T. Yamasaki May 2004
-!
-! Contact address : Phase System Consortium
-! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
-!
-!
-!
-!=======================================================================
-!
-! The original version of this set of the computer programs "PHASE"
-! was developed by the members of the Theory Group of Joint Research
-! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
-! 1993-2001.
-!
-! Since 2002, this set has been tuned and new functions have been
-! added to it as a part of the national project "Frontier Simulation
-! Software for Industrial Science (FSIS)", which is supported by
-! the IT program of the Ministry of Education, Culture, Sports,
-! Science and Technology (MEXT) of Japan.
-! Since 2006, this program set has been developed as a part of the
-! national project "Revolutionary Simulation Software (RSS21)", which
-! is supported by the next-generation IT program of MEXT of Japan.
-! Since 2013, this program set has been further developed centering on PHASE System
-! Consortium.
-! The activity of development of this program set has been supervised by Takahisa Ohno.
-!
-! $Id: IterationNumbers_Setting.f90 614 2020-05-07 03:24:24Z jkoga $
-subroutine MDiterationNumber_Setting
- use m_IterationNumbers, only : m_Iter_mdIterN_increment&
- &, m_Iter_electronic_reset
- use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch
- use m_Files, only : nfout
- implicit none
-
- call m_CtrlP_reset_dtim_1Dsearch()
- call m_Iter_mdIterN_increment(nfout)
- call m_Iter_electronic_reset
-end subroutine MDiterationNumber_Setting
-
-subroutine SCDFTiterationNumber_Setting
- use m_IterationNumbers, only : m_Iter_scdftIterN_increment &
- &, m_Iter_electronic_reset, m_Iter_reset_iter_ionic
- use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, m_CtrlP_reset_iconvergence
- use m_Files, only : nfout
- implicit none
-
- call m_CtrlP_reset_dtim_1Dsearch()
- call m_Iter_scdftIterN_increment(nfout)
- call m_Iter_electronic_reset
- call m_Iter_reset_iter_ionic()
- call m_CtrlP_reset_iconvergence()
-end subroutine SCDFTiterationNumber_Setting
-
-subroutine MDiterationNumber_Setting2
- use m_IterationNumbers, only : m_Iter_mdIterN_increment&
- &, m_Iter_electronic_reset,iteration_electronic,m_Iter_reset_iter_ionic &
- &, m_Iter_unitcell_increment &
- &, m_Iter_stress_correction_incre
- use m_Control_Parameters, only : m_CtrlP_reset_dtim_1Dsearch, sw_optimize_lattice &
- &, m_CtrlP_reset_iconvergence,imdalg, sw_stress_correction
- use m_Const_Parameters, only : ON, PT_CONTROL, P_CONTROL
- use m_Stress, only : m_Stress_in_correction, m_Stress_correction
- use m_Files, only : nfout
- implicit none
- logical :: Rightafter_stress_correction
- if(sw_optimize_lattice==ON .or. imdalg == PT_CONTROL .or. imdalg == P_CONTROL)then
- call m_Iter_electronic_reset
- if(sw_optimize_lattice == ON) call m_Iter_reset_iter_ionic()
- if(.not.m_Stress_in_correction(2)) call m_Iter_unitcell_increment()
- call m_CtrlP_reset_iconvergence()
- endif
-end subroutine MDiterationNumber_Setting2
-
-logical function Rightafter_stress_correction()
- use m_IterationNumbers, only : iteration_stress_correction
- implicit none
- Rightafter_stress_correction = iteration_stress_correction == 4
-end function
-
-subroutine MDiterationNumber_Setting_pre
- use m_IterationNumbers, only : m_Iter_electronic_reset, m_Iter_stress_correction_incre
- use m_Control_Parameters, only : m_CtrlP_reset_iconvergence, sw_stress_correction
- use m_Const_Parameters, only : ON
- use m_Stress, only : m_Stress_in_correction, m_Stress_correction
- use m_Files, only : nfout
- implicit none
- if(sw_stress_correction == ON .and. m_Stress_in_correction(4)) then
- call m_Stress_correction(nfout)
- call m_Iter_electronic_reset
- call m_Iter_stress_correction_incre()
- call m_CtrlP_reset_iconvergence()
- endif
-end subroutine MDiterationNumber_Setting_pre
-
-subroutine MDiterationNumber_Setting3
- use m_Const_Parameters, only : DRIVER_URAMP
- use m_Control_Parameters, only : driver
- use m_IterationNumbers, only : m_Iter_electronic_reset,m_Iter_reset_iter_ionic &
- &, m_Iter_uramp_increment
- use m_Control_Parameters, only : driver, m_CtrlP_reset_iconvergence
- implicit none
- if(driver == DRIVER_URAMP)then
- call m_Iter_electronic_reset
- call m_Iter_reset_iter_ionic()
- call m_Iter_uramp_increment()
- call m_CtrlP_reset_iconvergence()
- endif
-end subroutine MDiterationNumber_Setting3
-
-subroutine MDiterationNumber_Setting_ep
- use m_IterationNumbers, only : m_Iter_mdIterN_increment&
- & , m_Iter_total_increment
- use m_Files, only : nfout
- implicit none
- call m_Iter_mdIterN_increment(nfout)
- call m_Iter_total_increment()
-end subroutine MDiterationNumber_Setting_ep
-
-subroutine IterationNumber_Setting
- use m_Control_Parameters,only: icond, ipritiming0&
- & , iprijobstatus, jobstatus_series, jobstatus_format, driver
- use m_IterationNumbers, only : m_Iter_electronic_incre &
- & , m_Iter_total_increment &
- & , iteration, first_iteration_of_this_job &
- & , iteration_electronic, iteration_ionic &
- & , iteration_unit_cell, iteration_uramp, iteration_scdft
- use m_Timing, only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter &
- & , m_Timing_wd_status
- use m_Const_Parameters, only : INITIAL, CONTINUATION &
- & , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION &
- & , START, ITERATIVE, ON, OFF, DRIVER_URAMP
- use m_Files, only : nfstatus,nfout &
- & , m_Files_open_nfstatus &
- & , m_Files_close_nfstatus &
- & , m_Files_skiptoend
- implicit none
- integer :: it, status_wdmode
- logical :: unitcell_can_change,Uramping,isSCDFT
-
- call tstatc_iter(iteration, first_iteration_of_this_job)
- it = iteration
- if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
- if(iteration == first_iteration_of_this_job) then
- call tstatc_wd0
- call flush(nfout)
- else
- if(ipritiming0 >= 1) call tstatc_wd(it)
- end if
- call tstatc_init
-
- if(iprijobstatus >=1 ) then
- call m_Files_open_nfstatus()
- if(iteration == first_iteration_of_this_job) then
- status_wdmode = START
- else
- status_wdmode = ITERATIVE
- if(jobstatus_series == ON) then
- call m_Files_skiptoend(nfstatus)
- else
- end if
- end if
- call m_Timing_wd_status(nfstatus,jobstatus_format,jobstatus_series,status_wdmode &
- & ,iteration,iteration_ionic,iteration_electronic)
- call m_Files_close_nfstatus()
- end if
-
- call m_Iter_electronic_incre()
- call m_Iter_total_increment()
-
- if(iprijobstatus >=1 ) then
- if(.not.unitcell_can_change()) then
- if(Uramping()) then
- write(nfout,'(" ---- iteration(total, uramp, ionic, electronic) = ",4i8," ----")') &
- & iteration, iteration_uramp, iteration_ionic, iteration_electronic
- else if (isSCDFT()) then
- write(nfout,'(" ---- iteration(total, scdft, ionic, electronic) = ",4i8," ----")') &
- & iteration, iteration_scdft, iteration_ionic, iteration_electronic
- else
- write(nfout,'(" ---- iteration(total, ionic, electronic) = ",3i8," ----")') &
- & iteration, iteration_ionic, iteration_electronic
- endif
- else
- write(nfout,'(" ---- iteration(total, unitcell, ionic, electronic) = ",4i8," ----")') &
- & iteration, iteration_unit_cell,iteration_ionic, iteration_electronic
- endif
- end if
-
-end subroutine IterationNumber_Setting
-
-subroutine IterationNumber_Setting_g()
- use m_Control_Parameters,only: icond,ipritiming0
- use m_IterationNumbers, only : iteration, first_iteration_of_this_job &
- & , iteration_electronic &
- & , m_Iter_total_increment &
- & , m_Iter_electronic_incre
- use m_Timing , only : tstatc_wd, tstatc_wd0, tstatc_init, tstatc_iter
- use m_Const_Parameters, only : INITIAL, CONTINUATION, FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
- implicit none
- integer :: it
-
- call tstatc_iter(iteration, first_iteration_of_this_job)
- it = iteration
- if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) it = iteration_electronic
- if(iteration_electronic == 0) then
- call tstatc_wd0()
- else
- if(ipritiming0 >= 1) call tstatc_wd(it)
- end if
- call tstatc_init()
-
- call m_Iter_electronic_incre()
- call m_Iter_total_increment()
-
-end subroutine IterationNumber_Setting_g
-
-subroutine IterationNumber_reset()
- use m_Timing , only : tstatc_init
- use m_IterationNumbers, only : m_Iter_electronic_reset
-
- call m_Iter_electronic_reset()
- call tstatc_init()
-end subroutine IterationNumber_reset
-
-subroutine KpointNumber_Setting()
- use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
- & , iteration_electronic, first_iteration_electronic &
- & , m_Iter_nk_incre &
- & , m_Iter_wd_electronic &
- & , m_Iter_wd_nk &
- & , m_Iter_electronic_reset &
- & , m_Iter_electronic_set
- use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
- use m_Files,only : nfout
-
-! ===================== added by K. Tagami ================== 11.0
- use m_Control_Parameters, only : noncol, ndim_spinor
-
- implicit none
-! =========================================================== 11.0
-
- call m_CtrlP_ntcnvg_reset()
-! =================================== modified by K. Tagami ======== 11.0
-!! call m_Iter_nk_incre(nspin)
- if ( noncol ) then
- call m_Iter_nk_incre(ndim_spinor)
- else
- call m_Iter_nk_incre(nspin)
- endif
-! ================================================================== 11.0
-
- if(nk_in_the_process == first_kpoint_in_this_job) then
- call m_Iter_electronic_set()
- else
- call m_Iter_electronic_reset()
- end if
- if(ipriekzaj <= 0) call m_Iter_electronic_reset()
- call m_Iter_wd_nk(nfout)
- call m_Iter_wd_electronic(nfout)
-
-end subroutine KpointNumber_Setting
-
-subroutine KpointNumber_Setting2()
- use m_IterationNumbers, only : nk_in_the_process, first_kpoint_in_this_job &
- & , iteration_electronic, first_iteration_electronic &
- & , m_Iter_nk_incre2 &
- & , m_Iter_wd_electronic &
- & , m_Iter_wd_nk2 &
- & , m_Iter_electronic_reset &
- & , m_Iter_electronic_set
-!!$ & , m_Iter_nkgroup_set
- use m_Control_Parameters,only: nspin, ipriekzaj, m_CtrlP_ntcnvg_reset
- use m_Kpoints, only : kv3, kv3_ek
- use m_Files,only : nfout
-
-! ===================== added by K. Tagami ================== 11.0
- use m_Control_Parameters, only : noncol, ndim_spinor
-
- implicit none
-! =========================================================== 11.0
-
- call m_CtrlP_ntcnvg_reset()
-
-! ======================================= added by K. Tagami ============ 11.0
-! call m_Iter_nk_incre2(nspin,kv3_ek)
- if ( noncol ) then
- call m_Iter_nk_incre2( ndim_spinor,kv3_ek )
- else
- call m_Iter_nk_incre2( nspin,kv3_ek )
- endif
-! ====================================================================== 11.0
-
- if(nk_in_the_process == first_kpoint_in_this_job) then
- call m_Iter_electronic_set()
-!!$ call m_Iter_nkgroup_set(kv3)
- else
- call m_Iter_electronic_reset()
- end if
- if(ipriekzaj <= 0) call m_Iter_electronic_reset()
- call m_Iter_wd_nk2(nfout,kv3)
- call m_Iter_wd_electronic(nfout)
-
-end subroutine KpointNumber_Setting2
-
-!!$subroutine pIterationNumber_Setting()
-!!$ use m_IterationNumbers, only : m_Iter_positron_set()
-!!$ implicit none
-!!$ call m_Iter_positron_set()
-!!$end subroutine pIterationNumber_Setting
diff -ruN phase0_2023.01/src_phase_3d/Makefile.M1Mac phase0_2023.01.01/src_phase_3d/Makefile.M1Mac
--- phase0_2023.01/src_phase_3d/Makefile.M1Mac 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/Makefile.M1Mac 2023-11-09 12:02:33.667110276 +0900
@@ -9,14 +9,14 @@
###########################################################################
###<< PLEASE CHANGE THE VARIABLES BELOW ACCORDING TO YOUR ENVIRONMENT >>###
###########################################################################
-F90 = mpif90
+F90 = mpifort -fallow-argument-mismatch
CC = gcc
CPP =
AR = ar -vq
-LINK = mpif90
-F90FLAGS = -O2 -ffree-form -fallow-argument-mismatch
-F77FLAGS = -O2 -ffixed-form -fallow-argument-mismatch -ffixed-line-length-72
-CFLAGS = -DINTEL -DDARWIN
+LINK = mpifort
+F90FLAGS = -O2 -ffree-form
+F77FLAGS = -O2 -ffixed-form -ffixed-line-length-72
+CFLAGS = -DINTEL
ESM = yes
ifdef ESM
@@ -98,7 +98,7 @@
cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="" AR="$(AR)"
else
libesm.a:
- cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90) -fallow-argument-mismatch" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
+ cd EsmPack; make INCLUDE="$(INCLUDE)" FORTRAN="$(F90)" LIBFLAG="$(LIBS)" MPIFLAG="-D__MPI__" AR="$(AR)"
endif
liblapack.a:
diff -ruN phase0_2023.01/src_phase_3d/Optimize_Blocking_Parameters.F90 phase0_2023.01.01/src_phase_3d/Optimize_Blocking_Parameters.F90
--- phase0_2023.01/src_phase_3d/Optimize_Blocking_Parameters.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/Optimize_Blocking_Parameters.F90 2023-11-09 12:02:33.699110444 +0900
@@ -12,7 +12,8 @@
& , nblsizecand_submat, blsizecand_submat &
& , nblocksize_submat_is_given, nblocksize_submat &
& , m_CntrlP_rst_submat_call_stat,nspin &
- & , sw_betar_dot_wfs_exp, sw_precalculate_phase_vnonlocal, damp, meg
+ & , sw_betar_dot_wfs_exp, sw_precalculate_phase_vnonlocal, damp, meg &
+ & , sw_scalapack
use m_Kpoints, only : kv3
use m_Parallelization, only : np_g1k, np_e, np_fs
#ifdef FFT_3D_DIVISION
@@ -25,7 +26,7 @@
use m_ES_ortho, only : mgs_4_each_k_G_3D, m_ESortho_mgs_alloc, m_ESortho_mgs_dealloc &
& , m_ES_modified_gram_schmidt
use m_ES_nonlocal, only : m_ES_betar_dot_Psi_4_each_k_3D, m_ES_Vnonlocal_W_3D
- use m_Parallelization, only : make_index_band_3D,make_index_band_for_Gdiv_3D, nrank_e
+ use m_Parallelization, only : make_index_band_3D,make_index_band_for_Gdiv_3D, nrank_e, nrank_k
use m_ES_WF_by_submat, only : evolve_WFs_in_subspace_3D, m_ESsubmat_alloc, m_ESsubmat_dealloc, m_ESsubmat_renew_WF
use m_Timing, only : tstatc0_begin, tstatc0_end
use m_PlaneWaveBasisSet, only : kg1, iba
@@ -48,7 +49,11 @@
integer :: id_sname = -1
call tstatc0_begin('Optimize_Blocking_Parameters ',id_sname,-1)
-
+ if (nrank_k>1 .and. sw_scalapack == on ) then
+ call phase_error_with_msg(nfout, &
+ & 'optimization of the blocking parameters, kpoint parallelization and ScaLAPACK cannot be used simultaneously', &
+ & __LINE__, __FILE__)
+ endif
nblocksize_mgs_is_given = .true.
best = HUGE(0)
nbuf = blsizecand_mgs(1)
diff -ruN phase0_2023.01/src_phase_3d/b_Crystal_Structure.F90 phase0_2023.01.01/src_phase_3d/b_Crystal_Structure.F90
--- phase0_2023.01/src_phase_3d/b_Crystal_Structure.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/b_Crystal_Structure.F90 2023-11-09 12:02:33.699110444 +0900
@@ -1029,13 +1029,15 @@
end subroutine primitive2bravais
-logical function is_hexagonal(ca,cb,cc)
+logical function is_hexagonal(a,b,ca,cb,cc)
use m_Const_Parameters, only : DP
implicit none
+ real(kind=DP), intent(in) :: a,b
real(kind=DP), intent(in) :: ca,cb,cc
real(kind=DP), parameter :: epsilon = 1.d-10
is_hexagonal = .false.
- if (abs(ca)<epsilon .and. abs(cb)<epsilon .and. abs(abs(cc)-0.5d0)<epsilon) is_hexagonal=.true.
+ if (abs(ca)<epsilon .and. abs(cb)<epsilon .and. abs(abs(cc)-0.5d0)<epsilon .and. abs(a-b)<epsilon) &
+ & is_hexagonal=.true.
end function is_hexagonal
diff -ruN phase0_2023.01/src_phase_3d/b_XC_Potential.F90 phase0_2023.01.01/src_phase_3d/b_XC_Potential.F90
--- phase0_2023.01/src_phase_3d/b_XC_Potential.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/b_XC_Potential.F90 2023-11-09 12:02:33.652110198 +0900
@@ -3635,11 +3635,22 @@
real(kind=DP), parameter :: a2 = 0.27430d0
real(kind=DP), parameter :: a3 = 0.15084d0
real(kind=DP), parameter :: a4 = 100.0d0
- real(kind=DP), parameter :: ax = -0.7385588d0
+
+! === KT_mod === 2014/11/25
+!!! real(kind=DP), parameter :: ax = -0.7385588d0
+ real(kind=DP), parameter :: ax = -0.7385587663820224d0
+!=============== 2014/11/25
+
real(kind=DP), parameter :: a = 7.7956d0
real(kind=DP), parameter :: b1 = 0.004d0
- real(kind=DP), parameter :: thrd = 0.33333333333d0
- real(kind=DP), parameter :: thrd4 = 1.333333333333333d0
+
+! === KT_mod === 2014/11/25
+! real(kind=DP), parameter :: thrd = 0.33333333333d0
+! real(kind=DP), parameter :: thrd4 = 1.333333333333333d0
+ real(kind=DP), parameter :: thrd = 0.33333333333333333333333d0
+ real(kind=DP), parameter :: thrd4 = 1.33333333333333333333333d0
+!=============== 2014/11/25
+
real(kind=DP), parameter :: thpith = 3.0936677262801d0
!---- Spin dependency
@@ -3755,8 +3766,12 @@
real(kind=DP), parameter :: c5 = 0.472d0, c6 = 7.389d-2
real(kind=DP), parameter :: a4 = 100.d0
- real(kind=DP), parameter :: thrd = 0.333333333333d0
- real(kind=DP), parameter :: sixth7 = 1.1666666666666666d0
+! ==== KT_mod ==== 2014/11/25
+! real(kind=DP), parameter :: thrd = 0.333333333333d0
+! real(kind=DP), parameter :: sixth7 = 1.1666666666666666d0
+ real(kind=DP), parameter :: thrd = 0.3333333333333333333333d0
+ real(kind=DP), parameter :: sixth7 = 1.1666666666666666666666d0
+! ================= 2014/11/25
integer :: is,i
real(kind=DP) :: facw,bet,delt,exc1,g,g3,g4,facpon,d,dd,rs,fk,sk,t,s&
@@ -3772,7 +3787,12 @@
call timer_sta(765)
#endif
facw = ispin
- bet = xnu*cc0
+
+! === KT_mod === 2014/11/25
+! bet = xnu*cc0
+ bet=0.06672455060314922d0
+! ============== 2014/11/25
+
delt = 2.d0*alf/bet
!---- Spin dependency
diff -ruN phase0_2023.01/src_phase_3d/ekmain.F90 phase0_2023.01.01/src_phase_3d/ekmain.F90
--- phase0_2023.01/src_phase_3d/ekmain.F90 1970-01-01 09:00:00.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/ekmain.F90 2023-11-09 12:02:33.669110287 +0900
@@ -0,0 +1,88 @@
+!=======================================================================
+!
+! PROGRAM PHASE/0 2016.01 ($Rev: 606 $)
+!
+! PROGRAM: EK
+!
+! AUTHOR(S): T. Yamasaki August/20/2003
+! Further modification by T. Yamasaki Feb. 2004
+!
+! Contact address : Phase System Consortium
+! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
+!
+!
+!
+!=======================================================================
+!
+! The original version of this set of the computer programs "PHASE"
+! was developed by the members of the Theory Group of Joint Research
+! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
+! 1993-2001.
+!
+! Since 2002, this set has been tuned and new functions have been
+! added to it as a part of the national project "Frontier Simulation
+! Software for Industrial Science (FSIS)", which is supported by
+! the IT program of the Ministry of Education, Culture, Sports,
+! Science and Technology (MEXT) of Japan.
+! Since 2006, this program set has been developed as a part of the
+! national project "Revolutionary Simulation Software (RSS21)", which
+! is supported by the next-generation IT program of MEXT of Japan.
+! Since 2013, this program set has been further developed centering on PHASE System
+! Consortium.
+! The activity of development of this program set has been supervised by Takahisa Ohno.
+!
+!
+! $Id: ekmain.f90 606 2020-04-15 06:45:49Z ktagami $
+!
+program EK
+! This program was coded by T. Yamasaki(FUJITSU Laboratories Ltd.), 17th Feb. 2003.
+!
+ implicit none
+ logical :: EigenValues_are_Converged, AllKpoints_are_Calculated
+ logical :: Already_Converged
+ logical :: Ending_Time
+
+ call Initialization_set_ekmode_ON ! set `ekmode' ON in m_Control_Parameters
+ call Initialization(1) ! Initialization of mpi and file-setting
+ call InputData_Analysis
+ call Preparation(0) ! Basis set, symmetry check etc.
+ call Preparation_for_mpi(1) ! mpi
+ call PseudoPotential_Construction
+#ifdef ENABLE_ESM_PACK
+ call Preparation_for_ESM
+#endif
+ call Ewald_and_Structure_Factor ! Calculate Structure Factor
+ call Initial_Electronic_Structure()! read Charge Density, (lclchh)
+
+ KPOINTS: do
+! call KpointNumber_Setting()
+ call KpointNumber_Setting2()
+ call Preparation_ek ! (basnum)
+ call Preparation_for_mpi_ek ! mpi -> np_g1k, mp_g1k
+ call PseudoPotential_ek ! (kbint)
+ call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
+ if(.not.Already_Converged()) then
+ SolveWaveFunctions: do
+ if(Ending_Time()) exit KPOINTS
+ call IterationNumber_Setting()
+ call Renewal_of_WaveFunctions()
+ if(EigenValues_are_Converged()) exit SolveWaveFunctions
+ enddo SolveWaveFunctions
+ call Postprocessing_k()
+ if(AllKpoints_are_Calculated()) exit KPOINTS
+ else
+ exit KPOINTS
+ end if
+ enddo KPOINTS
+!!$ else
+!!$ write(6,'(" Already_Converged")')
+!!$ call KpointNumber_Setting()
+!!$ call Preparation_ek ! (basnum)
+!!$ call PseudoPotential_ek ! (kbint)
+!!$ call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
+!!$ end if
+
+ call Postprocessing(.false.)
+ call WriteDownData_onto_Files_ek()
+ call Finalization_of_mpi ! mpi
+end program EK
diff -ruN phase0_2023.01/src_phase_3d/ekmain.f90 phase0_2023.01.01/src_phase_3d/ekmain.f90
--- phase0_2023.01/src_phase_3d/ekmain.f90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/ekmain.f90 1970-01-01 09:00:00.000000000 +0900
@@ -1,88 +0,0 @@
-!=======================================================================
-!
-! PROGRAM PHASE/0 2016.01 ($Rev: 606 $)
-!
-! PROGRAM: EK
-!
-! AUTHOR(S): T. Yamasaki August/20/2003
-! Further modification by T. Yamasaki Feb. 2004
-!
-! Contact address : Phase System Consortium
-! E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
-!
-!
-!
-!=======================================================================
-!
-! The original version of this set of the computer programs "PHASE"
-! was developed by the members of the Theory Group of Joint Research
-! Center for Atom Technology (JRCAT), based in Tsukuba, in the period
-! 1993-2001.
-!
-! Since 2002, this set has been tuned and new functions have been
-! added to it as a part of the national project "Frontier Simulation
-! Software for Industrial Science (FSIS)", which is supported by
-! the IT program of the Ministry of Education, Culture, Sports,
-! Science and Technology (MEXT) of Japan.
-! Since 2006, this program set has been developed as a part of the
-! national project "Revolutionary Simulation Software (RSS21)", which
-! is supported by the next-generation IT program of MEXT of Japan.
-! Since 2013, this program set has been further developed centering on PHASE System
-! Consortium.
-! The activity of development of this program set has been supervised by Takahisa Ohno.
-!
-!
-! $Id: ekmain.f90 606 2020-04-15 06:45:49Z ktagami $
-!
-program EK
-! This program was coded by T. Yamasaki(FUJITSU Laboratories Ltd.), 17th Feb. 2003.
-!
- implicit none
- logical :: EigenValues_are_Converged, AllKpoints_are_Calculated
- logical :: Already_Converged
- logical :: Ending_Time
-
- call Initialization_set_ekmode_ON ! set `ekmode' ON in m_Control_Parameters
- call Initialization(1) ! Initialization of mpi and file-setting
- call InputData_Analysis
- call Preparation(0) ! Basis set, symmetry check etc.
- call Preparation_for_mpi(1) ! mpi
- call PseudoPotential_Construction
-#ifdef ENABLE_ESM_PACK
- call Preparation_for_ESM
-#endif
- call Ewald_and_Structure_Factor ! Calculate Structure Factor
- call Initial_Electronic_Structure()! read Charge Density, (lclchh)
-
- KPOINTS: do
-! call KpointNumber_Setting()
- call KpointNumber_Setting2()
- call Preparation_ek ! (basnum)
- call Preparation_for_mpi_ek ! mpi -> np_g1k, mp_g1k
- call PseudoPotential_ek ! (kbint)
- call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
- if(.not.Already_Converged()) then
- SolveWaveFunctions: do
- if(Ending_Time()) exit KPOINTS
- call IterationNumber_Setting()
- call Renewal_of_WaveFunctions()
- if(EigenValues_are_Converged()) exit SolveWaveFunctions
- enddo SolveWaveFunctions
- call Postprocessing_k()
- if(AllKpoints_are_Calculated()) exit KPOINTS
- else
- exit KPOINTS
- end if
- enddo KPOINTS
-!!$ else
-!!$ write(6,'(" Already_Converged")')
-!!$ call KpointNumber_Setting()
-!!$ call Preparation_ek ! (basnum)
-!!$ call PseudoPotential_ek ! (kbint)
-!!$ call Initial_WaveFunctions_ek ! (rndzaj|rdzaj),(fsrfsi),(lclchh)
-!!$ end if
-
- call Postprocessing(.false.)
- call WriteDownData_onto_Files_ek()
- call Finalization_of_mpi ! mpi
-end program EK
diff -ruN phase0_2023.01/src_phase_3d/input_interface.F90 phase0_2023.01.01/src_phase_3d/input_interface.F90
--- phase0_2023.01/src_phase_3d/input_interface.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/input_interface.F90 2023-11-09 12:02:33.699110444 +0900
@@ -556,7 +556,7 @@
logical, intent(in) :: is_hex, printable
character(FMAXUNITLEN) :: readunit
- real(DP) :: s, al, be, ga, sin_be, sin_ga, wk, alpha, beta,gamma
+ real(DP) :: s, al, be, ga, sin_be, sin_ga, wk, wkbuf, alpha, beta,gamma
real(DP), dimension(3) :: wvec
integer getRealVectorValue, realConvByUnit
integer getRealValue
@@ -608,13 +608,14 @@
ucinptype = 1
else if( getRealValue( trim(TAG_A)//char(0), wk, readunit ) == 0 ) then
!!$ if(printable) write(6,'(" !!! readunit = ",a15)') trim(readunit)
+ wkbuf = wk
if( realConvByUnit( wk, a, readunit, unit ) < 0 ) then
return;
end if
if( getRealValue( trim(TAG_B)//char(0), wk, readunit ) /= 0 ) then
!return;
- wk = a
+ wk = wkbuf
end if
if( realConvByUnit( wk, b, readunit, unit ) < 0 ) then
return;
@@ -622,7 +623,7 @@
if( getRealValue( trim(TAG_C)//char(0), wk, readunit ) /= 0 ) then
!return;
- wk = a
+ wk = wkbuf
end if
if( realConvByUnit( wk, c, readunit, unit ) < 0 ) then
return;
diff -ruN phase0_2023.01/src_phase_3d/input_parse.h phase0_2023.01.01/src_phase_3d/input_parse.h
--- phase0_2023.01/src_phase_3d/input_parse.h 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/input_parse.h 2023-11-09 12:02:33.651110193 +0900
@@ -22,7 +22,7 @@
/*#include <fcntl.h>*/
/*#include <memory.h>*/
#include <stdlib.h>
-#ifndef DARWIN
+#ifndef __APPLE__
#include <malloc.h>
#else
#include <malloc/malloc.h>
diff -ruN phase0_2023.01/src_phase_3d/m_BP_Properties.F90 phase0_2023.01.01/src_phase_3d/m_BP_Properties.F90
--- phase0_2023.01/src_phase_3d/m_BP_Properties.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_BP_Properties.F90 2023-11-09 12:02:33.664110261 +0900
@@ -806,7 +806,7 @@
real(kind=DP) :: eps0,eps1
real(kind=DP) :: pos0(natm,3),pos1(natm,3)
logical :: exists
- real(kind=DP) :: dphi_ion
+ real(kind=DP) :: dphi_ion, dphi_0, dphi_1
! === KT_add === 2015/03/23
ismax = nspin /ndim_spinor
@@ -822,39 +822,56 @@
call m_BP_get_Berry_phase_strain(ig,ist,cphi1,wgh1,nkp1,eps1,pos1,exists)
if(.not.exists) cycle STRAIN
present_strain(ist) = .true.
- if(nkp0.ne.nkp1) then
- if(printable) then
- write(nfout,*) 'nkp0=',nkp0
- write(nfout,*) 'nkp1=',nkp1
- end if
- call phase_error_with_msg(nfout,'nkp0 and nkp1 are different in <<<m_BP_calc_diff_Berry_strain>>', &
- __LINE__,__FILE__)
- end if
- ! debug
- ! write(nfout,*) 'ig,ist =',ig,ist
- ! end debug
+
+! <<< ASMS 2023.10.31
+! if(nkp0.ne.nkp1) then
+! if(printable) then
+! write(nfout,*) 'nkp0=',nkp0
+! write(nfout,*) 'nkp1=',nkp1
+! end if
+! call phase_error_with_msg(nfout,'nkp0 and nkp1 are different in <<<m_BP_calc_diff_Berry_strain>>', &
+! __LINE__,__FILE__)
+! end if
+! ! debug
+! ! write(nfout,*) 'ig,ist =',ig,ist
+! ! end debug
+! ASMS 2023.10.31 >>>
dphi(ig,ist) = 0.d0
- do is=1, ismax
- do k=1,nkp0
- if(wgh0(k).ne.wgh1(k)) then
- if(printable) then
- write(nfout,*) 'wgh0=',wgh0(k)
- write(nfout,*) 'wgh1=',wgh1(k)
- end if
- call phase_error_with_msg(nfout,'wgh0 and wgh1 are different in <<<m_BP_calc_diff_Berry_strain>>'&
- ,__LINE__,__FILE__)
- end if
- phi(k,is) = dimag(log(cphi1(k,is)/cphi0(k,is)))
-
- ! debug
- if(printable) write(nfout,*) 'k=',k,' is=',is,' phi=',phi(k,is)
- ! end debug
+! <<< ASMS 2023.10.31
+! do is=1, ismax
+! do k=1,nkp0
+! if(wgh0(k).ne.wgh1(k)) then
+! if(printable) then
+! write(nfout,*) 'wgh0=',wgh0(k)
+! write(nfout,*) 'wgh1=',wgh1(k)
+! end if
+! call phase_error_with_msg(nfout,'wgh0 and wgh1 are different in <<<m_BP_calc_diff_Berry_strain>>'&
+! ,__LINE__,__FILE__)
+! end if
+! phi(k,is) = dimag(log(cphi1(k,is)/cphi0(k,is)))
+!
+! ! debug
+! if(printable) write(nfout,*) 'k=',k,' is=',is,' phi=',phi(k,is)
+! ! end debug
+!
+! dphi(ig,ist) = dphi(ig,ist) + phi(k,is)*wgh0(k)
+! end do
+! end do
- dphi(ig,ist) = dphi(ig,ist) + phi(k,is)*wgh0(k)
+ dphi_0 = 0.0d0; dphi_1 = 0.0d0
+ do is=1, ismax
+ do k=1, nkp0
+ dphi_0 = dphi_0 +dimag(log(cphi0(k,is))) *wgh0(k)
+ end do
+ do k=1, nkp1
+ dphi_1 = dphi_1 +dimag(log(cphi1(k,is))) *wgh1(k)
end do
end do
+ dphi(ig,ist) = dphi_1 -dphi_0
+! ASMS 2023.10.31 >>>
+
dphi(ig,ist) = 2.d0*dphi(ig,ist)
! debug
@@ -915,7 +932,7 @@
integer :: i,ia,ist
real(kind=DP) :: dphi(3,6)
real(kind=DP) :: fac
- logical :: present_strain(natm)
+ logical :: present_strain(6)
if(.not.allocated(piezo)) allocate(piezo(3,6))
piezo = 0.d0
diff -ruN phase0_2023.01/src_phase_3d/m_CD_mixing.F90 phase0_2023.01.01/src_phase_3d/m_CD_mixing.F90
--- phase0_2023.01/src_phase_3d/m_CD_mixing.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_CD_mixing.F90 2023-11-09 12:02:33.647110172 +0900
@@ -1,6 +1,9 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!!$#define _DUPLICATION_HSR_DOTPRODUCT_
+#define _PARALLEL_HSR_
!=======================================================================
!
-! SOFTWARE NAME : PHASE (ver. 900)
+! SOFTWARE NAME : PHASE/0 2023.01
!
! MODULE: m_Charge_Density
!
@@ -63,36 +66,29 @@
module m_CD_mixing
! $Id: m_CD_mixing.F90 593 2019-06-20 03:47:31Z jkoga $
- use m_Const_Parameters, only : BUCS, DP, OFF &
- & , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
- & , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
- & , OLD, NEXT, PAI, VTK &
- & , DELTA10 &
- & , unit_conv_byname, UMICRO, GAMMA, DELTA, ELECTRON, INVERSE, YES
+ use m_Const_Parameters, only : DP, OFF, BOHR,NO,YES,ANTIFERRO &
+ & , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY
use m_IterationNumbers, only : iteration,iteration_for_cmix
- use m_Parallelization, only : mpi_comm_group &
+ use m_Parallelization, only : m_Parallel_init_mpi_urec_hsr, mpi_comm_group &
& , ista_kngp,iend_kngp,is_kngp,ie_kngp,np_kngp,mp_kngp &
- & , npes,mype,ierr &
+ & , npes,ierr &
& , is_kgpm,ie_kgpm,ista_kgpm,iend_kgpm,mp_kgpm &
- & , nis_fftp, nie_fftp, myrank_g, nrank_g, myrank_chg,nrank_chg
+ & , myrank_chg,nrank_chg &
+ & , ista_urec_hsr,iend_urec_hsr, ista_and_iend_urec_hsr_set &
+ & , mpi_chg_world
use m_Timing, only : tstatc0_begin, tstatc0_end
- use m_Control_Parameters, only : nspin,ipri,ipriwf,iprichargedensity,c_precon &
+ use m_Control_Parameters, only : nspin,ipri,c_precon &
& , amix,bmix,hownew,nbxmix,istrbr &
- & , kimg,af,neg,ipripulay &
- & , charge_filetype, charge_title, initial_chg &
- & , iprichargemixing, ipritotalcharge &
+ & , kimg,af,neg,ipripulay,iprichargemixing &
& , sw_recomposing, spin_density_mixfactor &
& , amin, sw_precon_diff, sw_metric_diff,metric_ratio &
& , sw_force_simple_mixing,printable, sw_control_stepsize, max_stepsize &
& , m_CtrlP_set_rmx, ommix_factor
use m_Crystal_Structure, only : univol,nopr
- use m_PlaneWaveBasisSet, only : kg,kgp,ngpt_l,ngabc,gr_l,kgpm
- use m_Charge_Density, only : chgq_l, chgqo_l ,symmtrz_of_ff
- use m_Charge_Density, only : charge_average_3D
- use m_Parallelization, only : mpi_chg_world
-! === DEBUG by tkato 2011/09/09 ================================================
- use m_Charge_Density, only : work
-! ==============================================================================
+ use m_PlaneWaveBasisSet, only : kg,kgp,gr_l,kgpm
+ use m_Charge_Density, only : chgq_l, chgqo_l ,symmtrz_of_ff &
+ & , charge_average_3D
+
! === Added by tkato 2011/11/09 ================================================
use m_Control_Parameters, only : sw_mix_bothspins_sametime &
, sw_recomposing_hsr, sw_force_simple_mixing_hsr &
@@ -111,21 +107,18 @@
use m_Control_Parameters, only : sw_gradient_simplex, alpha_pulay, alpha_pulay_damp, alpha_pulay_org, alpha_pulay_damp_thres
-! ===== KT_add ===== 13.0U3
- use m_Control_Parameters, only : precon_mode
-! ================== 13.0U3
-! ==== KT_Add === 2014/09/16
- use m_Control_Parameters, only : sw_mix_charge_hardpart, sw_mix_charge_with_ekindens
-! =============== 2014/09/16
-
+ use m_Control_Parameters, only : precon_mode ! === KT_add === 13.0U3
+ use m_Control_Parameters, only : sw_mix_charge_hardpart, sw_mix_charge_with_ekindens ! ==== KT_Add === 2014/09/16
use m_Orbital_Population, only : om, omold, ommix, om_aimag, omold_aimag, ommix_aimag
+!!$#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!!$ use m_Files, only : nfout
+!!$#endif
implicit none
-! --> 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), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
+ real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
real(kind=DP),private,pointer, dimension(:,:,:) :: rho,rhoo ! MPI
! rho => chgq_l, rhoo => chgqo_l ( when kgpm == kgp)
@@ -181,6 +174,8 @@
real(DP),private,pointer,dimension(:,:,:) :: urec_l_3_2
#endif
+ logical, save :: is_and_ie_hsr_set = .false.
+
logical :: force_dealloc = .false.
integer, private :: previous_waymix = 0
@@ -195,8 +190,7 @@
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)
+ real(kind=DP),private,allocatable, dimension(:,:) :: rho_hsr, rhoo_hsr ! d(nsize_rho_hsr,nspin)
real(DP),private,allocatable,dimension(:,:) :: d0_hsr, u_hsr, v_hsr, w_hsr, &
& dout_hsr, dd_hsr
@@ -221,7 +215,7 @@
! ========================== adde by K. Tagami ========================== 11.0
integer :: nsize_rho_hsr_realpart
-integer :: nsize_rho_om_realpart
+ integer :: nsize_rho_om_realpart
! integer :: sw_mix_imaginary_hardpart = OFF
! integer :: sw_mix_imaginary_hardpart = ON
! ======================================================================= 11.0
@@ -230,7 +224,9 @@
real(kind=DP), allocatable, dimension(:,:) :: ynorm
-! ==== KT_add == 2014/09/19
+! --------------------------
+! meta-gga ( Kinetic Energy Density )
+! --------------------------
real(kind=DP), allocatable, target:: din_ekinq(:,:,:)
real(kind=DP), allocatable :: dout_ekinq(:,:,:)
real(kind=DP), allocatable :: dF_l_ekinq(:,:,:)
@@ -318,6 +314,31 @@
contains
+ subroutine m_CD_mixing_write_DEFINITION(nfout)
+ ! coded by T. Yamasaki, 2023/07/08
+ integer, intent(in) :: nfout
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(ipri>=1) then
+#endif
+ write(nfout,'(" !!")')
+ write(nfout,'(" !! <<m_CD_mixing_write_DEFINITION>>")')
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ write(nfout,'(" !! Compiler Defintion in (m_CD_mixing.F90) is _DUPLICATION_HSR_DOTPRODUCT_ ,", &
+ & "namely asis in HSR related dotproduction")')
+#else
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" !! Compiler Defintion in (m_CD_mixing.F90) is _PARALLEL_HSR__ ,",&
+ & "namely parallelized HSR related dotproduct")')
+#else
+ write(nfout,'(" !! Compiler Defintion in (m_CD_mixing.F90) is nothing, namely mpi_bcast after HSR related dotproduct")')
+#endif
+#endif
+ write(nfout,'(" !!")')
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ endif
+#endif
+ end subroutine m_CD_mixing_write_DEFINITION
+
subroutine alloc_chgqstore_recompose_chgq(rmxt,rmxtrc)
real(kind=DP),intent(in) :: rmxt
real(kind=DP),intent(out),dimension(nspin_m) :: rmxtrc
@@ -472,45 +493,23 @@
real(kind=DP) :: rmxtt
integer :: id_sname = -1
__TIMER_SUB_START(1103)
+ call tstatc0_begin('m_CD_simple_mixing ',id_sname,1)
-! ================================ modified by K. Tagami =============== 11.0
-!!! --> T. Yamasaki 03 Aug. 2009
-!! nspin_m = nspin/(af+1)
-!!! <--
-!
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
nspin_m = ndim_magmom
else
nspin_m = nspin/(af+1)
endif
-! ====================================================================== 11.0
- call tstatc0_begin('m_CD_simple_mixing ',id_sname,1)
if(previous_waymix /= SIMPLE.or.force_dealloc) then
call mix_dealloc_previous()
-! ------------------------------ ktDEBUG -------------------- 20121030
- call mix_dealloc_previous_hsr()
-! ------------------------------ ktDEBUG -------------------- 20121030
+ call mix_dealloc_previous_hsr() ! --- ktDEBUG ---------------- 20121030
force_dealloc = .false.
end if
-! ================================ modified by K. Tagami =============== 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-!
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmxt,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc = rmxt
-! end if
-! if(ipri >= 2) write(nfout,'(" rmxt = ",d20.8)') rmxt
-!! --> T. Yamasaki 03 Aug. 2009
-!
-!
allocate(rmxtrc(nspin_m))
-
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc = rmxt
rmxtrc(2:nspin_m) = min( rmxt *spin_density_mixfactor, rmx_max )
else
@@ -520,51 +519,28 @@
rmxtrc = rmxt
endif
end if
-
if(ipri >= 2) write(nfout,'(" rmxt = ",d20.8)') rmxt
-! ====================================================================== 11.0
-
-!!$ allocate(c_p(ista_kngp:iend_kngp))
- allocate(c_p(ista_kngp:iend_kngp,nspin_m))
- c_p = 0.0d0 ! ===== Adde by K. Tagami =========
-
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0.d0 ! =================== 11.0
call precon_4_charge_mix(rmxtrc,c_p)
__TIMER_DO_START(1148)
-! ================================ modified by K. Tagami ================ 11.0
-!! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 !! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
chgq_l(:,k,is) = c_p(:,is)*chgq_l(:,k,is) + (1.0d0-c_p(:,is))*chgqo_l(:,k,is)
end do
end do
__TIMER_DO_STOP(1148)
deallocate(c_p)
-
-! ================================ modified by K. Tagami ============= 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call compose_chgq_dealloc_chgqstore()
-! end if
-! deallocate(rmxtrc)
-!! <--
-
-!
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami ========= 11.0
if (sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call compose_chgq_dealloc_chgqstore()
end if
endif
+
deallocate(rmxtrc)
-! ==================================================================== 11.0
- if(af /= 0) then
-!xx allocate(work(kgp,kimg))
- call charge_average_3D(ANTIFERRO,chgq_l)
-!xx deallocate(work)
- endif
+ if(af /= 0) call charge_average_3D(ANTIFERRO,chgq_l)
previous_waymix = SIMPLE
call tstatc0_end(id_sname)
@@ -644,9 +620,7 @@
end do
else
allocate(gr_l_m(ista_kngp:iend_kngp))
-! ============================== by K. Tagami =============
- gr_l_m = 0.0d0
-! ========================================================
+ gr_l_m = 0.0d0 ! === by K. Tagami ===
call scatter_cp_onto_cpm(gr_l,gr_l_m)
do i = ist, iend_kgpm !for mpi
f_q(i) = 1.0d0 + (q1/gr_l_m(i))**2
@@ -685,6 +659,213 @@
endif
end function icrspd_is
+ subroutine mult_urec_urec(nfout,itc,jtc,iResid,fdpsum)
+ ! Coded by T. Yamasaki, 2023/07/07
+ integer :: nfout, itc, jtc, iResid
+ real(DP), intent(inout), dimension(nspin_m) :: fdpsum
+ real(DP), dimension(nspin_m) :: fmult
+ integer :: is, k
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(DP) :: time0, time1
+#endif
+
+#ifdef _PARALLEL_HSR_
+ if(.not.ista_and_iend_urec_hsr_set) then
+ call m_Parallel_init_mpi_urec_hsr(nfout,iprichargemixing,nsize_rho_hsr) !-> ista_urec_hsr, iend_urec_hsr
+ is_and_ie_hsr_set = .true.
+ endif
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_chg_world,ierr)
+ time0 = MPI_Wtime()
+#endif
+ fmult = 0.d0
+#ifdef _PARALLEL_HSR_
+ do is = 1, nspin_m, af+1
+ do k = ista_urec_hsr, iend_urec_hsr
+ fmult(is) = fmult(is) + urec_hsr(k,is,itc,iResid) * urec_hsr(k,is,jtc,iResid)
+ end do
+ end do
+ if(nrank_chg>=2) then
+ call mpi_allreduce(MPI_IN_PLACE, fmult, nspin_m, mpi_double_precision,mpi_sum,mpi_chg_world,ierr)
+ end if
+#else
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ write(nfout,'(" not _PARALLEL_HSR_")')
+#endif
+ do is = 1, nspin_m, af+1
+ fmult(is) = fmult(is) + sum( urec_hsr(:,is,itc,iResid)*urec_hsr(:,is,jtc,iResid) )
+ end do
+ call mpi_bcast(fmult, nspin_m, mpi_double_precision, 0, mpi_chg_world,ierr)
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_chg_world,ierr)
+ time1 = MPI_Wtime()
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" time in <<mult_urec_urec>> = ",f20.8, " (mpi_allreduce)")') time1-time0
+#else
+ write(nfout,'(" time in <<mult_urec_urec>> = ",f20.8, " (mpi_bcast)")') time1-time0
+#endif
+#endif
+ fdpsum = fdpsum + fmult
+ end subroutine mult_urec_urec
+
+ subroutine mult_urec_hsr5(nfout,u_hsr,mb,muv,j,iuv,v_hsr,fdpsum)
+ ! Coded by T. Yamasaki, 2023/07/07
+ integer, intent(in) :: nfout,mb,muv,j,iuv
+ real(DP), intent(in), dimension(nsize_rho_hsr,nspin_m,mb,muv) :: u_hsr
+ real(DP), intent(in), dimension(nsize_rho_hsr,nspin_m) :: v_hsr
+ real(DP), intent(out), dimension(nspin_m) :: fdpsum
+ real(DP), dimension(nspin_m) :: fmult
+ integer :: is, k
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(DP) :: time0, time1
+#endif
+
+#ifdef _PARALLEL_HSR_
+ if(.not.is_and_ie_hsr_set) then
+ call m_Parallel_init_mpi_urec_hsr(nfout,iprichargemixing,nsize_rho_hsr) !-> ista_urec_hsr, iend_urec_hsr
+ is_and_ie_hsr_set = .true.
+ end if
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_chg_world,ierr)
+ time0 = MPI_Wtime()
+#endif
+ fmult = 0.d0
+#ifdef _PARALLEL_HSR_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
+ do k = ista_urec_hsr, iend_urec_hsr
+ fmult(is) = fmult(is) + u_hsr(k,is,j,iuv) * v_hsr(k,is)
+ end do
+ end do
+ if(nrank_chg>=2) then
+ call mpi_allreduce(MPI_IN_PLACE, fmult, nspin_m, mpi_double_precision, mpi_sum,mpi_chg_world,ierr)
+ end if
+#else
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ write(nfout,'(" not _PARALLEL_HSR_")')
+#endif
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
+ fmult(is) = fmult(is) + sum( u_hsr(:,is,j,iuv)*v_hsr(:,is) )
+ end do
+ call mpi_bcast(fmult, nspin_m, mpi_double_precision, 0, mpi_chg_world,ierr)
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_chg_world,ierr)
+ time1 = MPI_Wtime()
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" time in <<mult_urec_hsr5>> = ",f20.8, " (mpi_allreduce)")') time1-time0
+#else
+ write(nfout,'(" time in <<mult_urec_hsr5>> = ",f20.8, " (mpi_bcast)")') time1-time0
+#endif
+#endif
+ fdpsum = fdpsum + fmult
+ end subroutine mult_urec_hsr5
+
+ subroutine mult_urec_hsr(nfout,v_hsr,FF_hsr,fdpsum)
+ ! Coded by T. Yamasaki, 2023/07/07
+ integer :: nfout
+ real(DP), intent(in), dimension(nsize_rho_hsr,nspin_m) :: v_hsr, FF_hsr
+ real(DP), intent(inout), dimension(nspin_m) :: fdpsum
+ real(DP), dimension(nspin_m) :: fmult
+ integer :: is, k
+!!$#ifdef DEBUG_WRITE
+!!$ real(DP) :: time0, time1
+!!$#endif
+
+#ifdef _PARALLEL_HSR_
+ if(.not.ista_and_iend_urec_hsr_set) then
+ call m_Parallel_init_mpi_urec_hsr(nfout,iprichargemixing,nsize_rho_hsr) !-> ista_urec_hsr, iend_urec_hsr
+ is_and_ie_hsr_set = .true.
+ endif
+#endif
+!!$#ifdef DEBUG_WRITE
+!!$ call MPI_Barrier( mpi_chg_world,ierr)
+!!$ time0 = MPI_Wtime()
+!!$#endif
+ fmult = 0.d0
+#ifdef _PARALLEL_HSR_
+ do is = 1, ndim_magmom, af+1
+ do k = ista_urec_hsr, iend_urec_hsr
+ fmult(is) = fmult(is) + v_hsr(k,is) * FF_hsr(k,is)
+ end do
+ end do
+ if(nrank_chg>=2) then
+ call mpi_allreduce(MPI_IN_PLACE, fmult, nspin_m, mpi_double_precision,mpi_sum,mpi_chg_world,ierr)
+ end if
+#else
+!!$#ifdef DEBUG_WRITE
+!!$ write(nfout,'(" not _PARALLEL_HSR_")')
+!!$#endif
+ do is = 1, ndim_magmom, af+1
+ fmult(is) = fmult(is) + sum( v_hsr(:,is)*FF_hsr(:,is) )
+ end do
+ call mpi_bcast(fmult, nspin_m, mpi_double_precision, 0, mpi_chg_world,ierr)
+#endif
+!!$#ifdef DEBUG_WRITE
+!!$ call MPI_Barrier( mpi_chg_world,ierr)
+!!$ time1 = MPI_Wtime()
+!!$#ifdef _PARALLEL_HSR_
+!!$ write(nfout,'(" time in <<mult_urec_hsr>> = ",f20.8, " (mpi_allreduce)")') time1-time0
+!!$#else
+!!$ write(nfout,'(" time in <<mult_urec_hsr>> = ",f20.8, " (mpi_bcast)")') time1-time0
+!!$#endif
+!!$#endif
+ fdpsum = fdpsum + fmult
+ end subroutine mult_urec_hsr
+
+ subroutine mult_urec_hsr_urec_d0(nfout,jtc,iResid,fdpsum)
+ ! Coded by T. Yamasaki, 2023/07/07
+ integer :: nfout, jtc, iResid
+ real(DP), intent(inout), dimension(nspin_m) :: fdpsum
+ real(DP), dimension(nspin_m) :: fmult
+ integer :: is, k
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(DP) :: time0, time1
+#endif
+
+#ifdef _PARALLEL_HSR_
+ if(.not.ista_and_iend_urec_hsr_set) then
+ call m_Parallel_init_mpi_urec_hsr(nfout,iprichargemixing,nsize_rho_hsr) !-> ista_urec_hsr, iend_urec_hsr
+ is_and_ie_hsr_set = .true.
+ endif
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_chg_world,ierr)
+ time0 = MPI_Wtime()
+#endif
+ fmult = 0.d0
+#ifdef _PARALLEL_HSR_
+ do is = 1, ndim_magmom, af+1
+ do k = ista_urec_hsr, iend_urec_hsr
+ fmult(is) = fmult(is) + urec_hsr(k,is,jtc,iResid) * d0_hsr(k,is)
+ end do
+ end do
+ if(nrank_chg>=2) then
+ call mpi_allreduce(MPI_IN_PLACE, fmult, nspin_m, mpi_double_precision,mpi_sum,mpi_chg_world,ierr)
+ end if
+#else
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ write(nfout,'(" not _PARALLEL_HSR_")')
+#endif
+ do is = 1, ndim_magmom, af+1
+ fmult(is) = fmult(is) + sum(urec_hsr(:,is,jtc,iResid) * d0_hsr(:,is))
+ end do
+ call mpi_bcast(fmult, nspin_m, mpi_double_precision, 0, mpi_chg_world,ierr)
+#endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call MPI_Barrier( mpi_chg_world,ierr)
+ time1 = MPI_Wtime()
+#ifdef _PARALLEL_HSR_
+ write(nfout,'(" time in <<mult_urec_hsr>> = ",f20.8, " (mpi_allreduce)")') time1-time0
+#else
+ write(nfout,'(" time in <<mult_urec_hsr>> = ",f20.8, " (mpi_bcast)")') time1-time0
+#endif
+#endif
+ fdpsum = fdpsum + fmult
+ end subroutine mult_urec_hsr_urec_d0
+
subroutine mult1s(u,v,f_q,fmult)
real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m) :: u,v
real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
@@ -696,27 +877,20 @@
fmult = 0.d0
-! ================================ modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ===================================================================== 11.0
-
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
p = 0.d0
fac=1.0d0
__TIMER_DO_START(1160)
do ik = 1,kimg
do i = ista_kgpm, iend_kgpm ! mpi
-! ========================================== modified by K. Tagami ======== 11.0
-! if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(i)
-!
- if ( noncol ) then
+
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
fac=f_q(i)
else
if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
fac=f_q(i)
endif
- endif
-! ======================================================================== 11.0
+ endif ! <<============================ 11.0
! p = p + f_q(i)*u(i,ik,is)*v(i,ik,is)
p = p + fac*u(i,ik,is)*v(i,ik,is)
@@ -746,27 +920,22 @@
integer :: is,ik,i
__TIMER_SUB_START(1115)
fmult = 0.d0
-! ================================ modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ===================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
p = 0.d0
fac=1.0d0
__TIMER_DO_START(1162)
do ik = 1,kimg
do i = ista_kgpm, iend_kgpm ! mpi
-! ========================================== modified by K. Tagami ======== 11.0
-! if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(i)
-!
- if ( noncol ) then
+
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
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
-! ========================================================================= 11.0
+ end if ! <<============================ 11.0
p = p + fac*u(i,ik,is,j,iuv)*v(i,ik,is)
end do
@@ -796,13 +965,7 @@
fmult = 0.d0
p = 0.d0
-
-! ================================ modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ===================================================================== 11.0
-
-!!$ p = 0.d0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
fac = 1.0d0
do ik = 1,kimg
do i = ista_kgpm, iend_kgpm ! mpi
@@ -817,7 +980,6 @@
endif
end if
! ========================================================================= 11.0
-
p = p + fac*u(i,ik,is,j,iuv)*v(i,ik,is)
end do
end do
@@ -839,11 +1001,7 @@
integer :: is,ik,ig
__TIMER_SUB_START(1137)
fmult = 0.d0
-
-! ====================================== modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
p = 0.d0
fac = 1.0d0
@@ -888,17 +1046,10 @@
fmult = 0.d0
p = 0.d0
-
-! ====================================== modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================== 11.0
-
-!!$ p = 0.d0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
fac = 1.0d0
do ik = 1,kimg
do ig = ista_kgpm, iend_kgpm ! mpi
-
! ====================================== modified by K. Tagami ============= 11.0
!! if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(ig)
!
@@ -910,7 +1061,6 @@
endif
end if
! ========================================================================== 11.0
-
p = p + fac*u(ig,ik,is,i,iu)*v(ig,ik,is,j,iv)
end do
end do
@@ -923,10 +1073,7 @@
end subroutine mult1s10_reduce_spin
subroutine subtr_j_th_term(f,iuv,j,urec_l,um)
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP), intent(in), dimension(nspin) :: f
- real(DP), intent(in), dimension(nspin_m) :: f
-! ==============================================================================
+ real(DP), intent(in), dimension(nspin_m) :: f ! dimension(nspin) :: f ! === DEBUG by tkato 2011/11/24 ===
integer, intent(in) :: iuv,j
real(DP), intent(in) :: urec_l(ista_kgpm:iend_kgpm,kimg,nspin_m,nbxmix,2)
real(DP), intent(inout) :: um(ista_kgpm:iend_kgpm,kimg,nspin_m)
@@ -938,10 +1085,7 @@
if(istart == 1) istart = 2
__TIMER_DO_START(1164)
-! =============================== modified by K. Tagami =================== 11.0
-!! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 !! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do ik = 1, kimg
do i = istart, iend_kgpm ! mpi
@@ -955,21 +1099,16 @@
subroutine store_to_urec2(v,f,j,iuv)
real(DP), intent(in) :: v(ista_kgpm:iend_kgpm,kimg,nspin_m)
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP), intent(in), dimension(nspin) :: f
- real(DP), intent(in), dimension(nspin_m) :: f
-! ==============================================================================
+
+ real(DP), intent(in), dimension(nspin_m) :: f ! dimension(nspin) :: f ! === DEBUG by tkato 2011/11/24 ===
integer , intent(in) :: j,iuv
real(DP) :: dv
integer :: is
__TIMER_SUB_START(1119)
__TIMER_DO_START(1165)
-! ====================================== modified by K. Tagami ============= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
dv = 1.d0/f(is)
urec_l(:,:,is,j,iuv) = v(:,:,is)*dv
end do
@@ -1004,10 +1143,8 @@
integer :: is,j,i,icr,jcr,iwork
__TIMER_SUB_START(1112)
__TIMER_DO_START(1158)
-! ======================================= modified by K. Tagami ========= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do j = 3, nbxmix
icr = ncrspd(2)
@@ -1039,16 +1176,13 @@
real(DP), intent(in), dimension(ista_kngp:iend_kngp,nspin_m) :: p
integer :: is,k
-! ==================================== added by K. Tagami ============ 11.0
- if ( noncol ) return
-! ===================================================================11.0
+
+ if ( noncol ) return ! === added by K. Tagami === 11.0
if(nspin<2 .or. af==1) return
-! === DEBUG by tkato 2011/11/18 ================================================
- if(kgpm == kgp .or. nrank_chg == 1) then
-! ==============================================================================
-!!$ write(6,'(" ! kgpm == kgp")')
+
+ if(kgpm == kgp .or. nrank_chg == 1) then ! === DEBUG by tkato 2011/11/18 ===
do is = 2, 2
din (ista_kgpm:iend_kgpm,:,is) = chgqo_l(ista_kgpm:iend_kgpm,:,is)
dout(ista_kgpm:iend_kgpm,:,is) = chgq_l (ista_kgpm:iend_kgpm,:,is)
@@ -1070,14 +1204,10 @@
integer :: is,k
__TIMER_SUB_START(1108)
-! === DEBUG by tkato 2011/11/18 ================================================
- if(kgpm == kgp .or. nrank_chg == 1) then
-! ==============================================================================
+
+ if(kgpm == kgp .or. nrank_chg == 1) then ! === DEBUG by tkato 2011/11/18 ===
__TIMER_DO_START(1154)
-! ========================= modified by K. Tagami ==================== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ==================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din (ista_kgpm:iend_kgpm,:,is) = chgqo_l(ista_kgpm:iend_kgpm,:,is)
dout(ista_kgpm:iend_kgpm,:,is) = chgq_l (ista_kgpm:iend_kgpm,:,is)
@@ -1088,10 +1218,8 @@
call scatter_chg_onto_d(chgq_l, dout) ! -(m_C.D.)
end if
__TIMER_DO_START(1155)
-! ========================= modified by K. Tagami ==================== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ==================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
chgq_l(:,k,is) = p(:,is)*chgq_l(:,k,is) + (1.0d0-p(:,is))*chgqo_l(:,k,is)
end do
@@ -1119,16 +1247,11 @@
__TIMER_DO_START(1168)
if(ip == myrank_chg) then
-! =============================== modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ==================================================================== 11.0
-
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do ik = 1, kimg
ipbase = mp_kngp*(ik-1) + mp_kngp*kimg*(is-1)
do i = 1, iend_kngp-ista_kngp+1
- prj_wk(i + ipbase) = c(ista_kngp-1+i,ik,is)
-!!$ prj_wk(i,ik,is) = c(ista_kngp-1+i,ik,is)
+ prj_wk(i + ipbase) = c(ista_kngp-1+i,ik,is) !!$ prj_wk(i,ik,is) = c(ista_kngp-1+i,ik,is)
end do
end do
end do
@@ -1143,16 +1266,12 @@
iend = iend_kgpm; if(iend > ie_kngp(ip)) iend = ie_kngp(ip)
if(iend < istart) cycle
__TIMER_DO_START(1170)
-! ====================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do ik = 1, kimg
ipbase = mp_kngp*(ik-1) + mp_kngp*kimg*(is-1)
do i = istart, iend
- d(i,ik,is) = prj_wk(i + ipbase)
-!!$ d(i,ik,is) = prj_wk(i - is_kngp(ip)+1,ik,is)
+ d(i,ik,is) = prj_wk(i + ipbase) !!$ d(i,ik,is) = prj_wk(i - is_kngp(ip)+1,ik,is)
end do
end do
!!$ d(istart:iend,:,is) = prj_wk(istart-is_kngp(ip)+1:iend-is_kngp(ip)+1,:,is)
@@ -1168,21 +1287,16 @@
integer :: ip,istart,iend,i, is, ibase, nelmnt
-! --> T. Yamasaki, 03rd Aug. 2009
- nelmnt = mp_kngp*nspin_m
-! <--
-!!$ print '(" -- scatter_cp_onto_cpm -- ")'
+
+ nelmnt = mp_kngp*nspin_m ! T. Yamasaki, 03rd Aug. 2009
+
do ip = 0, nrank_chg - 1
! (1) coping input data onto a work array, and broadcasting
if(is_kngp(ip) > kgpm) exit
if(ip == myrank_chg) then
! --> T. Yamasaki, 03rd Aug. 2009
-! ============================= modified by K. Tagami ================= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ==================================================================== 11.0
-
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
ibase = mp_kngp*(is-1)
do i = 1, iend_kngp-ista_kngp+1
prj_wk(i+ibase) = cp(ista_kngp-1+i,is)
@@ -1201,11 +1315,7 @@
iend = iend_kgpm; if(iend > ie_kngp(ip)) iend = ie_kngp(ip)
if(iend < istart) cycle
! --> T. Yamasaki, 03rd Aug. 2009
-
-! ==================================== modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
ibase = mp_kngp*(is-1)
do i = istart, iend
cpm(i,is) = prj_wk(i + ibase)
@@ -1229,7 +1339,6 @@
! =========================================================================== 11.0
integer :: ip,is,istart,iend,nelmnt,ik,i,ip2,ipbase
-!!$ integer :: istart_p, iend_p
__TIMER_SUB_START(1122)
if(kgpm < kgp .and. nrank_chg /= 1) then
@@ -1242,10 +1351,8 @@
if(iend < istart) cycle
if(myrank_chg == ip2) then
__TIMER_DO_START(1171)
-! ================================ modified by K. Tagami ================= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do ik = 1, kimg
ipbase = mp_kgpm*(ik-1) + mp_kgpm*kimg*(is-1) - istart + 1
do i = istart, iend
@@ -1261,10 +1368,8 @@
if(myrank_chg == ip) then
call mpi_recv(prj_wk,nelmnt,mpi_double_precision,ip2,1,mpi_chg_world,istatus,ierr)
__TIMER_DO_START(1173)
-! ================================ modified by K. Tagami ================= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do ik = 1, kimg
ipbase = mp_kgpm*(ik-1) + mp_kgpm*kimg*(is-1) - istart + 1
do i = istart, iend
@@ -1316,9 +1421,8 @@
allocate(dF_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(urec_l(ista_kgpm:iend_kgpm,kimg,nspin_m,nbxmix,2))
allocate(prj_wk(mp_kngp*kimg*nspin_m))
-! ======================================Added by K. Tagami ========
- din = 0.0d0; dout = 0.0d0; dF_l = 0.0d0; urec_l = 0.0d0; prj_wk = 0.0d0
-! ==================================================================
+
+ din = 0.0d0; dout = 0.0d0; dF_l = 0.0d0; urec_l = 0.0d0; prj_wk = 0.0d0 ! === Added by K. Tagami ===
if(hownew == RENEW) then
! ============================= modified by K. Tagami =========== 11.0
! allocate(f(nbxmix,nbxmix,nspin))
@@ -1330,14 +1434,10 @@
endif
! =============================================================== 11.0
allocate(g(nbxmix))
-! ================================= Added by K. Tagami ==========
- f = 0.0d0; g = 0.0d0
-! ==============================================================
+ f = 0.0d0; g = 0.0d0 ! === Added by K. Tagami ===
end if
allocate(ncrspd(nbxmix))
-! ================================= Added by K. Tagami ==========
- ncrspd = 0
-! ==============================================================
+ ncrspd = 0 ! === Added by K. Tagami ===
end subroutine mix_broyden_allocate
subroutine mix_broyden_deallocate
@@ -1356,9 +1456,7 @@
allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(u_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(v_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
-! =========================================== Added by K. Tagami =======
- d0_l = 0; u_l = 0; v_l = 0
-! =======================================================================
+ d0_l = 0; u_l = 0; v_l = 0 ! === Added by K. Tagami ===
call alloc_rho_rhoo_and_cpm
end subroutine mix_broyden_alloc2
@@ -1367,9 +1465,7 @@
allocate(rho(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(rhoo(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(c_pm(ista_kgpm:iend_kgpm,nspin_m))
-! ============================================= Added by K. Tagami ======
- rho = 0.0d0; rhoo = 0.0d0 ; c_pm = 0.0d0
-! =======================================================================
+ rho = 0.0d0; rhoo = 0.0d0 ; c_pm = 0.0d0 ! === Added by K. Tagami ===
call scatter_chg_onto_d(chgq_l,rho)
call scatter_chg_onto_d(chgqo_l,rhoo)
call scatter_cp_onto_cpm(c_p,c_pm)
@@ -1397,9 +1493,7 @@
allocate(u_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(v_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(dd_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
-! =========================================== Added by K. Tagami ===
- d0_l = 0.0d0; u_l = 0.0d0; v_l = 0.0d0; dd_l = 0.0d0
-! =================================================================
+ d0_l = 0.0d0; u_l = 0.0d0; v_l = 0.0d0; dd_l = 0.0d0 ! === Added by K. Tagami ===
call alloc_rho_rhoo_and_cpm
__TIMER_SUB_STOP(1109)
end subroutine mix_broyden_alloc3
@@ -1434,10 +1528,8 @@
allocate(ncrspd(nbxmix))
allocate(uuf(nbxmix,nspin_m,2))
allocate(prj_wk(mp_kngp*kimg*nspin_m))
-! =============================Added by K. Tagami =============
- din = 0.0d0; dout = 0.0d0; dF_l = 0.0d0; urec_l = 0.0d0
- ncrspd = 0; uuf = 0.0d0; prj_wk = 0.0d0
-! ============================================================
+ din = 0.0d0; dout = 0.0d0; dF_l = 0.0d0; urec_l = 0.0d0 ! === Added by K. Tagami ===
+ ncrspd = 0; uuf = 0.0d0; prj_wk = 0.0d0 ! === Added by K. Tagami ===
end subroutine mix_DFP_allocate
subroutine mix_DFP_deallocate()
@@ -1455,9 +1547,7 @@
allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(u_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(w_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
-! ======================================== Added by K. Tagami ======
- d0_l = 0; u_l = 0; w_l = 0
-! ==================================================================
+ d0_l = 0; u_l = 0; w_l = 0 ! === Added by K. Tagami ===
call alloc_rho_rhoo_and_cpm
end subroutine mix_DFP_alloc2
@@ -1467,7 +1557,6 @@
end subroutine mix_DFP_dealloc2
!!!
-!!!
!!! ========================== added by K. Tagami ================ 5.0
subroutine alloc_rhostore_recomp( rmxt, rmxtrc )
real(kind=DP),intent(in) :: rmxt
@@ -1722,11 +1811,7 @@
subroutine renew_u_br(j,i)
integer, intent(in) :: j,i
-
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: v_dF(nspin)
- real(DP) :: v_dF(nspin_m)
-! ==============================================================================
+ real(DP) :: v_dF(nspin_m) ! real(DP) :: v_dF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1113)
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
@@ -1747,21 +1832,15 @@
! ================================================================== 11.0
call subtr_j_th_term(v_dF,iU,j,urec_l,u_l) !-(m_CD)
-
! |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
-! === DEBUG by tkato 2011/11/24 ================================================
-! if(hownew == RENEW) f(j,i,1:nspin) = v_dF(1:nspin)
- if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m)
-! ==============================================================================
+
+ if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m) ! nspin --> nspin_m ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_STOP(1113)
end subroutine renew_u_br
subroutine renew_d_br(j)
integer, intent(in) :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1118)
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
@@ -1769,12 +1848,10 @@
#else
call mult1s5(urec_l,nbxmix,2,j,iV,F_l,f_p,vF) !-(m_CD);<v|F> ->vF
#endif
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
- vF(1) = vF(1) + vF(2)
- vF(2) = vF(1)
+
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! nspin==2 --> nspin_m==2 ! === DEBUG by tkato 2011/11/24 ===
+ vF(1) = vF(1) + vF(2)
+ vF(2) = vF(1)
endif
! ================================= added by K. Tagami =============== 11.0
@@ -1792,18 +1869,13 @@
subroutine renew_d_last_br(p)
real(DP), intent(in), dimension(ista_kngp:iend_kngp) :: p
integer :: is, ik, i, ns
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1120)
call mult1s(v_l,F_l,f_p,vF) !-(m_CD) <v|F> ->vF
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin==2 .and. ...) ! === DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
@@ -1817,10 +1889,8 @@
if(kgpm == kgp .or. nrank_chg == 1) then
__TIMER_DO_START(1166)
-! ===================================== modified by K. Tagami ============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din (:,:,is) = chgqo_l(ista_kgpm:iend_kgpm,:,is)
dout(:,:,is) = chgq_l (ista_kgpm:iend_kgpm,:,is)
end do
@@ -1860,18 +1930,46 @@
__TIMER_SUB_STOP(1120)
end subroutine renew_d_last_br
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ subroutine printvF(nfout,aorb,title,n,vF,j,i)
+ integer, intent(in) :: nfout,n
+ character(len=1), intent(in) :: aorb
+ character(len=n), intent(in) :: title
+ real(DP), intent(in) :: vF(nspin_m)
+ integer, intent(in), optional :: j,i
+!!$ character(len=80) :: fmt = ''
+!!$ write(fmt,*) "(a",n,")"
+ if(present(i) .and. present(j)) then
+ if(nspin_m == 1) then
+ write(nfout,'(" (",a1,") (j,i) = (",i2,",",i2,") ",a4,"(1) = ",f20.12)') aorb,j,i, title, vF(1)
+ else
+ write(nfout,'(" (",a1,") (j,i) = (",i2,",",i2,") ",a4,"(1) = ",f20.12, 2x,a4,"(2) = ",f20.12)') &
+ & aorb,j,i, title, vF(1), title, vF(2)
+ end if
+ else if(present(j)) then
+ if(nspin_m == 1) then
+ write(nfout,'(" (",a1,") j = ",i2,1x,a2,"(1) = ",f20.12)') aorb, j, title, vF(1)
+ else
+ write(nfout,'(" (",a1,") j = ",i2,1x,a2,"(1) = ",f20.12, 2x,a4,"(2) = ",f20.12)') aorb, j, title, vF(1), title, vF(2)
+ end if
+ else
+ if(nspin_m == 1) then
+ write(nfout,'(" (",a1,") ",a2,"(1) = ",f20.12)') aorb, title, vF(1)
+ else
+ write(nfout,'(" (",a1,") ",a2,"(1) = ",f20.12,2x, a4,"(2) = ",f20.12)') aorb, title, vF(1),title, vF(2)
+ end if
+ end if
+ end subroutine printvF
+#endif
+
! =========================== added by K. Tagami ================================== 5.0
- subroutine renew_u_br_with_hsr(j,i)
- integer, intent(in) :: j,i
+ subroutine renew_u_br_with_hsr(nfout,j,i)
+ integer, intent(in) :: nfout,j,i
integer :: is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: v_dF(nspin)
- real(DP) :: v_dF(nspin_m)
-! ==============================================================================
+ real(DP) :: v_dF(nspin_m) ! v_dF(nspin), revised by tkato 2011/11/24
v_dF = 0.d0
-
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
call mult1s(urec_l_3,dF_l,f_p,v_dF)!-(m_CD);<v|dF> ->v_dF
@@ -1879,50 +1977,48 @@
call mult1s5(urec_l,nbxmix,2,j,iV,dF_l,f_p,v_dF)
#endif
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"a","v_dF",4,v_dF,j,i)
+ write(nfout,'(" nsize_rho_hsr = ",i8)') nsize_rho_hsr
+#endif
+
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
v_dF(is) = v_dF(is) + sum( urec_hsr(:,is,j,iV)*dF_hsr(:,is) )
- End do
-!
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ end do
+#else
+ call mult_urec_hsr5(nfout,urec_hsr,nbxmix,2,j,iV,dF_hsr,v_dF) ! -(m_CD_mixing) <v_hsr|FF_hsr> -> v_dF_hsr by T. Yamasaki 2023/07/07
+#endif
+
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin==2 .and. ...) then ! === DEBUG by tkato 2011/11/24 ===
v_dF(1) = v_dF(1) + v_dF(2)
v_df(2) = v_dF(1)
endif
-!
-! ======================== added by K. Tagami ==================== 11.0
- if ( noncol ) then
+
+ if ( noncol ) then ! === added by K. Tagami === 11.0
v_dF(1) = sum( v_dF(:) )
v_dF(:) = v_dF(1)
endif
-! ================================================================ 11.0
+
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"b","v_dF",4,v_dF,j,i)
+#endif
call subtr_j_th_term(v_dF,iU,j,urec_l,u_l) !-(m_CD)
! |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
u_hsr(:,is) = u_hsr(:,is) - v_dF(is) *urec_hsr(:,is,j,iU)
- End do
-! === DEBUG by tkato 2011/11/24 ================================================
-! if(hownew == RENEW) f(j,i,1:nspin) = v_dF(1:nspin)
- if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m)
-! ==============================================================================
+ end do
+
+ if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m) ! nspin --> nspin_m ! === DEBUG by tkato 2011/11/24 ===
end subroutine renew_u_br_with_hsr
- subroutine renew_d_br_with_hsr(j)
- integer, intent(in) :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+ subroutine renew_d_br_with_hsr(nfout,j)
+ integer, intent(in) :: nfout,j
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
+
integer :: is
vF = 0.d0
@@ -1934,79 +2030,75 @@
call mult1s5(urec_l,nbxmix,2,j,iV,F_l,f_p,vF) !-(m_CD);<v|F> ->vF
#endif
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
- vF(is) = vF(is) + sum( urec_hsr(:,is,j,iV)*FF_hsr(:,is) )
- End do
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"a","vF",2,vF,j)
+#endif
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
+ vF(is) = vF(is) + sum( urec_hsr(:,is,j,iV)*FF_hsr(:,is) )
+ end do
+#else
+ call mult_urec_hsr5(nfout,urec_hsr,nbxmix,2,j,iV,FF_hsr, vF) ! by T. Yamasaki 2023/07/07
+#endif
+
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin==2 .and. ...) then ! === DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
-! ======================== added by K. Tagami ==================== 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
vF(1) = sum( vF(:) )
vF(:) = vF(1)
endif
-! ================================================================ 11.0
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"b","vF",2,vF,j)
+#endif
call subtr_j_th_term(vF,iU,j,urec_l,d0_l) !-(m_CD)
! |d(m)> = |d(m)> - <v(j)|F(m)>|u(j)>
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
d0_hsr(:,is) = d0_hsr(:,is) - vF(is) *urec_hsr(:,is,j,iU)
end do
end subroutine renew_d_br_with_hsr
- subroutine renew_d_last_br_with_hsr( p, rmxtrc_hsr )
+ subroutine renew_d_last_br_with_hsr(nfout, p, rmxtrc_hsr )
+ integer, intent(in) :: nfout
real(DP), intent(in), dimension(ista_kngp:iend_kngp) :: p
real(DP), intent(in) :: rmxtrc_hsr(nspin_m)
integer :: is, ik, i, ns
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vF(nspin)
- real(DP) :: vF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: vF(nspin_m) ! real(DP) :: vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
vF = 0.0d0
call mult1s(v_l,F_l,f_p,vF) !-(m_CD) <v|F> ->vF
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"a","vF",2,vF)
+#endif
+
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
vF(is) = vF(is) + sum( v_hsr(:,is)*FF_hsr(:,is) )
- End do
+ end do
+#else
+ call mult_urec_hsr(nfout,v_hsr,FF_hsr,vF) ! -(m_CD_mixing) <v_hsr|FF_hsr> -> vF_hsr, by T. Yamasaki 2023/07/07
+#endif
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin==2 .and. ...) then ! === DEBUG by tkato 2011/11/24 ===
vF(1) = vF(1) + vF(2)
vF(2) = vF(1)
endif
-! ========================== added by K. Tagami =============== 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami ========= 11.0
vF(1) = sum( vF(:) )
vF(:) = vF(1)
endif
-! ============================================================= 11.0
if(kgpm == kgp .or. npes == 1) then
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din (:,:,is) = chgqo_l(ista_kgpm:iend_kgpm,:,is)
dout(:,:,is) = chgq_l (ista_kgpm:iend_kgpm,:,is)
end do
@@ -2015,17 +2107,16 @@
call scatter_chg_onto_d(chgq_l, dout) ! -(m_C.D.)
end if
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
din_hsr (:,is) = rhoo_hsr(:,is) ! chgqo
dout_hsr(:,is) = rho_hsr (:,is) ! chgq
end do
-!!$ do is = 1, nspin, af+1
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ call printvF(nfout,"b","vF",2,vF)
+#endif
ns = nspin_for_qnewton()
- do is = 1, ns,af+1
+ do is = 1, ns,af+1 ! do is = 1, nspin, af+1
do ik = 1, kimg
do i = ista_kgpm,iend_kgpm
rho(i,ik,is) = d0_l(i,ik,is) - vF(is)*u_l(i,ik,is)
@@ -2073,10 +2164,7 @@
iend = kgp; if(iend > iend_kngp) iend = iend_kngp
__TIMER_DO_START(1174)
if(iend >= istart) then
-! =================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do ik = 1, kimg
do i = istart, iend
chgq_l(i,ik,is) = p(i)*chgq_l(i,ik,is) + (1.0d0-p(i))*chgqo_l(i,ik,is)
@@ -2202,10 +2290,7 @@
subroutine m_CD_mix_broyden1(rmx)
real(DP),intent(in) :: rmx
integer :: iter,j,mxiter,icr,jcr
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: vdF(nspin)
- real(DP) :: vdF(nspin_m)
-! ==============================================================================
+ real(DP) :: vdF(nspin_m) !! real(DP) :: vdF(nspin) ! === DEBUG by tkato 2011/11/24 ===
integer :: id_sname = -1
__TIMER_SUB_START(1107)
call tstatc0_begin('m_CD_mix_broyden1 ',id_sname,1)
@@ -2216,18 +2301,8 @@
force_dealloc = .false.
end if
-! ================================== modified by K. Tagami =============== 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc(1:nspin_m) = rmx
-! end if
-!! <--
-!
allocate(rmxtrc(nspin_m))
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc(1:nspin_m) = rmx
rmxtrc(2:nspin_m) = min( rmx *spin_density_mixfactor, rmx_max )
else
@@ -2237,16 +2312,8 @@
rmxtrc(1:nspin_m) = rmx
end if
end if
-! ======================================================================== 11.0
-
-! ================================== Modified by K. Tagami =============
-! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
- allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-
-! =======================================================================
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0 ! allocate(c_p(ista_kngp:iend_kngp)) ! === Modified by K. Tagami ===
call precon_4_charge_mix(rmxtrc,c_p)
@@ -2277,32 +2344,18 @@
call mix_broyden_dealloc3() !-(m_CD)
endif
-! =================================== modified by K. Tagami =========== 11.0
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call compose_chgq_dealloc_chgqstore()
-! end if
-! deallocate(rmxtrc)
-!! <--
-!
- if ( .not. noncol ) then
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call compose_chgq_dealloc_chgqstore()
- end if
+ end if ! <--
endif
deallocate(rmxtrc)
-! ======================================================================== 11.0
if(af /= 0) then
-!xx allocate(work(kgp,kimg))
-! =============================================== Added by K. Tagami ========
-!xx work = 0
-! ===========================================================================
call charge_average_3D(ANTIFERRO,chgq_l)
-!xx deallocate(work)
endif
-
deallocate(c_p)
previous_waymix = BROYD1
call tstatc0_end(id_sname)
@@ -2317,10 +2370,8 @@
integer :: is,k,i
__TIMER_SUB_START(1110)
__TIMER_DO_START(1156)
-! ==================================== modified by K. Tagami ============ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ====================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -2339,11 +2390,8 @@
end do
__TIMER_DO_STOP(1156)
__TIMER_DO_START(1157)
-! ================================= modified by K. Tagami =============== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
v_l(:,k,is) = c_pm(:,is)*dd_l(:,k,is)
end do
@@ -2354,10 +2402,8 @@
subroutine renew_v(j)
integer, intent(in) :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: u_dd(nspin)
- real(DP) :: u_dd(nspin_m)
-! ==============================================================================
+
+ real(DP) :: u_dd(nspin_m) ! real(DP) :: u_dd(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1117)
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iU)
@@ -2374,14 +2420,10 @@
subroutine m_CD_mix_broyden2(nfout,rmx)
integer, intent(in) :: nfout
real(DP),intent(in) :: rmx
-
integer :: iter,j,mxiter,icr,jcr
-!!$ real(DP) :: v_dF(nspin),vF(nspin)
integer :: id_sname = -1
-! --> T. Yamasaki 03 Aug. 2009
+
real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
-! real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
-! <--
__TIMER_SUB_START(1124)
call tstatc0_begin('m_CD_mix_broyden2 ',id_sname,1)
@@ -2391,46 +2433,29 @@
force_dealloc = .false.
end if
-! ===================================== modified by K. Tagami ============ 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc(1:nspin_m) = rmx
-! end if
-!! <--
-
allocate(rmxtrc(nspin_m))
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc(1:nspin_m) = rmx
rmxtrc(2:nspin_m) = min( rmx *spin_density_mixfactor, rmx_max )
else
+!! --> T. Yamasaki 03 Aug. 2009
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
else
rmxtrc(1:nspin_m) = rmx
- end if
+ end if ! <--
endif
-! ======================================================================== 11.0
-! ====================== Modified by K. Tagami =========
-! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-! =======================================================
call precon_4_charge_mix(rmxtrc,c_p)
-
iter = iter_from_reset() !-(m_CD)
if((iter-istrbr+1) <= 1) then
call simple_mix1(c_p) !-(m_CD)
! din=chgqo_l; dout=chgq_l; (din,dout,c_p)->chgq_l
else
-!!$ stop ' -- iter-istrbr+1 > 1 (m_CD_mix_broyden2) --'
call mix_broyden_alloc2 !-(m_CD) d0_l,u_l, and v_l are allocated
call dF_F_d0_u_and_v !-(c.h.) dF_l, F_l, initial u_l,v_l,d0_l
@@ -2450,30 +2475,15 @@
call mix_broyden_dealloc2 !-(m_CD)
endif
-! ============================== modified by K. Tagami ================= 11.0
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call compose_chgq_dealloc_chgqstore()
-! end if
-! deallocate(rmxtrc)
-!! <--
-!
- if ( .not. noncol ) then
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call compose_chgq_dealloc_chgqstore()
- end if
+ end if ! <--
endif
deallocate(rmxtrc)
-! =========================================================================== 11.0
- if(af /= 0) then
-!xx allocate(work(kgp,kimg))
-! ============================================== Added by K. Tagami =======
-!xx work = 0
-! ========================================================================
- call charge_average_3D(ANTIFERRO,chgq_l)
-!xx deallocate(work)
- endif
+ if(af /= 0) call charge_average_3D(ANTIFERRO,chgq_l)
deallocate(c_p)
previous_waymix = BROYD2
@@ -2514,26 +2524,18 @@
call mult1s(dF_l,dF_l,f_p,fff)
if(sum(fff) < 1.d-40) call phase_error_with_msg(nfout,' fmult is too small',__LINE__,__FILE__)
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin == 2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin == 2 .and. ...) then ! === DEBUG by tkato 2011/11/24 ===
fff(1) = fff(1) + fff(2)
fff(2) = fff(1)
endif
-! ========================= added by K. Tagami =========================== 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
fff(1) = sum( fff(:) )
fff(:) = fff(1)
endif
-! ======================================================================== 11.0
-
__TIMER_DO_START(1176)
-! ========================================= modified by K. Tagami ========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
v_l(:,:,is) = dF_l(:,:,is)/fff(is)
end do
__TIMER_DO_STOP(1176)
@@ -2549,12 +2551,10 @@
logical, intent(in) :: mixocc
integer :: iter,j,mxiter,icr,jcr
-!!$ real(DP) :: v_dF(nspin),vF(nspin)
integer :: id_sname = -1
-! --> 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), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
+
call tstatc0_begin('m_CD_mix_broyden2_hsr ',id_sname,1)
if (previous_waymix /= BROYD2.or.force_dealloc) then
@@ -2593,18 +2593,8 @@
endif
! ========================================================================= 11.0
-! ==================================== modified by K. Tagami ============= 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc(1:nspin_m) = rmx
-! end if
-!! <--
-!
allocate(rmxtrc(nspin_m))
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc(1:nspin_m) = rmx
rmxtrc(2:nspin_m) = min( rmx *spin_density_mixfactor, rmx_max )
else
@@ -2614,16 +2604,8 @@
rmxtrc(1:nspin_m) = rmx
end if
endif
-! ========================================================================= 11.0
-! ========================= modified by K. Tagami ======================= 11.0
-! if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
-! call alloc_rhostore_recomp( rmx, rmxtrc )
-! else
-! rmxtrc = rmx
-! endif
-
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc = rmx
rmxtrc(2:nspin_m) = min( rmx *spin_density_mixfactor, rmx_max )
else
@@ -2633,26 +2615,17 @@
rmxtrc = rmx
endif
endif
-! ========================================================================== 11.0
-! ====================== Modified by K. Tagami =========
-! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
- allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-! =======================================================
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0 ! allocate(c_p(ista_kngp:iend_kngp)) ! === Modified by K. Tagami ===
call precon_4_charge_mix(rmxtrc,c_p)
-
-
+
iter = iter_from_reset() !-(m_CD)
if((iter-istrbr+1) <= 1) then
call simple_mix1(c_p) !-(m_CD)
- ! din=chgqo_l; dout=chgq_l; (din,dout,c_p)->chgq_l
call simple_mix_kt( rmxtrc )
else
-!!$ stop ' -- iter-istrbr+1 > 1 (m_CD_mix_broyden2) --'
call mix_broyden_alloc2 !-(m_CD) d0_l,u_l, and v_l are allocated
call mix_broyden_alloc2_hsr
@@ -2664,8 +2637,8 @@
icr = icrspd_is(iter) !-(m_CD) function
do j = 2, mxiter
jcr = ncrspd(j)
- call renew_u_br_with_hsr(jcr,icr) !-(m_CD) |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
- call renew_d_br_with_hsr(jcr) !-(m_CD) |d(m)> = |d(m)> - <v(j)|F(m)> |u(j)>
+ call renew_u_br_with_hsr(nfout,jcr,icr) !-(m_CD) |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
+ call renew_d_br_with_hsr(nfout,jcr) !-(m_CD) |d(m)> = |d(m)> - <v(j)|F(m)> |u(j)>
enddo!j-loop
urec_l(:,:,:,icr,iU) = u_l(:,:,:) ! storing
@@ -2674,26 +2647,14 @@
urec_hsr(:,:,icr,iU) = u_hsr(:,:) ! storing
urec_hsr(:,:,icr,iV) = v_hsr(:,:) ! storing
- call renew_d_last_br_with_hsr( c_p, rmxtrc )
+ call renew_d_last_br_with_hsr(nfout, c_p, rmxtrc )
!-(m_CD) chgq_l(|d(m)>) = |d(m)>-<v(m)|F(m)>|u(m)>
call mix_broyden_dealloc2 !-(m_CD)
call mix_broyden_dealloc2_hsr
endif
-! ============================== modified by K. Tagami ================= 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call compose_chgq_dealloc_chgqstore()
-! end if
-!! <--
-! if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
-! call compose_rho_dealloc_store
-! end if
-! call map_rho_to_hsr( hsr, rho_hsr )
-! deallocate(rmxtrc)
-!
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call compose_chgq_dealloc_chgqstore()
end if
@@ -2702,7 +2663,7 @@
end if
endif
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
call map_rho_to_hsr_noncl( hsr, hsi, rho_hsr )
if ( mixocc ) call map_rho_to_om_noncl( om, om_aimag, rho_hsr )
else
@@ -2711,7 +2672,6 @@
endif
deallocate(rmxtrc)
-! =========================================================================== 11.0
if(af /= 0) then
call charge_average_3D(ANTIFERRO,chgq_l)
@@ -2731,10 +2691,7 @@
integer :: is,k,i
real(DP), dimension(nspin_m) :: fff
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -2750,11 +2707,8 @@
if(myrank_chg == 0) u_l(1,k,is) = 0.d0
end do
end do
-!
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
dF_hsr(:,is) = ( rho_hsr(:,is)-rhoo_hsr(:,is)) - ( dout_hsr(:,is)-FF_hsr(:,is))
d0_hsr(:,is) = rhoo_hsr(:,is) + rmxtrc(is) *( rho_hsr(:,is) - rhoo_hsr(:,is))
u_hsr(:,is) = rmxtrc(is) *dF_hsr(:,is) + ( rhoo_hsr(:,is) - FF_hsr(:,is) )
@@ -2763,42 +2717,27 @@
call mult1s(dF_l,dF_l,f_p,fff)
-! ======================================= modified by K. Tagami =========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ========================================================================= 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
fff(is) = fff(is) + sum( dF_hsr(:,is)*dF_hsr(:,is) )
end do
if(sum(fff) < 1.d-40) call phase_error_with_msg(nfout,' fmult is too small',__LINE__,__FILE__)
-!!!!!!!!
-! === DEBUG by tkato 2011/11/24 ================================================
-! if ( nspin == 2 .and. sw_mix_bothspins_sametime == YES ) then
- if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then
-! ==============================================================================
+ if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then ! if ( nspin == 2 .and. ...) then ! === DEBUG by tkato 2011/11/24 ===
fff(1) = fff(1) + fff(2)
fff(2) = fff(1)
endif
-! ========================= added by K. Tagami =========================== 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
fff(1) = sum( fff(:) )
fff(:) = fff(1)
endif
-! ======================================================================== 11.0
-! ========================================= modified by K. Tagami ========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
v_l(:,:,is) = dF_l(:,:,is)/fff(is)
end do
-! ========================================= modified by K. Tagami ========== 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =========================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do i=1,nsize_rho_hsr
v_hsr(i,is) = dF_hsr(i,is)/fff(is)
end do
@@ -2813,13 +2752,9 @@
real(DP),intent(in) :: rmx
integer :: iter,j,mxiter,icr,jcr
real(DP), pointer, dimension(:,:,:) :: F_l
-! === DEBUG by tkato 2011/11/24 ================================================
- real(DP) :: udF(nspin_m),wdF(nspin_m)
-! ==============================================================================
-! --> T. Yamasaki 03 Aug. 2009
+ real(DP) :: udF(nspin_m),wdF(nspin_m) ! === DEBUG by tkato 2011/11/24 ===
real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
-! real(kind=DP), allocatable, dimension(:,:,:) :: chgqstore_l, chgqostore_l
-! <--
+
integer :: id_sname = -1
__TIMER_SUB_START(1126)
call tstatc0_begin('m_CD_mix_DFP ',id_sname,1)
@@ -2830,40 +2765,23 @@
call mix_DFP_allocate(); F_l => din
end if
-! ==================================== modified by K. Tagami ============= 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc(1:nspin_m) = rmx
-! end if
-!! <--
-!
allocate(rmxtrc(nspin_m))
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc(1:nspin_m) = rmx
rmxtrc(2:nspin_m) = min( rmx *spin_density_mixfactor, rmx_max )
else
+ ! --> T. Yamasaki 03 Aug. 2009
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
else
rmxtrc(1:nspin_m) = rmx
- end if
+ end if ! <--
endif
-! ========================================================================= 11.0
-! ============================= Modified by K. Tagami ================
-! allocate(c_p(kgp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
- allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0.0d0
-!!$ allocate(c_p(kgp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
-! ====================================================================
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0.0d0 ! allocate(c_p(kgp)) ! === Modified by K. Tagami ===
call precon_4_charge_mix(rmxtrc,c_p)
-
iter = iter_from_reset() !-(m_CD)
if((iter-istrbr+1) <= 1) then
@@ -2896,27 +2814,15 @@
call mix_DFP_dealloc2 !-(m_CD)
endif
-! ================================== modified by K. Tagami ============== 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) &
-! & call compose_chgq_dealloc_chgqstore()
-! deallocate(rmxtrc)
-!! <--
-
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
+ !! --> T. Yamasaki 03 Aug. 2009
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) &
& call compose_chgq_dealloc_chgqstore()
- endif
+ endif !! <--
deallocate(rmxtrc)
-! ========================================================================= 11.0
if(af /= 0) then
-!xx allocate(work(kgp,kimg))
-! ================================================ Added by K. Tagami ========
-!xx work = 0
-! =========================================================================
call charge_average_3D(ANTIFERRO,chgq_l)
-!xx deallocate(work)
endif
deallocate(c_p)
@@ -2932,11 +2838,8 @@
integer :: is,k,i
__TIMER_SUB_START(1127)
__TIMER_DO_START(1177)
-! =============================== modified by K. Tagami ================ 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! ======================================================================== 11.0
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
do k = 1, kimg
do i = ista_kgpm,iend_kgpm
! Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
@@ -2956,10 +2859,8 @@
subroutine renew_w(j)
integer :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: y_dF(nspin),v_dF(nspin)
- real(DP) :: y_dF(nspin_m),v_dF(nspin_m)
-! ==============================================================================
+
+ real(DP) :: y_dF(nspin_m),v_dF(nspin_m) ! real(DP) :: y_dF(nspin),v_dF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1128)
#ifdef _CDMIX_USE_POINTER_
@@ -2986,12 +2887,8 @@
subroutine renew_d(j)
integer :: j
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: yF(nspin),vF(nspin)
- real(DP) :: yF(nspin_m),vF(nspin_m)
-! ==============================================================================
+ real(DP) :: yF(nspin_m),vF(nspin_m) ! real(DP) :: yF(nspin),vF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1129)
-
#ifdef _CDMIX_USE_POINTER_
urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iY)
call mult1s(urec_l_3,F_l,f_p,yF) !-(m_CD);<y(j)|F(m)> ->yF
@@ -3014,16 +2911,11 @@
end subroutine renew_d
subroutine renew_d_last(udF,wdF)
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP),intent(in) :: udF(nspin),wdF(nspin)
- real(DP),intent(in) :: udF(nspin_m),wdF(nspin_m)
-! ==============================================================================
+
+ real(DP),intent(in) :: udF(nspin_m),wdF(nspin_m) ! :: udF(nspin),wdF(nspin) ! === DEBUG by tkato 2011/11/24 ===
integer :: is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: uF(nspin),wF(nspin)
- real(DP) :: uF(nspin_m),wF(nspin_m)
-! ==============================================================================
+ real(DP) :: uF(nspin_m),wF(nspin_m) ! :: uF(nspin),wF(nspin) ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1130)
call mult1s(F_l,u_l,f_p,uF) ! ->uF = <u(m)|F(m)>
@@ -3035,10 +2927,8 @@
din = rhoo
dout = rho
__TIMER_DO_START(1178)
-! =================================== modified by K. Tagami ========= 11.0
-! do is = 1, nspin, af+1
- do is = 1, ndim_magmom, af+1
-! =================================================================== 11.0
+
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
rho(:,:,is) = d0_l(:,:,is)-uF(is)*u_l(:,:,is)-wF(is)*w_l(:,:,is)
enddo
__TIMER_DO_STOP(1178)
@@ -3053,22 +2943,15 @@
end subroutine m_CD_mix_DFP
subroutine mix_pulay_allocate
-!!$ if(allocated(f_p)) return
-! =============================== modified by K. Tagami ========== 11.0
-! nspin_m = nspin/(af+1)
-!
- if ( noncol ) then
- nspin_m = ndim_magmom
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
+ nspin_m = ndim_magmom ! nspin_m = nspin/(af+1)
else
nspin_m = nspin/(af+1)
endif
-! ================================================================= 11.0
-! =========================================== Modified by K. Tagami =========
-! allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_CD)
- allocate(f_p(ista_kgpm:iend_kgpm)); f_p = 0; call precon_4_mult(f_p) !-(m_CD)
-! ============================================================================
+ allocate(f_p(ista_kgpm:iend_kgpm)); f_p = 0 ! allocate(f_p(ista_kgpm:iend_kgpm)) ! === Modified by K. Tagami ===
+ call precon_4_mult(f_p) !-(m_CD)
allocate(din(ista_kgpm:iend_kgpm,kimg,nspin_m))
allocate(dout(ista_kgpm:iend_kgpm,kimg,nspin_m))
@@ -3089,10 +2972,9 @@
endif
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; prj_wk = 0.0d0; ncrspd = 0
-! ======================================================================
+
+ din = 0.0d0; dout = 0.0d0; urec_l = 0.0d0; uuf_p = 0.0d0; f = 0.0d0 ! === Added by K. Tagami ===
+ g_p = 0.0d0; prj_wk = 0.0d0; ncrspd = 0 ! === Added by K. Tagami ===
end subroutine mix_pulay_allocate
subroutine mix_pulay_deallocate
@@ -3115,9 +2997,7 @@
subroutine mix_pulay_alloc2
allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
-! =========================================== Added by K. Tagami ========
- d0_l = 0.0d0
-! =======================================================================
+ d0_l = 0.0d0 ! === Added by K. Tagami ===
call alloc_rho_rhoo_and_cpm
end subroutine mix_pulay_alloc2
@@ -3133,10 +3013,8 @@
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
__TIMER_SUB_START(1131)
@@ -3148,28 +3026,18 @@
call mix_pulay_allocate()
end if
-! ============================= modified by K. Tagami ================== 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! allocate(rmxtrc(nspin_m))
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
-! call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
-! else
-! rmxtrc(1:nspin_m) = rmx
-! end if
-!! <--
-!
allocate(rmxtrc(nspin_m))
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc(1:nspin_m) = rmx
rmxtrc(2:nspin_m) = min( rmx *spin_density_mixfactor, rmx_max )
else
+ !! --> T. Yamasaki 03 Aug. 2009
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
call alloc_chgqstore_recompose_chgq(rmx,rmxtrc) ! --> chgq_l, chgqo_l, rmxtrc
else
rmxtrc(1:nspin_m) = rmx
end if
- endif
-! ========================================================================= 11.0
+ endif !! <--
if(sw_control_stepsize==ON)then
rmxtt = rmx*step_control_factor
@@ -3179,16 +3047,10 @@
if(printable) write(nfout,'(a,f10.5)') 'step size for the current iteration : ',rmxtt
endif
-! ====================================== Modified by K. Tagami =========
-! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
- allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-! ========================================================================
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0 ! allocate(c_p(ista_kngp:iend_kngp)); ! === Modified by K. Tagami ===
call precon_4_charge_mix(rmxtrc,c_p)
-
iter = iter_from_reset() !-(m_CD)
if((iter-istrbr+1) <= 1) then
call simple_mix1(c_p) !-(m_CD)
@@ -3223,27 +3085,15 @@
call mix_pulay_dealloc2 !-(m_CD)
endif
-! ============================== modified by K. Tagami =================== 11.0
-!! --> T. Yamasaki 03 Aug. 2009
-! if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) &
-! & call compose_chgq_dealloc_chgqstore()
-! deallocate(rmxtrc)
-!! <--
-!
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
+ !! --> T. Yamasaki 03 Aug. 2009
if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) &
& call compose_chgq_dealloc_chgqstore()
- endif
+ endif !! <--
deallocate(rmxtrc)
-! ========================================================================= 11.0
if(af /= 0) then
-!xx allocate(work(kgp,kimg))
-! ==================================================== Added by K. Tagami ===
-!xx work = 0
-! ==========================================================================
call charge_average_3D(ANTIFERRO,chgq_l)
-!xx deallocate(work)
endif
deallocate(c_p)
@@ -3255,9 +3105,7 @@
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
-! =====================================================================
+ e_wk = 0; f_wk = 0; ww1 = 0; finv = 0; ip = 0 ! === Added by K. Tagami ===
end subroutine mix_pulay_alloc3
subroutine set_ncrspd_mxiter(n,iter,m)
@@ -3385,10 +3233,8 @@
subroutine Ri_dot_Rj(n)
integer, intent(in) :: n
integer :: it,jt,itc,jtc
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: ff1(nspin),ff1tmp
- real(DP) :: ff1(nspin_m),ff1tmp
-! ==============================================================================
+
+ real(DP) :: ff1(nspin_m),ff1tmp ! real(DP) :: ff1(nspin),ff1tmp ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1133)
__TIMER_DO_START(1179)
do it = 1, n
@@ -3407,15 +3253,12 @@
call mult1s10(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1) ! <delta F^i|delta F^j>
endif
-! ============================= added by K. Tagami ======================= 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
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
-! ======================================================================== 11.0
-
#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)
@@ -3428,10 +3271,8 @@
subroutine Rj_dot_d(n)
integer, intent(in) :: n
integer :: jt, jtc
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: ff1(nspin),ff1tmp
- real(DP) :: ff1(nspin_m),ff1tmp
-! ==============================================================================
+
+ real(DP) :: ff1(nspin_m),ff1tmp ! real(DP) :: ff1(nspin),ff1tmp ! === DEBUG by tkato 2011/11/24 ===
__TIMER_SUB_START(1138)
do jt = 1, n
jtc = ncrspd(jt)
@@ -3446,12 +3287,10 @@
call mult1s5(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1)
endif
-! ============================= added by K. Tagami ======================= 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
ff1(:) = ff1tmp
endif
-! ======================================================================== 11.0
#endif
uuf_p(jt,1:nspin_m) = ff1(1:nspin_m)
@@ -3469,11 +3308,9 @@
nnspin = nspin
if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1
-! ======================= added by K. Tagami ============= 11.0
- if ( noncol ) then
+ if ( noncol ) then ! === added by K. Tagami === 11.0
nnspin = 1
end if
-! ======================================================== 11.0
do is=1,nnspin
if(ipripulay >= 2) then
@@ -3513,15 +3350,14 @@
enddo
enddo
endif
-! ============================== added by K. Tagami ========== 11.0
- if ( noncol ) then
+
+ if ( noncol ) then ! === added by K. Tagami === 11.0
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
@@ -3539,10 +3375,7 @@
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
+ do is = 1, ndim_magmom, af+1 ! do is = 1, nspin, af+1 ! === modified by K. Tagami === 11.0
div = 1.d0/f(1,1,is)
icount = 1
__TIMER_DO_START(1180)
@@ -3590,9 +3423,8 @@
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
+
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
g_p = 0.d0
do is = 1, nnspin
@@ -3613,14 +3445,12 @@
g_p(it,2) = g_p(it,1)
enddo
endif
-! ============================== added by K. Tagami ============ 11.0
- if ( noncol ) then
+
+ if ( noncol ) then ! === added by K. Tagami === 11.0
do it = 1,n
g_p(it,:) = g_p(it,1)
enddo
endif
-! ============================================================== 11.0
-
__TIMER_SUB_STOP(1139)
end subroutine get_gmatrix
@@ -3629,10 +3459,8 @@
real(DP),intent(in),dimension(ista_kgpm:iend_kgpm,nspin_m) :: p
integer :: is, k, i, it, itc, ns
__TIMER_SUB_START(1140)
-
-!!$ do is = 1, nspin, af+1
ns = nspin_for_qnewton()
- do is = 1, ns,af+1
+ do is = 1, ns,af+1 ! do is = 1, nspin, af+1
do k = 1, kimg
__TIMER_DO_START(1189)
do i = ista_kngp, iend_kngp
@@ -3651,15 +3479,11 @@
end do
end do
-! ============================== modified by K. Tagami ================ 11.0
-! if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) call simple_mix2(c_p)
-!
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) then
call simple_mix2(c_p)
endif
endif
-! ===================================================================== 11.0
if(kgpm < kgp) then
call concentrate_d_to_chg(rho,chgq_l) !-(m_C.D.)
@@ -3771,16 +3595,10 @@
if(printable) write(nfout,'(a,f10.5)') 'step size for the current iteration : ',rmxtt
endif
-! ====================================== Modified by K. Tagami =========
-! allocate(c_p(ista_kngp:iend_kngp)); call precon_4_charge_mix(rmx,c_p)
-! --> T. Yamasaki, 03rd Aug. 2009
-!!$ allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_charge_mix(rmx,c_p)
- allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
-! ========================================================================
+ allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0 ! allocate(c_p(ista_kngp:iend_kngp)) ! === Modified by K. Tagami ===
call precon_4_charge_mix(rmxtrc,c_p)
-
iter = iter_from_reset() !-(m_CD)
if(iter.eq.1) then
alpha_pulay = alpha_pulay_org
@@ -4012,10 +3830,9 @@
subroutine Ri_dot_Rj_with_hsr(n)
integer, intent(in) :: n
integer :: it,jt,itc,jtc,is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: ff1(nspin),ff2(nspin),ff1tmp
- real(DP) :: ff1(nspin_m),ff2(nspin_m),ff1tmp
-! ==============================================================================
+
+ real(DP) :: ff1(nspin_m),ff2(nspin_m),ff1tmp ! real(DP) :: ff1(nspin),ff2(nspin),ff1tmp ! === DEBUG by tkato 2011/11/24 ===
+ real(DP) :: ff0(nspin_m)
do it = 1, n
itc = ncrspd(it)
do jt = it, n
@@ -4028,25 +3845,39 @@
if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
ff1tmp=0.d0
call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp) ! <delta F^i|delta F^j>
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,nspin_m,af+1
ff1tmp = ff1tmp+sum(urec_hsr(:,is,itc,iResid) * urec_hsr(:,is,jtc,iResid))
enddo
+#else
+ ff0 = 0.d0
+ call mult_urec_urec(nfout,itc,jtc,iResid, ff0)
+ ff1tmp = ff1tmp + ff0(1) + ff0(2)
+#endif
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>
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,nspin_m,(af+1)
ff1(is) = ff1(is)+sum(urec_hsr(:,is,itc,iResid) * urec_hsr(:,is,jtc,iResid))
enddo
+#else
+ call mult_urec_urec(nfout,itc,jtc,iResid, ff1)
+#endif
endif
! ============================= added by K. Tagami ======================= 11.0
if ( noncol ) then
ff1tmp=0.d0
call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp) ! <delta F^i|delta F^j>
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,ndim_magmom
ff1tmp = ff1tmp+sum(urec_hsr(:,is,itc,iResid) * urec_hsr(:,is,jtc,iResid))
enddo
+#else
+ call mult_urec_urec(nfout,itc,jtc,iResid, ff1)
+#endif
ff1(:) = ff1tmp
endif
! ======================================================================== 11.0
@@ -4060,10 +3891,8 @@
subroutine Rj_dot_d_with_hsr(n)
integer, intent(in) :: n
integer :: jt, jtc, is
-! === DEBUG by tkato 2011/11/24 ================================================
-! real(DP) :: ff1(nspin),ff2(nspin)
- real(DP) :: ff1(nspin_m),ff2(nspin_m)
-! ==============================================================================
+ real(DP) :: ff1(nspin_m),ff2(nspin_m) ! real(DP) :: ff1(nspin),ff2(nspin) ! === DEBUG by tkato 2011/11/24 ===
+ real(DP) :: ff0(nspin_m)
real(DP) :: ff1tmp
do jt = 1, n
jtc = ncrspd(jt)
@@ -4074,16 +3903,26 @@
if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
ff1tmp=0.d0
call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,nspin_m,af+1
ff1tmp = ff1tmp+sum(urec_hsr(:,is,jtc,iResid) * d0_hsr(:,is))
enddo
+#else
+ ff0 = 0.d0
+ call mult_urec_hsr_urec_d0(nfout,jtc,iResid,ff0)
+ ff1tmp = ff1tmp + ff0(1)+ ff0(2)
+#endif
ff1(1) = ff1tmp;ff1(2) = ff1tmp
else
call mult1s5(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1)
ff2=0.d0
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,nspin_m,af+1
ff2(is) = ff2(is)+sum(urec_hsr(:,is,jtc,iResid) * d0_hsr(:,is))
enddo
+#else
+ call mult_urec_hsr_urec_d0(nfout,jtc,iResid,ff2)
+#endif
ff1(:) = ff1(:)+ff2(:)
endif
@@ -4091,9 +3930,15 @@
if ( noncol ) then
ff1tmp=0.d0
call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,ndim_magmom
ff1tmp = ff1tmp+sum(urec_hsr(:,is,jtc,iResid) * d0_hsr(:,is))
enddo
+#else
+ ff0 = 0.d0
+ call mult_urec_hsr_urec_d0(nfout,jtc,iResid,ff0)
+ ff1tmp = sum(ff0(:))
+#endif
ff1(:) = ff1tmp
endif
! ================================================================ 11.0
@@ -4113,9 +3958,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
do is=1,nnspin
if(ipripulay >= 2) then
@@ -4174,9 +4017,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
g_p = 0.d0
do is = 1, nnspin
@@ -4209,9 +4050,8 @@
real(DP),intent(in),dimension(ista_kgpm:iend_kgpm,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 is = 1, ns,af+1 ! do is = 1, nspin, af+1
do k = 1, kimg
do i = ista_kngp, iend_kngp
rho(i,k,is) = rhoo(i,k,is) + p(i,is)*d0_l(i,k,is)
@@ -4659,25 +4499,15 @@
integer :: is
-! =============================== modified by K.Tagami ================ 11.0
-! nspin_m = nspin/(af+1)
- if ( noncol ) then
+ if ( noncol ) then ! nspin_m = nspin/(af+1) ! === modified by K.Tagami === 11.0
nspin_m = ndim_magmom
else
nspin_m = nspin/(af+1)
endif
-! ====================================================================== 11.0
allocate( rmxtrc(nspin_m) )
-! ============================= modified by K. Tagami =============== 11.0
-! if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
-! call alloc_hsrstore_recomp( rmxt, rmxtrc )
-! else
-! rmxtrc = rmxt
-! endif
-
- if ( noncol ) then
+ if ( noncol ) then ! === modified by K. Tagami === 11.0
rmxtrc = rmxt
rmxtrc(2:nspin_m) = min( rmxt *spin_density_mixfactor, rmx_max )
else
@@ -4687,35 +4517,24 @@
rmxtrc = rmxt
endif
end if
-! ==================================================================== 11.0
-! ====================== modified by K. Tagami ================ 11.0
-! Do is=1, nspin, af+1
- Do is=1, ndim_magmom, af+1
-! ============================================================= 11.0
+ Do is=1, ndim_magmom, af+1 ! Do is=1, nspin, af+1 ! === modified by K. Tagami === 11.0
hsr(:,:,:,is) = rmxtrc(is) *hsr(:,:,:,is) &
& + ( 1.d0-rmxtrc(is) )*hsro(:,:,:,is)
End do
-! ================================= added by K. Tagami ============= 11.0
- if ( noncol .and. sw_mix_imaginary_hardpart == ON ) then
+ if ( noncol .and. sw_mix_imaginary_hardpart == ON ) then ! === added by K. Tagami === 11.0
Do is=1, ndim_magmom
hsi(:,:,:,is) = rmxtrc(is) *hsi(:,:,:,is) &
& + ( 1.d0-rmxtrc(is) )*hsio(:,:,:,is)
End do
endif
-! ================================================================== 11.0
-! ================================= modified by K. Tagami ============= 11.0
-! if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
-! call compose_hsr_dealloc_store
-! end if
- if ( .not. noncol ) then
+ if ( .not. noncol ) then ! === modified by K. Tagami === 11.0
if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2) then
call compose_hsr_dealloc_store
end if
endif
-! ===================================================================== 11.0
deallocate(rmxtrc)
end subroutine m_CD_simple_mixing_hard
@@ -6023,6 +5842,9 @@
integer :: it,jt,itc,jtc,is
real(DP) :: ff1(nspin_m),ff2(nspin_m),ff1tmp, ff2tmp
+#ifndef _DUPLICATION_HSR_DOTPRODUCT_
+ real(DP) :: ff0(ndim_magmom)
+#endif
do it = 1, n
itc = ncrspd(it)
@@ -6035,16 +5857,22 @@
& urec_l, jtc, iResid, f_p, ff1tmp )
! <delta F^i|delta F^j>
if ( sw_mix_charge_hardpart == ON ) then
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,nspin_m,af+1
ff1tmp = ff1tmp + sum( urec_hsr(:,is,itc,iResid) &
- & *urec_hsr(:,is,jtc,iResid) )
+ & * urec_hsr(:,is,jtc,iResid) )
enddo
+#else
+ ff0 = 0.d0
+ call mult_urec_urec(nfout,itc,jtc,iResid, ff0)
+ ff1tmp = ff1tmp + ff0(1); if(nspin_m==2 .and. af==0) ff1tmp = ff1tmp + ff0(2)
+#endif
endif
if ( sw_mix_charge_with_ekindens == ON ) then
call mult1s10_reduce_spin( urec_l_ekinq, nbxmix, 2, itc, iResid, &
& urec_l_ekinq, jtc, iResid, f_p_ekinq, &
& ff2tmp )
- ff1tmp = ff1tmp +ff2tmp
+ ff1tmp = ff1tmp + ff2tmp
endif
ff1(1) = ff1tmp; ff1(2) = ff1tmp
@@ -6053,10 +5881,14 @@
call mult1s10( urec_l, nbxmix, 2, itc, iResid, &
& urec_l, jtc, iResid, f_p, ff1 ) ! <delta F^i|delta F^j>
if ( sw_mix_charge_hardpart == ON ) then
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,nspin_m,(af+1)
ff1(is) = ff1(is) +sum( urec_hsr(:,is,itc,iResid) &
- & * urec_hsr(:,is,jtc,iResid) )
+ & * urec_hsr(:,is,jtc,iResid) )
enddo
+#else
+ call mult_urec_urec(nfout,itc,jtc,iResid, ff1)
+#endif
endif
if ( sw_mix_charge_with_ekindens == ON ) then
call mult1s10( urec_l_ekinq, nbxmix, 2, itc, iResid, &
@@ -6071,10 +5903,16 @@
& urec_l, jtc, iResid, f_p, ff1tmp )
! <delta F^i|delta F^j>
if ( sw_mix_charge_hardpart == ON ) then
+#ifdef _DUPLICATION_HSR_DOTPRODUCT_
do is=1,ndim_magmom
ff1tmp = ff1tmp +sum( urec_hsr(:,is,itc,iResid) &
& *urec_hsr(:,is,jtc,iResid) )
enddo
+#else
+ ff0 = 0.d0
+ call mult_urec_urec(nfout,itc,jtc,iResid, ff0)
+ ff1tmp = ff1tmp + sum(ff0(:))
+#endif
endif
if ( sw_mix_charge_with_ekindens == ON ) then
call mult1s10_reduce_spin( urec_l_ekinq, nbxmix, 2, itc, iResid, &
@@ -6171,9 +6009,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
do is=1,nnspin
if(ipripulay >= 2) then
@@ -6232,9 +6068,7 @@
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
+ if ( noncol ) nnspin = 1 ! === added by K. Tagami === 11.0
g_p = 0.d0
do is = 1, nnspin
@@ -6270,9 +6104,8 @@
integer :: is, k, i, it, itc, ns
-!!$ do is = 1, nspin, af+1
ns = nspin_for_qnewton()
- do is = 1, ns,af+1
+ do is = 1, ns,af+1 ! do is = 1, nspin, af+1
do k = 1, kimg
do i = ista_kngp, iend_kngp
rho(i,k,is) = rhoo(i,k,is) + p(i,is)*d0_l(i,k,is)
diff -ruN phase0_2023.01/src_phase_3d/m_CLS_dipquad.F90 phase0_2023.01.01/src_phase_3d/m_CLS_dipquad.F90
--- phase0_2023.01/src_phase_3d/m_CLS_dipquad.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_CLS_dipquad.F90 2023-11-09 12:02:33.699110444 +0900
@@ -455,9 +455,9 @@
fac1 = PAI4 *PAI ! latter : i pi delta
- Spectr_E1_E1 = Spectr_E1_E1 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E2_E2 = Spectr_E2_E2 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E1_E2 = Spectr_E1_E2 /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E1(:) = Spectr_E1_E1(:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E2_E2(:) = Spectr_E2_E2(:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E2(:) = Spectr_E1_E2(:) /dble(kv3_fbz/nspin) /univol *fac1
if ( nspin == 1 ) then
Spectr_E1_E1 = Spectr_E1_E1 *2.0d0
Spectr_E2_E2 = Spectr_E2_E2 *2.0d0
@@ -693,9 +693,9 @@
fac1 = PAI4 *PAI ! latter : i pi delta
- Spectr_E1_E1 = Spectr_E1_E1 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E2_E2 = Spectr_E2_E2 /dble(kv3_fbz/nspin) /univol *fac1
- Spectr_E1_E2 = Spectr_E1_E2 /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E1(:,:) = Spectr_E1_E1(:,:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E2_E2(:,:) = Spectr_E2_E2(:,:) /dble(kv3_fbz/nspin) /univol *fac1
+ Spectr_E1_E2(:,:) = Spectr_E1_E2(:,:) /dble(kv3_fbz/nspin) /univol *fac1
if ( nspin == 1 ) then
Spectr_E1_E1 = Spectr_E1_E1 *2.0d0
Spectr_E2_E2 = Spectr_E2_E2 *2.0d0
diff -ruN phase0_2023.01/src_phase_3d/m_Control_Parameters.F90 phase0_2023.01.01/src_phase_3d/m_Control_Parameters.F90
--- phase0_2023.01/src_phase_3d/m_Control_Parameters.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Control_Parameters.F90 2023-11-09 12:02:33.686110375 +0900
@@ -8950,6 +8950,8 @@
charge_mixing(1)%rmxe = charge_mixing(1)%rmxs
if(printable) write(nfout,'(a)') ' !** applied charge-mixing method : simple'
end if
+ if(printable) write(nfout,'(" !** sw_mix_bothspins_sametime = ",i3," <<configuration_charge_mixing>>")') &
+ sw_mix_bothspins_sametime
end subroutine configure_charge_mixing
end subroutine m_CtrlP_rd_chargemix
@@ -9193,6 +9195,8 @@
! --- spin density ---
if( f_selectBlock(tag_spin_density)==0)then
+ if(ipriinputfile >= 1 .and. printable ) &
+ & write(nfout,'(" !** tag_spin_density is found")')
call m_CtrlP_rd_val(nfout, tag_spin_density_mixfactor, '', &
& spin_density_mixfactor, rr)
call m_CtrlP_rd_val(nfout, tag_sw_apply_precon,sw_precon_diff,rr)
@@ -9205,13 +9209,16 @@
& sw_mix_bothspins_sametime, rr, done_something)
if ( done_something ) then
if(.not. rr) write(nfout,*) '!** sw_mix_bothspins_sametime is set to ', &
- & sw_mix_bothspins_sametime
+ & sw_mix_bothspins_sametime
else
if(.not.rr) write(nfout,*) '!** sw_mix_bothspins_sametime is set to default, ', &
- & sw_mix_bothspins_sametime
+ & sw_mix_bothspins_sametime
endif
! ====================================================================== 5.0
iret = f_selectParentBlock()
+ else
+ if(ipriinputfile >= 1 .and. printable ) &
+ & write(nfout,'(" !** tag_spin_density is not found")')
endif
! ================ KT_add ======================== 13.0U2
diff -ruN phase0_2023.01/src_phase_3d/m_Crystal_Structure.F90 phase0_2023.01.01/src_phase_3d/m_Crystal_Structure.F90
--- phase0_2023.01/src_phase_3d/m_Crystal_Structure.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Crystal_Structure.F90 2023-11-09 12:02:33.702110460 +0900
@@ -920,7 +920,7 @@
call m_CS_gnrt_tmatrices(il)
if ( sw_strained_cell == OFF ) then
- if(is_hexagonal(ca,cb,cc).and. il==1 .and. symmetry_method == AUTOMATIC) then
+ if(is_hexagonal(a,b,ca,cb,cc).and. il==1 .and. symmetry_method == AUTOMATIC) then
if(printable) then
write(nfout,'(" !** lattice_system is converted to hexagonal")')
endif
diff -ruN phase0_2023.01/src_phase_3d/m_ES_ExactExchange.F90 phase0_2023.01.01/src_phase_3d/m_ES_ExactExchange.F90
--- phase0_2023.01/src_phase_3d/m_ES_ExactExchange.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_ES_ExactExchange.F90 2023-11-09 12:02:33.653110203 +0900
@@ -1988,12 +1988,24 @@
real(kind=DP), allocatable, dimension(:,:,:) :: vexx
real(kind=DP) :: exx
integer :: ng
+ integer :: npprev
+ real(kind=DP), allocatable, dimension(:,:,:,:) :: exx_potential_buf
integer,save :: id_sname = -1
iup = 2
if(present(iupdate)) iup = iupdate
store_e = .true.
if(present(store_exxp)) store_e = store_exxp
call tstatc0_begin('m_ES_Vexx_W ',id_sname,level=1)
+ if(allocated(exx_potential)) then
+ npprev = size(exx_potential, 1)
+ if (npprev<maxval(np_g1k)) then
+ allocate(exx_potential_buf(npprev, np_e, ista_k:iend_k, kimg))
+ exx_potential_buf = exx_potential
+ deallocate(exx_potential)
+ allocate(exx_potential(maxval(np_g1k),np_e,ista_k:iend_k,kimg))
+ exx_potential(1:npprev, np_e, ista_k:iend_k, kimg) = exx_potential_buf(1:npprev, np_e, ista_k:iend_k, kimg)
+ endif
+ endif
ispin = mod(ik-1,nspin)+1
@@ -2589,6 +2601,7 @@
real(kind=DP) :: ifac
logical :: eo
integer :: iadd
+ integer :: ikk
integer,save :: id_sname = -1,id_sname1=-2,id_sname2=-3,id_sname3=-4
integer,save :: id_sname_cdfft=-1
call tstatc0_begin('apply_Vx_to_WF ',id_sname)
@@ -2654,13 +2667,14 @@
call m_FFT_WF(ELECTRON,nfout,wfn,INVERSE,OFF) ! wfn(R)
#endif
+ ikk = k_index(ik)
sumdel = 0.d0
do jkbz=1,kv3bz
- if(.not.q_on_k_centered_mesh(jkbz,ik)) cycle
+ if(.not.q_on_k_centered_mesh(jkbz,ikk)) cycle
#ifdef MEMORY_SAVE_EXX
- call m_ES_EXX_ylm_each_k(iqmk(jkbz,ik))
+ call m_ES_EXX_ylm_each_k(iqmk(jkbz,ikk))
#ifdef MEMORY_SAVE_MORE_EXX
- call qitgft_qmk_each_k(iqmk(jkbz,ik))
+ call qitgft_qmk_each_k(iqmk(jkbz,ikk))
#endif
#endif
! q(bz) = S*k(ibz)
@@ -2729,7 +2743,7 @@
if(kimg==1) then
call map_FFT_box_on_RHOG(rhogr,rhogr,rho)
do ii=1,nmax_G_hyb
- rhogr(ii) = vc(ii,iqmk(jkbz,ik)) * rhogr(ii) ! phi(G) = Vc(G,q) * rho(G)
+ rhogr(ii) = vc(ii,iqmk(jkbz,ikk)) * rhogr(ii) ! phi(G) = Vc(G,q) * rho(G)
end do
call map_RHOG_on_FFT_box(rhogr,rhogr,phi)
else
@@ -2752,9 +2766,9 @@
endif
if(sw_rspace_hyb==ON)then
if(sw_precalculate==OFF)then
- call add_RHOG_hard_part_rs(iqmk(jkbz,ik),rhor,rhoi,bdwr,bdwi,fsr,fsi)
+ call add_RHOG_hard_part_rs(iqmk(jkbz,ikk),rhor,rhoi,bdwr,bdwi,fsr,fsi)
else
- call add_RHOG_hard_part_rs2(iqmk(jkbz,ik),rhor,rhoi,&
+ call add_RHOG_hard_part_rs2(iqmk(jkbz,ikk),rhor,rhoi,&
& fsrqm(:,:,m,jkbz,ispin),fsiqm(:,:,m,jkbz,ispin),bdwr,bdwi)
endif
call map_RHOG_on_FFT_box_hard(rhor,rhoi,afft)
@@ -2765,18 +2779,18 @@
rhogi(ii) = rhogi(ii) + rhoi(ii)
end do
else
- call add_RHOG_hard_part_2D(iqmk(jkbz,ik),rhogr,rhogi,bdwr,bdwi,fsr,fsi)
+ call add_RHOG_hard_part_2D(iqmk(jkbz,ikk),rhogr,rhogi,bdwr,bdwi,fsr,fsi)
endif
end if
if(present(eexx))then
exx = 0.d0
- call sum_rho_vc_rho_2D(rhogr,rhogi,vc(1,iqmk(jkbz,ik)),exx)
+ call sum_rho_vc_rho_2D(rhogr,rhogi,vc(1,iqmk(jkbz,ikk)),exx)
eexx = eexx + occupation * exx
if(eo) cycle
endif
do ii=1,nmax_G_hyb
- rhogr(ii) = vc(ii,iqmk(jkbz,ik)) * rhogr(ii) ! phi(G) = Vc(G,q) * rho(G)
- rhogi(ii) = vc(ii,iqmk(jkbz,ik)) * rhogi(ii) ! phi(G) = Vc(G,q) * rho(G)
+ rhogr(ii) = vc(ii,iqmk(jkbz,ikk)) * rhogr(ii) ! phi(G) = Vc(G,q) * rho(G)
+ rhogi(ii) = vc(ii,iqmk(jkbz,ikk)) * rhogi(ii) ! phi(G) = Vc(G,q) * rho(G)
end do
!! Dij[Vnm] = Sum_G Qij(G) * Vnm(G)
!! Hi[Vnm] = Sum_j Dij[Vnm] <beta_j|psi_m>
@@ -2787,20 +2801,20 @@
call m_FFT_CD0_exx(nfout,afft,INVERSE)
call map_FFT_box_on_RHOG_hard_inv(rhor,rhoi,afft)
if(force_mode)then
- call integrate_QijVnm_rs(iqmk(jkbz,ik),rhor,rhoi,fsr,fsi,qvr,qvi,dfsr,dfsi,dqvr,dqvi,gqvr,gqvi)
+ call integrate_QijVnm_rs(iqmk(jkbz,ikk),rhor,rhoi,fsr,fsi,qvr,qvi,dfsr,dfsi,dqvr,dqvi,gqvr,gqvi)
else
if(sw_precalculate==OFF)then
- call integrate_QijVnm_rs(iqmk(jkbz,ik),rhor,rhoi,fsr,fsi,qvr,qvi)
+ call integrate_QijVnm_rs(iqmk(jkbz,ikk),rhor,rhoi,fsr,fsi,qvr,qvi)
else
- call integrate_QijVnm_rs2(iqmk(jkbz,ik),rhor,rhoi, &
+ call integrate_QijVnm_rs2(iqmk(jkbz,ikk),rhor,rhoi, &
& fsrqm(:,:,m,jkbz,ispin),fsiqm(:,:,m,jkbz,ispin),qvr,qvi)
endif
endif
else
if(force_mode)then
- call integrate_QijVnm_2D(iqmk(jkbz,ik),rhogr,rhogi,fsr,fsi,qvr,qvi,dfsr,dfsi,dqvr,dqvi,gqvr,gqvi)
+ call integrate_QijVnm_2D(iqmk(jkbz,ikk),rhogr,rhogi,fsr,fsi,qvr,qvi,dfsr,dfsi,dqvr,dqvi,gqvr,gqvi)
else
- call integrate_QijVnm_2D(iqmk(jkbz,ik),rhogr,rhogi,fsr,fsi,qvr,qvi)
+ call integrate_QijVnm_2D(iqmk(jkbz,ikk),rhogr,rhogi,fsr,fsi,qvr,qvi)
endif
endif
endif
@@ -2952,6 +2966,7 @@
real(kind=DP) :: ifac
logical :: eo
integer :: iadd
+ integer :: ikk
integer,save :: id_sname = -1,id_sname1=-2,id_sname2=-3,id_sname3=-4
integer,save :: id_sname_cdfft=-1,id_sname_cdfft2=-1,id_sname_cdfft3=-1
call tstatc0_begin('apply_Vx_to_WF ',id_sname)
@@ -3022,12 +3037,13 @@
#endif
sumdel = 0.d0
+ ikk = k_index(ik)
do jkbz=1,kv3bz
- if(.not.q_on_k_centered_mesh(jkbz,ik)) cycle
+ if(.not.q_on_k_centered_mesh(jkbz,ikk)) cycle
#ifdef MEMORY_SAVE_EXX
- call m_ES_EXX_ylm_each_k(iqmk(jkbz,ik))
+ call m_ES_EXX_ylm_each_k(iqmk(jkbz,ikk))
#ifdef MEMORY_SAVE_MORE_EXX
- call qitgft_qmk_each_k(iqmk(jkbz,ik))
+ call qitgft_qmk_each_k(iqmk(jkbz,ikk))
#endif
#endif
! q(bz) = S*k(ibz)
@@ -3060,7 +3076,7 @@
call get_Rot_betar_dot_WFs(kk,m,jop,kop,jtrs,fsr2(m,:),fsi2(m,:))
endif
enddo
- call add_RHOG_hard_part_rs3(iqmk(jkbz,ik),kk,rhor2,rhoi2,bdwr,bdwi,fsr2,fsi2)
+ call add_RHOG_hard_part_rs3(iqmk(jkbz,ikk),kk,rhor2,rhoi2,bdwr,bdwi,fsr2,fsi2)
do m=ista_nval,iend_nval
if(occup_val(m,kk) < DELTA) cycle
! if(sw_rsb==ON)then
@@ -3129,13 +3145,13 @@
if(present(eexx))then
exx = 0.d0
- call sum_rho_vc_rho_2D(rhogr2(:,m),rhogi2(:,m),vc(1,iqmk(jkbz,ik)),exx)
+ call sum_rho_vc_rho_2D(rhogr2(:,m),rhogi2(:,m),vc(1,iqmk(jkbz,ikk)),exx)
eexx = eexx + occupation * exx
if(eo) cycle
endif
!do ii=1,nmax_G_hyb
- rhogr2(:,m) = vc(:,iqmk(jkbz,ik)) * rhogr2(:,m) ! phi(G) = Vc(G,q) * rho(G)
- rhogi2(:,m) = vc(:,iqmk(jkbz,ik)) * rhogi2(:,m) ! phi(G) = Vc(G,q) * rho(G)
+ rhogr2(:,m) = vc(:,iqmk(jkbz,ikk)) * rhogr2(:,m) ! phi(G) = Vc(G,q) * rho(G)
+ rhogi2(:,m) = vc(:,iqmk(jkbz,ikk)) * rhogi2(:,m) ! phi(G) = Vc(G,q) * rho(G)
!end do
call map_RHOG_on_FFT_box_hard_inv(rhogr2(:,m),rhogi2(:,m),afft)
call m_FFT_CD0_exx(nfout,afft,INVERSE)
@@ -3145,9 +3161,9 @@
enddo
if(.not.eo)then
if(force_mode)then
- call integrate_QijVnm_rs3(iqmk(jkbz,ik),rhor2,rhoi2,fsr2,fsi2,qvr2,qvi2,dfsr2,dfsi2,dqvr2,dqvi2,gqvr2,gqvi2)
+ call integrate_QijVnm_rs3(iqmk(jkbz,ikk),rhor2,rhoi2,fsr2,fsi2,qvr2,qvi2,dfsr2,dfsi2,dqvr2,dqvi2,gqvr2,gqvi2)
else
- call integrate_QijVnm_rs3(iqmk(jkbz,ik),rhor2,rhoi2,fsr2,fsi2,qvr2,qvi2)
+ call integrate_QijVnm_rs3(iqmk(jkbz,ikk),rhor2,rhoi2,fsr2,fsi2,qvr2,qvi2)
endif
! =============================================================== 12.5Exp
do m=ista_nval,iend_nval
@@ -3883,12 +3899,14 @@
write(nfout,'(" !! out of check of ngpt_exx")')
end if
+ if(sw_change_axis /= ON) then
! === Make FFT box index arrays. ===============================================
- call Parallelize_wf_onto_fft_exx_3D(nfout,fft_box_size_WF,igf,nbase,nbase_gamma, &
- & k_symmetry,GAMMA,kg,kg_gamma,kv3)
- 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 Parallelize_wf_onto_fft_exx_3D(nfout,fft_box_size_WF,igf,nbase,nbase_gamma, &
+ & k_symmetry,GAMMA,kg,kg_gamma,kv3)
+ 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)
! ==============================================================================
+ endif
call tstatc0_end(id_sname)
!!!stop 'Check: G_list'
end subroutine m_ES_EXX_ngpt
diff -ruN phase0_2023.01/src_phase_3d/m_ES_WF_by_RMM.F90 phase0_2023.01.01/src_phase_3d/m_ES_WF_by_RMM.F90
--- phase0_2023.01/src_phase_3d/m_ES_WF_by_RMM.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_ES_WF_by_RMM.F90 2023-11-09 12:02:33.687110380 +0900
@@ -176,10 +176,9 @@
use m_ES_WF_by_SDorCG, only : m_ES_contrib_kindens_to_vnlph, &
& m_ES_kindens_to_vnlph_ib, m_ES_kindens_to_vnlph_ib2
#ifdef MPI_FFTW
- use m_ES_WF_by_SDorCG, only : m_ES_con_kindens_to_vnlph_mpfw, &
- & m_ES_kindens_to_vnlph_ib_mpfw, &
- & m_ES_kindens_to_vnlph_ib2_mpfw
- &
+ use m_ES_WF_by_SDorCG, only : m_ES_con_kindens_to_vnlph_mpfw, &
+ & m_ES_kindens_to_vnlph_ib_mpfw, &
+ & m_ES_kindens_to_vnlph_ib2_mpfw
#endif
diff -ruN phase0_2023.01/src_phase_3d/m_ES_WF_by_submat.F90 phase0_2023.01.01/src_phase_3d/m_ES_WF_by_submat.F90
--- phase0_2023.01/src_phase_3d/m_ES_WF_by_submat.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_ES_WF_by_submat.F90 2023-11-09 12:02:33.695110422 +0900
@@ -4273,26 +4273,26 @@
nblocksize = 0
end if
- block = meg
- rowsize = meg*kimg
- if (nblocksize > 0) then
- if (mod(meg,nblocksize) > 0) then
- npart2 = meg / nblocksize + 1
- else
- npart2 = meg / nblocksize
- end if
- if(allocated(isp2)) deallocate(isp2)
- if(allocated(iep2)) deallocate(iep2)
- allocate(isp2(npart2))
- allocate(iep2(npart2))
- isp2(1) = 1
- iep2(1) = isp2(1) + nblocksize_submat_latter - 1
- do i = 2, npart2
- isp2(i) = iep2(i-1) + 1
- iep2(i) = isp2(i) + nblocksize_submat_latter - 1
- end do
- iep2(npart2) = meg
- else
+! block = meg
+! rowsize = meg*kimg
+! if (nblocksize > 0) then
+! if (mod(meg,nblocksize) > 0) then
+! npart2 = meg / nblocksize + 1
+! else
+! npart2 = meg / nblocksize
+! end if
+! if(allocated(isp2)) deallocate(isp2)
+! if(allocated(iep2)) deallocate(iep2)
+! allocate(isp2(npart2))
+! allocate(iep2(npart2))
+! isp2(1) = 1
+! iep2(1) = isp2(1) + nblocksize_submat_latter - 1
+! do i = 2, npart2
+! isp2(i) = iep2(i-1) + 1
+! iep2(i) = isp2(i) + nblocksize_submat_latter - 1
+! end do
+! iep2(npart2) = meg
+! else
!fj --------------------
rowsize = meg*kimg_t
if(allocated(isp2)) deallocate(isp2)
@@ -4324,7 +4324,7 @@
iep2(npart2) = meg
end if
!fj --------------------
- end if
+! end if
!fj --------------------
if (iprisubmat >= 2) then
diff -ruN phase0_2023.01/src_phase_3d/m_ES_nonlocal.F90 phase0_2023.01.01/src_phase_3d/m_ES_nonlocal.F90
--- phase0_2023.01/src_phase_3d/m_ES_nonlocal.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_ES_nonlocal.F90 2023-11-09 12:02:33.652110198 +0900
@@ -1863,7 +1863,8 @@
deallocate(fsrt)
!if(k_symmetry(ik) /= GAMMA) deallocate(fsit)
deallocate(fsit)
- if(present(mod_ball) .and. mod_ball == ON) then
+ if(present(mod_ball)) then
+ if(mod_ball == ON) then
allocate(wk_fsr_l(np_fs,np_e))
allocate(wk_fsr_ball(np_fs,neg))
if(k_symmetry(ik) /= GAMMA) then
@@ -1891,6 +1892,7 @@
!if(k_symmetry(ik) /= GAMMA) deallocate(wk_fsi_l,wk_fsi_ball)
if(k_symmetry(ik) /= GAMMA) deallocate(wk_fsi_l,wk_fsi_ball)
end if
+ end if
call m_ES_alloc_fsr_l_2d(np_e,nlmta)
call m_ES_gather_f_3d_to_2d(fsr_l, fsr_l_2D, ik)
@@ -2062,7 +2064,8 @@
call tstatc0_end(id_sname)
! for eigen value sort
- if(present(mod_ball) .and. mod_ball == ON) then
+ if(present(mod_ball)) then
+ if(mod_ball == ON) then
__TIMER_COMM_START(420)
do i=1,np_e
do j=1,np_fs
@@ -2090,7 +2093,8 @@
enddo
__TIMER_COMM_STOP(422)
- end if
+ end if
+ end if
deallocate(wk_fsr_l,wk_fsr_ball)
if(k_symmetry(ik) /= GAMMA) deallocate(wk_fsi_l,wk_fsi_ball)
diff -ruN phase0_2023.01/src_phase_3d/m_Electronic_Structure.F90 phase0_2023.01.01/src_phase_3d/m_Electronic_Structure.F90
--- phase0_2023.01/src_phase_3d/m_Electronic_Structure.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Electronic_Structure.F90 2023-11-09 12:02:33.666110271 +0900
@@ -4706,6 +4706,11 @@
tr_neg(neg_g_all(i)) = i
end do
__TIMER_DO_STOP(612)
+ allocate(eko_t(mp_e*nrank_e), stat=ierr)
+ if (ierr/=0) then
+ call phase_error_with_msg('failed to allocate temporary array at m_ES_sort_eigen_values_3D', &
+ & __LINE__, __FILE__)
+ endif
do ik = 1, kv3, af+1
if(map_k(ik) /= myrank_k) cycle ! MPI
@@ -4717,8 +4722,6 @@
if(ipri >= 2) call wd_eko_s(ik,1)
- allocate(eko_t(mp_e*nrank_e), stat=ierr)
-
#ifdef _NO_HEAP_SORT_EIGENVALUES_
call bubble_sorting(neg,eko_s,neordr(1,ik))
__TIMER_DO_START(618)
diff -ruN phase0_2023.01/src_phase_3d/m_Epsilon_ek.F90 phase0_2023.01.01/src_phase_3d/m_Epsilon_ek.F90
--- phase0_2023.01/src_phase_3d/m_Epsilon_ek.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Epsilon_ek.F90 2023-11-09 12:02:33.682110354 +0900
@@ -104,7 +104,7 @@
& , GENERAL, GENERAL_LARGER, NONAME, MESH, MONKHORST_PACK &
& , SKPS_DIRECT_IN, GAMMA, FILE,NODATA, TETRAHEDRON &
& , NEW_, FMAXVALLEN,LOWER, PARABOLIC, PARA, ANTIFERRO, FERRO, INITIAL, CONTINUATION &
- & , ONE_BY_ONE, har => Hartree, BOHR, bohr_r => BOHR_RADIUS
+ & , ONE_BY_ONE, har => Hartree, BOHR, bohr_r => BOHR_RADIUS, FIXED_CHARGE
use m_IterationNumbers, only : nk_in_the_process,nk_converged,iteration &
& , first_iteration_of_this_job,iteration_scdft,nkgroup
use m_Parallelization, only : is_kngp,ie_kngp,npes,mype,ierr,map_k &
@@ -1112,7 +1112,8 @@
kpt_file_mode = 0
kpt_data_mode = 0
crystal=SINGLE_CRYSTAL
- nrd_efermi=2
+! nrd_efermi=2
+ nrd_efermi=0
Dirac_point_option = 0
active_space_option = 0
n_check_ts=1
@@ -1800,7 +1801,6 @@
! === KT_add === 13.1R
if ( allocated(trm2) ) deallocate(trm2)
-
! === KT_add === 2014/09/22
if ( noncol ) then
nspin_kt = 1
@@ -6726,7 +6726,8 @@
! write restart data to nfepscont (restart_mode = 1)
if(mype==0.and.icond>=2.and.restart_mode == 1) call wd_epscont_data(ik,nv,nc)
end do
- call mpi_allreduce(MPI_IN_PLACE,trm_tmp,kv3*nv*nc*12,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
+! call mpi_allreduce(MPI_IN_PLACE,trm_tmp,kv3*nv*nc*12,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
+ call mpi_allreduce(MPI_IN_PLACE,trm_tmp,kv3*nv*nc*6,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_comm_group,ierr)
call mpi_allreduce(MPI_IN_PLACE,eb_ek_tmp,kv3*neg,MPI_DOUBLE_PRECISION,MPI_SUM,mpi_ge_world,ierr)
do ik = 1, kv3, af+1
if(nk_in_the_process+ik-1 > kv3_ek) cycle
@@ -7179,7 +7180,7 @@
end do
if(.not.trm_rptrans_allocated) then
- if(icond == 2) then
+ if(icond == INITIAL .or. icond == FIXED_CHARGE) then
num_vb = nvb
num_cb = neg-nvb
if(active_space_option == 1) then
@@ -7290,7 +7291,8 @@
end if
end if
if(icond <=2) then
- if(.not.allocated(trm_tmp)) allocate(trm_tmp(kv3,nv,nc,3,2,2)); trm_tmp=0.0d0
+ if(allocated(trm_tmp)) deallocate(trm_tmp)
+ allocate(trm_tmp(kv3,nv,nc,3,2,1)); trm_tmp=0.0d0
end if
trm_rptrans_allocated = .true.
if(printable) then
@@ -8857,6 +8859,10 @@
nspin_kt = nspin / ( af +1 ) ! ASMS 2016/10/21
endif
! =================== 2014/09/22
+
+ if(allocated(n_filled)) deallocate(n_filled)
+ if(allocated(n_unfilled)) deallocate(n_unfilled)
+ if(allocated(n_half_filled)) deallocate(n_half_filled)
allocate(n_filled(nspin_kt)) ; n_filled = 0
allocate(n_unfilled(nspin_kt)); n_unfilled = 0
@@ -8960,6 +8966,7 @@
if( (.not. noncol) .and. (nspin_kt==1) .and. (.not. metalic_system) ) then
nfband = int(totch*0.5d0)
do ib = 1, neg
+ if(map_e(ib) == myrank_e .and. myrank_g == 0) then
if ( icond == INITIAL .or. icond == CONTINUATION ) then
else
band_type(ib,1)=UNFILLED_BAND
@@ -8969,11 +8976,13 @@
band_type(ib,1) = FILLED_BAND
band_ch(ib,1) = 1.0d0
end if
+ endif
end do
! else if(noncol .eqv. .false. .and. nspin_kt == 1 .and. metalic_system .eqv. .true.) then
else if ( (.not. noncol) .and. (nspin_kt==1) .and. metalic_system ) then
nfband = int(totch*0.5d0)
do ib = 1, neg
+ if(map_e(ib) == myrank_e .and. myrank_g == 0) then
if ( icond == INITIAL .or. icond == CONTINUATION ) then
else
band_type(ib,1)=UNFILLED_BAND
@@ -8983,9 +8992,10 @@
band_type(ib,1) = FILLED_BAND
band_ch(ib,1) = 1.0d0
end if
+ endif
end do
do ib = 1, neg
- if(map_e(ib) == myrank_e) then
+ if(map_e(ib) == myrank_e .and. myrank_g==0) then
occupied=.false.
do ik = 1, kv3_ek
occ=occ_mpi_ek(n2_mpi_ek(ib,ik),ik)
@@ -9022,7 +9032,7 @@
endif
! ================ 13.1R
- if(map_e(ib) == myrank_e) then
+ if(map_e(ib) == myrank_e .and. myrank_g==0) then
occupied=.false.
do ik = ispin, kv3_ek-nspin+ispin, nspin
occ=occ_mpi_ek(n2_mpi_ek(ib,ik),ik)
@@ -11596,7 +11606,7 @@
write(nfout,'(1x," nstep_l0 = ",i6,3x,"nstep_l = ",i6)') nstep_l0, nstep_l
write(nfout,'(1x," nst = ",i6)') nst
write(nfout,'(1x," nstep_min = ",i6,3x," nstep_max = ",i6)') nstep_min, nstep_max
- write(nfout,'(1x," emin for impes = ",f10.5,1x,"eV")') (e_low + (nstep_min - 1)*e_step)*hartree_in_eV
+ write(nfout,'(1x," emin for imeps = ",f10.5,1x,"eV")') (e_low + (nstep_min - 1)*e_step)*hartree_in_eV
write(nfout,'(1x," emax for imeps = ",f10.5,1x,"eV")') (e_low + (nstep_max - 1)*e_step)*hartree_in_eV
write(nfout,'(1x," n_start = ",i6,1x," : photon energy =",f10.5)') n_start, (e_low + (n_start-1)*e_step)*hartree_in_eV
write(nfout,'(1x," n_end = ",i6,1x," : photon energy =",f10.5)') n_end, (e_low + (n_end-1)*e_step)*hartree_in_eV
@@ -12247,7 +12257,7 @@
integer :: ispin,ip2
allocate(eko_t(neg))
allocate(neordr_t(neg))
- if(icond==2) then
+ if(icond == INITIAL .or. icond==FIXED_CHARGE) then
if(np2*nspin/=nk_converged) then
if(printable) then
write(nfout,*) nspin
diff -ruN phase0_2023.01/src_phase_3d/m_Files.F90 phase0_2023.01.01/src_phase_3d/m_Files.F90
--- phase0_2023.01/src_phase_3d/m_Files.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Files.F90 2023-11-09 12:02:33.696110428 +0900
@@ -1,3 +1,4 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
!=======================================================================
!
! SOFTWARE NAME : PHASE ($Revision: 633 $)
@@ -2439,8 +2440,10 @@
subroutine m_Files_close_logfile()
if(mype == 0) then
close(nfout, status='keep')
+#ifndef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
else if(ipriparadeb == 0) then
close(nfout, status='delete')
+#endif
else
close(nfout, status='keep')
end if
diff -ruN phase0_2023.01/src_phase_3d/m_Ionic_System.F90 phase0_2023.01.01/src_phase_3d/m_Ionic_System.F90
--- phase0_2023.01/src_phase_3d/m_Ionic_System.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Ionic_System.F90 2023-11-09 12:02:33.701110454 +0900
@@ -16160,7 +16160,6 @@
racov = dftd3par%covrad(iaelem)
do i=1,nnei(ia)
itmp = indlist(i,ia)
- if(itmp == ia) cycle
ielem = nint(iatomn(ityp_full(itmp)))
rbcov = dftd3par%covrad(ielem)
rinv = 1.d0/rlist(i,ia)
@@ -18870,7 +18869,7 @@
character(len=256) :: idstr
n = 0
- if(f_getStringValue(tag_target_element,rstr)==0) then
+ if(f_getStringValue(tag_target_element,rstr, LOWER)==0) then
found = .false.
do j=1,ntyp
if(rstr == speciesname(j)) then
diff -ruN phase0_2023.01/src_phase_3d/m_Kpoints.F90 phase0_2023.01.01/src_phase_3d/m_Kpoints.F90
--- phase0_2023.01/src_phase_3d/m_Kpoints.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Kpoints.F90 2023-11-09 12:02:33.701110454 +0900
@@ -784,7 +784,7 @@
if(fixed_charge_k_parallel == ONE_BY_ONE .and. nk+kv3-1 > kv3_ek) then
kvt = kv3_ek - nk + 1
vkxyz(1:kvt,1:3,1:CRDTYP) = vkxyz_ek(nk:kv3_ek,1:3,1:CRDTYP)
- qwgt(1:kvt) = qwgt_ek(nk:kv3_ek-1)
+ qwgt(1:kvt) = qwgt_ek(nk:kv3_ek)
if ( sw_force_kpt_inside_bz == ON ) then
GVecTrans_kpt(1:kvt,1:3) = GvecTrans_kpt_ek(nk:kv3_ek,1:3)
diff -ruN phase0_2023.01/src_phase_3d/m_Ldos.F90 phase0_2023.01.01/src_phase_3d/m_Ldos.F90
--- phase0_2023.01/src_phase_3d/m_Ldos.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Ldos.F90 2023-11-09 12:02:33.646110167 +0900
@@ -2334,7 +2334,6 @@
! call mpi_bcast(dos_weight,ne*nk,mpi_double_precision,0,mpi_comm_group,ierr)
! endif
end if
- contains
end subroutine m_Ldos_get_dos_weight
diff -ruN phase0_2023.01/src_phase_3d/m_Orbital_Population.F90 phase0_2023.01.01/src_phase_3d/m_Orbital_Population.F90
--- phase0_2023.01/src_phase_3d/m_Orbital_Population.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Orbital_Population.F90 2023-11-09 12:02:33.687110380 +0900
@@ -1,3 +1,4 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
!=======================================================================
!
! SOFTWARE NAME : PHASE (ver. 7.01)
@@ -537,6 +538,10 @@
integer :: ig,ip,i
integer :: ilp
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ real(kind=DP) :: om2_sum, hsr2_sum
+ om2_sum = 0.d0
+#endif
#ifdef __TIMER_SUB__
call timer_sta(737)
@@ -624,6 +629,32 @@
call wd_occ_mat(om)
end if
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ om2_sum = 0.d0
+ hsr2_sum = 0.d0
+ do is = 1, nspin
+ do ia = 1, natm
+ ig = iproj_group(ia)
+ if(ig<1) cycle
+ do i = 1, num_proj_elems(ig)
+ do m2 = 1, max2lp
+ do m1 = 1, max2lp
+ om2_sum = om2_sum + om(m1,m2,i,ia,is)*om(m1,m2,i,ia,is)
+ end do
+ end do
+ end do
+ end do
+ do ia = 1, natm
+ it = ityp(ia)
+ do ilmt1 = 1, ilmt(it)
+ do ilmt2 = 1, ilmt(it)
+ hsr2_sum = hsr2_sum + hsr(ia,ilmt2,ilmt1,is)*hsr(ia,ilmt2,ilmt1,is)
+ end do
+ end do
+ end do
+ end do
+ write(nfout,'(" om2_sum = ",f20.10, " hsr2_sum = ",f20.10, " <<m_OP_occ_mat_ylm>>")') om2_sum, hsr2_sum
+#endif
if ( sw_mix_charge_hardpart == OFF ) call symmetrize_occ_mat(om)
! call symmetrize_occ_mat(om)
if( pmode==1 .and. iprihubbard > 1) then
diff -ruN phase0_2023.01/src_phase_3d/m_Parallelization.F90 phase0_2023.01.01/src_phase_3d/m_Parallelization.F90
--- phase0_2023.01/src_phase_3d/m_Parallelization.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Parallelization.F90 2023-11-09 12:02:33.685110370 +0900
@@ -288,6 +288,8 @@
! BROYDEN or DFP MIXING METHOD
integer :: ista_kgpm,iend_kgpm, np_kgpm, mp_kgpm
integer, allocatable, dimension(:) :: is_kgpm, ie_kgpm, nel_kgpm
+ integer :: ista_urec_hsr, iend_urec_hsr
+ logical, save :: ista_and_iend_urec_hsr_set = .false.
! FFT BOX
integer :: npes_cdfft, nrank_ggacmp, nrest_cdfft
@@ -979,6 +981,28 @@
__TIMER_SUB_STOP(1235)
end subroutine m_Parallel_init_mpi_nbmx
+ subroutine m_Parallel_init_mpi_urec_hsr(nfout,ipri,nsize_rho_hsr)
+ ! Coded by T. Ymasaki, 2023/07/07
+ integer, intent(in) :: nfout, ipri, nsize_rho_hsr
+ integer, allocatable, dimension(:) :: is_hsr, ie_hsr
+ integer :: iwork, k
+ allocate(is_hsr(0:npes-1),ie_hsr(0:npes-1))
+ iwork = ( nsize_rho_hsr - 1)/nrank_chg + 1
+ do k = 0, nrank_chg-1
+ is_hsr(k) = min(k*iwork+1,nsize_rho_hsr+1)
+ ie_hsr(k) = min(is_hsr(k)+iwork-1,nsize_rho_hsr)
+ end do
+ ista_urec_hsr = is_hsr(myrank_chg)
+ iend_urec_hsr = ie_hsr(myrank_chg)
+ if(ipri >= 1) then
+ write(nfout,'(" !|| ista_urec_hsr = ",i8, " iend_urec_hsr = ",i8, " myrank_chg = ",i4)') &
+ & ista_urec_hsr, iend_urec_hsr, myrank_chg
+ call flush(nfout)
+ end if
+ deallocate(is_hsr, ie_hsr)
+ ista_and_iend_urec_hsr_set = .true.
+ end subroutine m_Parallel_init_mpi_urec_hsr
+
subroutine set_block_range4allgather(ne,np,nel_p,nis_p,nie_p,idisp_p)
integer, intent(in) :: ne ! number of total elements
integer, intent(in) :: np ! number of ranks (or processors)
@@ -3325,23 +3349,9 @@
read_from_args = .true.
else if(nkflag==0 .and. neflag==0 .and. ngflag==0) then
flag_from_nmlfile = 1
- else
- if(nkflag>=2 .or. neflag>=2 .or. ngflag>=2) then
- if(printable) write(nfout,'(" wrong nk, ne, and ng in m_Parallel_get_nproc_from_arg_3D")')
- call phase_error_with_msg(nfout, &
- ' Wrong nk, ne, and ng in m_Parallel_get_nproc_from_arg_3D',__LINE__,__FILE__)
- end if
end if
endif
- if(flag_from_nmlfile==0) then
- if(nk*ne*ng/=npes) then
- if(printable) write(nfout,'(" nk*ne*ng /= npes")')
- if(printable) write(nfout,'(" nk = ",i4, " ne = ", i4, " ng = ",i4, " npes = ",i4)') nk,ne,ng,npes
- call phase_error_with_msg(nfout,'nk*ne*ng /= npes',__LINE__,__FILE__)
- end if
- end if
-
if(flag_from_nmlfile==1) then
ne = npes
@@ -3369,12 +3379,6 @@
na = npes/nr
else if(naflag==0 .and. nrflag==0) then
flag_from_nmlfile_for_nnatm = 1
- else
- if(naflag>=2 .or. nrflag>=2) then
- if(printable) write(nfout,'(" wrong na and nr in m_Parallel_get_nproc_from_arg_3D")')
- call phase_error_with_msg(nfout, &
- ' Wrong na and nr in m_Parallel_get_nproc_from_arg_3D',__LINE__,__FILE__)
- end if
end if
@@ -3412,6 +3416,33 @@
if(npes>1) call mpi_bcast(ne,1,mpi_integer,0,mpi_comm_group,ierr)
if(npes>1) call mpi_bcast(ng,1,mpi_integer,0,mpi_comm_group,ierr)
if(npes>1) call mpi_bcast(read_from_args,1,mpi_logical,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(nkflag,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(neflag,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(ngflag,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(flag_from_nmlfile,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(naflag,1,mpi_integer,0,mpi_comm_group,ierr)
+ if(npes>1) call mpi_bcast(nrflag,1,mpi_integer,0,mpi_comm_group,ierr)
+
+ if(nkflag>=2 .or. neflag>=2 .or. ngflag>=2) then
+ if(printable) write(nfout,'(" wrong nk, ne, and ng in m_Parallel_get_nproc_from_arg_3D")')
+ call phase_error_with_msg(nfout, &
+ ' Wrong nk, ne, and ng in m_Parallel_get_nproc_from_arg_3D',__LINE__,__FILE__)
+ end if
+
+ if(flag_from_nmlfile==0) then
+ if(nk*ne*ng/=npes) then
+ if(printable) write(nfout,'(" nk*ne*ng /= npes")')
+ if(printable) write(nfout,'(" nk = ",i4, " ne = ", i4, " ng = ",i4, " npes = ",i4)') nk,ne,ng,npes
+ call phase_error_with_msg(nfout,'nk*ne*ng /= npes',__LINE__,__FILE__)
+ end if
+ end if
+
+ if(naflag>=2 .or. nrflag>=2) then
+ if(printable) write(nfout,'(" wrong na and nr in m_Parallel_get_nproc_from_arg_3D")')
+ call phase_error_with_msg(nfout, &
+ ' Wrong na and nr in m_Parallel_get_nproc_from_arg_3D',__LINE__,__FILE__)
+ end if
+
!!$ if ( err/=0 ) goto 999
diff -ruN phase0_2023.01/src_phase_3d/m_PseudoPotential.F90 phase0_2023.01.01/src_phase_3d/m_PseudoPotential.F90
--- phase0_2023.01/src_phase_3d/m_PseudoPotential.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_PseudoPotential.F90 2023-11-09 12:02:33.666110271 +0900
@@ -3682,10 +3682,10 @@
!
if ( mode == 0 ) then
if ( mype == 0 ) then
- allocate( flag(max_orb) ); flag = 0
- allocate( val_nl(max_orb) )
- allocate( val_l(max_orb) ); val_l = 0
- allocate( val_tau(max_orb) ); val_tau = 0
+ if(.not.allocated(flag)) allocate( flag(max_orb) ); flag = 0
+ if(.not.allocated(val_nl)) allocate( val_nl(max_orb) )
+ if(.not.allocated(val_l)) allocate( val_l(max_orb) ); val_l = 0
+ if(.not.allocated(val_tau)) allocate( val_tau(max_orb) ); val_tau = 0
count = 0
Do while ( .true. )
diff -ruN phase0_2023.01/src_phase_3d/m_SpinOrbit_RadInt.F90 phase0_2023.01.01/src_phase_3d/m_SpinOrbit_RadInt.F90
--- phase0_2023.01/src_phase_3d/m_SpinOrbit_RadInt.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_SpinOrbit_RadInt.F90 2023-11-09 12:02:33.664110261 +0900
@@ -609,7 +609,7 @@
else
allocate( rho_work(mmesh,nspin,max_sph_expansion) ); rho_work = 0.0d0
-#if 0
+#if 1
nrmax = nrc
#else
nrmax = nmesh(it)
diff -ruN phase0_2023.01/src_phase_3d/m_SpinOrbit_SecondVariation.F90 phase0_2023.01.01/src_phase_3d/m_SpinOrbit_SecondVariation.F90
--- phase0_2023.01/src_phase_3d/m_SpinOrbit_SecondVariation.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_SpinOrbit_SecondVariation.F90 2023-11-09 12:02:33.667110276 +0900
@@ -871,7 +871,7 @@
if(map_e(ie) /= myrank_e) cycle
ito = nrvf_ordr(ie,ik)
Do is=1, ndim_spinor_socsv
- a_all( (ito-1)*ndim_spinor_socsv +is,iktmp) = a_l(map_z(ie),ik)
+ a_all( (ito-1)*ndim_spinor_socsv +is,iktmp) = a_l(map_z(ie),ik+is-1)
End Do
end do
end do
diff -ruN phase0_2023.01/src_phase_3d/m_Total_Energy.F90 phase0_2023.01.01/src_phase_3d/m_Total_Energy.F90
--- phase0_2023.01/src_phase_3d/m_Total_Energy.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_Total_Energy.F90 2023-11-09 12:02:33.682110354 +0900
@@ -1,3 +1,5 @@
+!#define _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+!!$#define DEBUG_WRITE
!=======================================================================
!
! PROGRAM PHASE/0 2016.01 ($Rev: 633 $)
@@ -70,7 +72,7 @@
& , m_CtrlP_get_isolver_now &
& , sub_delta_factor_is_given &
& , sub_delta_factor &
- & , sw_dipole_correction, sw_screening_correction &
+ & , sw_dipole_correction &
& , sw_hubbard, proj_attribute &
& , critical_ehub, delta_ehub &
& , num_conduction_bands_lmm &
@@ -103,9 +105,8 @@
& , FIXED_CHARGE, FIXED_CHARGE_CONTINUATION, MATRIXDIAGON &
& , DELTA_MOVING_AVERAGE, SLOPE, DELTA_V &
& , VDW_DFTD3 &
- & , MP
+ & , MP, Hartree
use m_Dipole, only : edip_ion, eext_ion, vdip_l, vext_l
- use m_Screening, only : screening
use m_Hubbard, only : m_Hubbard_energy
use m_FiniteElectricField, only : m_FEF_polarization, pmac, pmac_old
use m_ES_ExactExchange, only : m_ES_EXX_gather_valence_states,m_ES_EXX_energy &
@@ -117,42 +118,31 @@
& , m_PAW_XC_cal_potential_sphex2,m_PAW_XC_allocation, m_PAW_XC_deallocation
!!$ , m_PAW_XC_cal_potential_sym
use m_PAW_Hartree, only : m_PAWH_get_dion_hartree_now
- use m_External_Potential, only : espot_g
use m_PAW_ChargeDensity, only : calcGaussLegendreIntegration &
& , calcSphericalHarmonicsExpansion
use m_PlaneWaveBasisSet, only : kgp, kg
-
! ====================================== added by K. Tagami ================ 11.0
use m_Control_Parameters, only : noncol, ndim_spinor, ndim_magmom, ndim_chgpot
use m_PseudoPotential, only : dion0_noncl, nlmt
- use m_Charge_Density, only : hsi
+ use m_Charge_Density, only : hsi
use m_ES_NonCollinear, only : m_ES_MagMom_To_DensMat_hsr, &
& m_ES_MagMom_to_DensMat_Dhub
!
- use m_Crystal_Structure, only : sw_magnetic_constraint
- use m_ES_Mag_Constraint, only : m_ES_calc_MagConstraint_Energy
+ use m_Crystal_Structure, only : sw_magnetic_constraint
+ use m_ES_Mag_Constraint, only : m_ES_calc_MagConstraint_Energy
use m_Hubbard, only : m_Hubbard_energy_noncl, &
& m_Hubbard_energy2_noncl, &
& m_Hubbard_energy3_noncl
! ========================================================================== 11.0
-! ====================================== added by K. Tagami ================ 11.0
- use m_Control_Parameters, only : SpinOrbit_Mode
- use m_Const_Parameters, only : ByPawPot, CMPLDP, BuiltIn, EXECUT
- use m_SpinOrbit_Potential, only : dsoc, m_SO_set_Dsoc_potential2
- use m_SpinOrbit_RadInt, only : m_SO_calc_SOC_strength_pawpot
- use m_PseudoPotential, only : lmta, m_PP_include_vanderbilt_pot, dion_scr_noncl
- use m_Electronic_Structure, only : fsr_l, fsi_l, dhub_aimag
-! ========================================================================== 11.0
-
! ======================= KT_add ================== 13.0E
use m_Const_Parameters, only : Fermi_Dirac
! ================================================= 13.0E
! =========== KT_add ========== 13.0U2
- use m_Control_Parameters, only : sw_potential_mixing, use_metagga, vtau_exists
+ use m_Control_Parameters, only : sw_potential_mixing, use_metagga
! ============================= 13.0U2
#ifndef DISABLE_VDWDF
@@ -162,12 +152,9 @@
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_Control_Parameters, only : sw_positron, 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
+ use m_epc_potential, only : ecorr_pztr => epc
! ==================== 2015/11/28
use m_ES_LHXC, only : m_ESlhxc_delta_vmax
@@ -237,12 +224,6 @@
real(kind=DP),private :: emag1 ! double counting energy
! ==================================================================== 11.0
-! ====================================== added by K. Tagami ================ 11.0
-! Spin Orbit
-!
- real(kind=DP),private :: espinorb_old, espinorb_now
-! ========================================================================== 11.0
-
! === positron
real(kind=DP) :: ekin_pztr, elocal_pztr, ehartr_ep, eohxc_pztr
! ===
@@ -253,7 +234,15 @@
real(kind=DP), allocatable, dimension(:) :: ehist
integer :: ihist
real(kind=DP) :: emova, emovaold
+
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ integer, parameter :: DEBUGPRINTLEVEL = 1
+#else
+ integer, parameter :: DEBUGPRINTLEVEL = 2
+#endif
+
contains
+
real(DP) function m_TE_what_is_edeltb_now()
m_TE_what_is_edeltb_now = edeltb
end function m_TE_what_is_edeltb_now
@@ -339,6 +328,15 @@
if(sw_hubbard==ON) write(nfout,'(" !D EHUB1 = ",f12.5)') ehub1
if(sw_hybrid_functional == ON) write(nfout,'(" !D VEXX = ",f12.5)') vexx
endif
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(sw_hubbard==ON) then
+ write(nfout,'(" !D EBAND= ",F20.12," EOHXC= ",F20.12," ELOCA1= ",F20.12," ENONLC= ",F20.12, " EHUB1= ",F20.12)') &
+ & EBAND, EOHXC, ELOCA1, ENONLC, EHUB1
+ else
+ write(nfout,'(" !D EBAND= ",F20.12," EOHXC= ",F20.12," ELOCA1= ",F20.12," ENONLC= ",F20.12)') &
+ & EBAND, EOHXC, ELOCA1, ENONLC
+ end if
+#endif
#ifdef __TIMER_SUB__
call timer_end(747)
#endif
@@ -570,8 +568,12 @@
real(kind=DP), intent(in) :: exc
integer :: i
- real(kind=DP) :: edel
+ real(kind=DP) :: edel, EPC_t
character(len("potential_mixing")) :: tag_mixing
+ character(len=2) ::ndecimals ! T. Yamasaki, 2023/07/09
+ integer :: ij ! T. Yamasaki, 2023/07/09
+ character(:), allocatable :: fmt,fmt2 ! T. Yamasaki, 2023/07/09
+
#ifdef __TIMER_SUB__
call timer_sta(749)
#endif
@@ -638,119 +640,51 @@
if(way_of_smearing == MP) &
& etotal0 = (1.d0/(dble(order_mp+2)))*(dble(order_mp+1)*etotal+etotal0)
+#ifdef _DEBUG_WRITE_DFTU_MPI_PROCESSES_
+ if(display_on) then
+#else
if(display_on .and. ipri >= 1) then
+#endif
edel = cal_edeltb()
-!!$ write(nfout,600) iteration,etotal,etotal
-!!$ write(nfout,600) iteration,etotal,edel
if(number_of_cdmixing_applied<=0) call m_CtrlP_push_CDMixingNameApplied(" ",1)
tag_mixing = "Charge-Mixing" ; if(sw_potential_mixing == ON) tag_mixing = "Potential-Mixing"
+ if(number_of_solvers_applied == 1 .or. number_of_solvers_applied == 2) then
+ if(dabs(etotal) < 1.e13) then
+ ij = int(log10(dabs(etotal))) ! T. Yamasaki, 2023/07/09
+ if(dabs(etotal) < 1.e5) ij = 5 ! T. Yamasaki, 2023/07/09
+ if(17-ij>9) write(ndecimals,'(i2)') 17-ij ! T. Yamasaki, 2023/07/09
+ if(17-ij<=9) write(ndecimals,'(i1)') 17-ij ! T. Yamasaki, 2023/07/09
+ end if
+ end if
+
if(number_of_solvers_applied == 1) then
- if(dabs(etotal) <1.e6) then
- write(nfout,91) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
-!!$ write(nfout,'(" TOTAL ENERGY FOR",I6," -TH ITER=",F20.12," edel = ",D14.6," : SOLVER = ",A, " : ",A," = ",A)') &
-!!$ & iteration, etotal, edel, trim(solver_names_applied(1)), trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e7) then
- write(nfout,92) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e8) then
- write(nfout,93) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e9) then
- write(nfout,94) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e10) then
- write(nfout,95) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e11) then
- write(nfout,96) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e12) then
- write(nfout,97) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e13) then
- write(nfout,98) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
- else
- write(nfout,99) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
+ fmt2 = ",' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)"
+ if(dabs(etotal) <1.e13) then
+ fmt = "(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20."//trim(ndecimals)//trim(fmt2)
+ else
+ fmt = "(' TOTAL ENERGY FOR',i6,' -TH ITER=',d20.12"//trim(fmt2)
end if
-91 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.12,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-92 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.11,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-93 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.10,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-94 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.9,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-95 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.8,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-96 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.7,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-97 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.6,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-98 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.5,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
-99 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',d20.12,' EDEL = ',d14.6, ' : SOLVER = ',A, ' : ',A,' = ',A)
+ write(nfout,fmt) iteration,etotal,edel,trim(solver_names_applied(1)),trim(tag_mixing),trim(cdmixing_names_applied(1))
+ ! T. Yamasaki, 2023/07/09
else if(number_of_solvers_applied == 2) then
- if(dabs(etotal) <1.e6) then
-!!$ write(nfout,'(" TOTAL ENERGY FOR",I6," -TH ITER=",F20.12," edel = ",D14.6," : SOLVER = ",A," + ",A," : ",A," = ",A)') &
-!!$ & iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
-!!$ & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- write(nfout,81) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e7) then
- write(nfout,82) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e8) then
- write(nfout,83) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) <1.e9) then
- write(nfout,84) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) < 1.e10) then
- write(nfout,85) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) < 1.e11) then
- write(nfout,86) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) < 1.e12) then
- write(nfout,87) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
- else if(dabs(etotal) < 1.e13) then
- write(nfout,88) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
+ fmt2 = ",' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)"
+ if(dabs(etotal) <1.e13) then
+ fmt = "(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20."//trim(ndecimals)//trim(fmt2)
else
- write(nfout,89) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
- & , trim(tag_mixing), trim(cdmixing_names_applied(1))
-!!$ else
-!!$#ifdef FORTRAN2008
-!!$ write(nfout,'(" TOTAL ENERGY FOR",I6," -TH ITER=",G0," edel = ",D14.6," : SOLVER = ",A," + ",A," : ",A," = ",A)') &
-!!$#else
-!!$ write(nfout,'(" TOTAL ENERGY FOR",I6," -TH ITER=",G20.13," edel = ",D14.6," : SOLVER = ",A," + ",A," : ",A," = ",A)') &
-!!$#endif
-!!$ & iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
-!!$ & , trim(tag_mixing), trim(cdmixing_names_applied(1))
+ fmt = "(' TOTAL ENERGY FOR',i6,' -TH ITER=',d20.12"//trim(fmt2)
end if
-81 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.12,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-82 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.11,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-83 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.10,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-84 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.9,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-85 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.8,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-86 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.7,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-87 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.6,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-88 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',f20.5,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
-89 format(' TOTAL ENERGY FOR',i6,' -TH ITER=',d20.12,' EDEL = ',d14.6, ' : SOLVER = ',A,' + ',A,' : ',A,' = ',A)
+ write(nfout,fmt) iteration, etotal, edel, trim(solver_names_applied(1)),trim(solver_names_applied(2)) &
+ & , trim(tag_mixing), trim(cdmixing_names_applied(1))
+ ! T. Yamasaki, 2023/07/09
else
write(nfout,600) iteration,etotal,edel
-!!$ write(nfout,*) " TOTAL ENERGY FOR ",iteration
-!!$ call flush(nfout)
-!!$ write(nfout,*) " -TH ITER", etotal
-!!$ call flush(nfout)
-!!$ write(nfout,*) " edel = ", edel
-!!$ call flush(nfout)
-!!$ write(nfout,'(" TOTAL ENERGY FOR",i6," -TH ITER=",f20.8," edel = ",d14.6)') iteration, etotal, edel
end if
+ EPC_t = epc; if ( flg_paw ) EPC_t = epc_paw ! T.Y., 2023/07/09
if(sw_output_xc_seperately==OFF)then
- if ( flg_paw ) then
- write(nfout,610) ekinet,ehartr,exc,elocal, &
- & enonlc,eewald,-epc_paw,eentropy
- else
- write(nfout,610) ekinet,ehartr,exc,elocal, &
- & enonlc,eewald,-epc,eentropy
- endif
+ write(nfout,610) ekinet,ehartr,exc,elocal,enonlc,eewald,-EPC_t,eentropy ! T.Y., 2023/07/09
else
- if ( flg_paw ) then
- write(nfout,615) ekinet,ehartr,eex,ecor,exc,elocal, &
- & enonlc,eewald,-epc_paw,eentropy
- else
- write(nfout,615) ekinet,ehartr,eex,ecor,exc,elocal, &
- & enonlc,eewald,-epc,eentropy
- endif
+ write(nfout,615) ekinet,ehartr,eex,ecor,exc,elocal,enonlc,eewald,-EPC_t,eentropy ! T.Y., 2023/07/09
endif
if(sw_dipole_correction == ON) write(nfout,630) evdip,evext,edip
@@ -767,9 +701,7 @@
if(way_of_smearing == COLD .or. way_of_smearing == PARABOLIC &
& .and. abs(eentropy)>=DELTA ) write(nfout,620) etotal0
-! =============== KT_add =========================================== 13.0E
- if (way_of_smearing == Fermi_Dirac ) write(nfout,620) etotal0
-! ================================================================== 13.0E
+ if (way_of_smearing == Fermi_Dirac ) write(nfout,620) etotal0 ! === KT_add === 13.0E
if (way_of_smearing == MP) write(nfout,620) etotal0
@@ -785,9 +717,7 @@
end if
! ==============================================================================
-! ====================================== added by K. Tagami =============== 11.0
- if ( sw_magnetic_constraint == ON ) write(nfout,700) emag0, emag1
-! ========================================================================= 11.0
+ if ( sw_magnetic_constraint == ON ) write(nfout,700) emag0, emag1 ! === added by K. Tagami === 11.0
! ====================================== added by K. Tagami =============== 11.0
!!#ifdef USE_ESPINORB
@@ -821,8 +751,6 @@
! ================================== added by K. Tagami ================== 11.0
700 FORMAT(" Emag0=",F15.7," Emag1=",F15.7)
-710 FORMAT(" ESpinOrb_old=",F15.7," ESpinOrb_now=",F15.7)
-720 FORMAT(" ESpinOrb=",F15.7)
! ======================================================================== 11.0
end subroutine sumup_all_energies
@@ -849,8 +777,8 @@
if(iteration_electronic == 1) iincre = 0
!edeltb = etotal - etoold
edeltb = cal_edeltb()
- if(ipri >= 2) write(nfout,'(" ! edeltb = ",d14.6 &
- & ," hr (= ",d14.6," hr/atom ) ( iter = ",i7," )")') edeltb,edeltb/natm2,iteration
+ if(ipri >= DEBUGPRINTLEVEL) write(nfout,'(" ! edeltb = ",d14.6 &
+ & ," hr (= ",d14.6," hr/atom ) ( iter = ",i7," )")') edeltb,edeltb/natm2,iteration
if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) then
m_TE_is_Divergent_core = .false.
@@ -876,6 +804,13 @@
!!$ else if(iincre > 0) then
!!$ iincre = iincre - 1
!!$ end if
+!!$ if(iteration_electronic >= 10) then
+!!$ if(edeltb/natm2 >= 1.0/Hartree) then
+!!$ iincre = iincre + (edeltb/natm2)/(1.0/Hartree)
+!!$ else
+!!$ iincre = iincre - 1
+!!$ end if
+!!$ end if
if(edeltb > 1.d-7 .and. iincre /= 0 .and. printable) &
& write(nfout,*) ' !W IINCRE is increasing as ', iincre
if(iincre > IINCRE_CRITICAL) then
diff -ruN phase0_2023.01/src_phase_3d/m_constraints.F90 phase0_2023.01.01/src_phase_3d/m_constraints.F90
--- phase0_2023.01/src_phase_3d/m_constraints.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_constraints.F90 2023-11-09 12:02:33.653110203 +0900
@@ -821,16 +821,24 @@
endif
end subroutine parse_mobile_and_monitor
- subroutine prep_reac_coords_1D(constrainable_coord,uni)
+ subroutine prep_reac_coords_1D(constrainable_coord,uni,min_val)
type(constrainable_coords_t), intent(inout) :: constrainable_coord
integer, intent(in) :: uni
+ real(DP), intent(in), optional :: min_val
character(len=256) :: tag
integer :: f_getIntValue, f_getRealValue,f_selectBlock,f_selectParentBlock
integer :: i
integer :: iret
real(DP) :: dret
real(DP) :: factor
- real(DP) :: fval,incre
+ real(DP) :: fval,incre,val
+ logical :: has_minval
+ real(DP) :: mval
+ has_minval = .false.
+ if(present(min_val)) then
+ mval = min_val
+ has_minval = .true.
+ endif
tag=''
if( f_selectBlock(tag_reaction_coordinate)==0 ) then
factor = 1
@@ -866,6 +874,13 @@
allocate(constrainable_coord%finished(constrainable_coord%n_reaction_coords+1))
constrainable_coord%finished=.false.
do i=1,constrainable_coord%n_reaction_coords
+ val = constrainable_coord%value(1) + incre*i
+ if(has_minval) then
+ if (val<min_val) then
+ constrainable_coord%n_reaction_coords = constrainable_coord%n_reaction_coords-1
+ cycle
+ endif
+ endif
constrainable_coord%reaction_coords(i,1) = constrainable_coord%value(1) &
& + incre * i
enddo
@@ -1061,7 +1076,7 @@
iret = f_selectParentBlock()
endif
constrainable_coord%value(1) = get_curr_dfc(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_dfc_constraint
real(kind=DP) function get_curr_dfc(constrainable_coord)
@@ -1160,7 +1175,7 @@
endif
constrainable_coord%value(1) = get_curr_dfp(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,DISTANCE_FROM_POS)
+ call prep_reac_coords_1D(constrainable_coord,DISTANCE_FROM_POS,very_small)
end subroutine read_dfp_constraint
end module distance_from_pos_constraint
@@ -1294,7 +1309,7 @@
endif
constrainable_coord%value(1) = get_distance_between_com(1,2,constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_bl_constraint
@@ -1460,7 +1475,6 @@
'you must specify at least four atoms in order to define a '//trim(constrainable_coord%nam)//' constraint' &
,__LINE__,__FILE__)
endif
- constrainable_coord%n_associated_atoms = ntot
call alloc_constrainable_coord(constrainable_coord)
call parse_mobile_and_monitor(constrainable_coord)
if(f_selectBlock('dihedral')==0)then
@@ -2111,7 +2125,7 @@
constrainable_coord%value(1) = get_curr_coord_num(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,NO_UNIT)
+ call prep_reac_coords_1D(constrainable_coord,NO_UNIT,very_small)
end subroutine read_coord_num_constraint
@@ -2279,7 +2293,7 @@
call parse_mobile_and_monitor(constrainable_coord)
constrainable_coord%value(1) = get_curr_bl_sum(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_bl_sum_constraint
function get_indices(constrainable_coord)
@@ -2653,7 +2667,7 @@
call alloc_constrainable_coord(constrainable_coord,allocate_map = .false.)
call parse_mobile_and_monitor(constrainable_coord)
constrainable_coord%value(1) = get_curr_distance_from_ref(constrainable_coord)
- call prep_reac_coords_1D(constrainable_coord,LENGTH)
+ call prep_reac_coords_1D(constrainable_coord,LENGTH,very_small)
end subroutine read_dref_constraint
diff -ruN phase0_2023.01/src_phase_3d/m_dimer.F90 phase0_2023.01.01/src_phase_3d/m_dimer.F90
--- phase0_2023.01/src_phase_3d/m_dimer.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/m_dimer.F90 2023-11-09 12:02:33.667110276 +0900
@@ -114,8 +114,8 @@
end if
dimvars%for(i,:,:) = forc_l(:,:)
dimvars%ene(i) = etotal
- write(nfout,'(a,i8,f20.10)') '!** DIMER METHOD energy for atom ',i,dimvars%ene(i)
- write(nfout,'(a,i8)') '!** DIMER METHOD forces for atom ',i
+ write(nfout,'(a,i8,f20.10)') '!** dimer method energy for configuration ',i,dimvars%ene(i)
+ write(nfout,'(a,i8)') '!** dimer method forces for configuration ',i
do ia=1, dimvars%natm
write(nfout,'(i8,3f20.10)') ia,dimvars%for(i,ia,1:3)
enddo
@@ -203,7 +203,7 @@
pos(ia,1:3) = matmul(transpose(rltv),r(ia,1:3))/PAI2
end do
if(mype == 0) then
- write(nfout,'(a,i5)') '!** DIMER METHOD coordinates for dimer ',i
+ write(nfout,'(a,i5)') '!** dimer method coordinates for configuration ',i
do ia=1, dimvars%natm
write(nfout,'(i8,3f20.10)') ia,cps(ia,1:3)
enddo
@@ -233,7 +233,7 @@
call alloc_dimer(natm)
do i=1, dimvars%natm
dimvars%mobile(i) = imdtyp(i)
- if(mype==0) write(nfout,'(a,2i8)') '!** DIMER METHOD moblie',i,dimvars%mobile(i)
+ if(mype==0) write(nfout,'(a,2i8)') '!** dimer method moblie',i,dimvars%mobile(i)
enddo
dimvars%dR = delta_r
dimvars%dtheta = delta_theta
@@ -278,10 +278,13 @@
subroutine finalize_dimer_method()
use m_Files, only : nfdynm, nfenf, m_Files_close_all, m_Files_close_logfile
+ use m_Control_parameters, only : terminated_because
+ use m_Const_Parameters, only : FORCE_CONVERGENCE_REACHED
call dealloc_dimer()
close(nfdynm)
close(nfenf)
call m_Files_close_all()
+ terminated_because = FORCE_CONVERGENCE_REACHED
call PrintStatus()
call m_Files_close_logfile()
end subroutine finalize_dimer_method
@@ -317,7 +320,7 @@
dimvars%dt = neb_dt
dimvars%max_dimer_iteration = 2000
!pp_generated = .false.
- write(nfout,'(a,f15.5)') '!** DIMER METHOD dt',dimvars%dt
+ write(nfout,'(a,f15.5)') '!** dimer method dt',dimvars%dt
end subroutine alloc_dimer
subroutine set_r1_r2(natm, r1, r2)
@@ -332,7 +335,7 @@
if(mype==0) then
do i=1, dimvars%natm
! if (dimvars%mobile(i)==ON) then
- write(nfout,'(a,i10,3f10.5)') '!** DIMER METHOD vector N ',i,dimvars%N(i,1:3)
+ write(nfout,'(a,i10,3f10.5)') '!** dimer method vector N ',i,dimvars%N(i,1:3)
! endif
enddo
endif
@@ -383,7 +386,7 @@
enddo
dimvars%curvature = 0.5d0*dimvars%curvature/dimvars%dR
if(printable) then
- write(nfout,'(a,f15.5)') '!** DIMER METHOD curvature',dimvars%curvature
+ write(nfout,'(a,f15.5)') '!** dimer method curvature',dimvars%curvature
endif
end subroutine cal_curvature
@@ -391,7 +394,7 @@
integer :: i
real(kind=DP) :: fac
dimvars%e = dimvars%ene(1) + dimvars%ene(2)
- write(nfout,'(a,f15.5)') '!** DIMER METHOD dimer energy ',dimvars%e
+ write(nfout,'(a,f15.5)') '!** dimer method dimer energy ',dimvars%e
dimvars%e0 = dimvars%e*0.5d0
fac = 0.25d0*dimvars%dR
do i=1, dimvars%natm
@@ -400,7 +403,7 @@
! endif
enddo
if(printable) then
- write(nfout,'(a,f15.5)') '!** DIMER METHOD e0',dimvars%e0
+ write(nfout,'(a,f15.5)') '!** dimer method e0',dimvars%e0
endif
end subroutine cal_dimer_energies
@@ -424,7 +427,7 @@
if(mype==0) then
do i=1, dimvars%natm
! if(dimvars%mobile(i)) then
- write(nfout,'(a,i8,3f20.10)') '!** DIMER METHOD theta',i,dimvars%theta(i,1:3)
+ write(nfout,'(a,i8,3f20.10)') '!** dimer method theta',i,dimvars%theta(i,1:3)
! endif
enddo
endif
@@ -459,7 +462,7 @@
call normalize(dimvars%natm, dimvars%N)
if(printable) then
do i=1, dimvars%natm
- write(nfout,'(a,i10,3f10.5)') '!** DIMER METHOD vector N ',i,dimvars%N(i,1:3)
+ write(nfout,'(a,i10,3f10.5)') '!** dimer method vector N ',i,dimvars%N(i,1:3)
enddo
endif
end subroutine update_N
@@ -534,7 +537,7 @@
dimvars%max_force = fmax
deallocate(transfor)
- if(mype==0) write(nfout, '(a,f15.8)') '!** DIMER METHOD max translational force ',fmax
+ if(mype==0) write(nfout, '(a,f15.8)') '!** dimer method max translational force ',fmax
end subroutine translate_dimer
@@ -728,7 +731,7 @@
call write_result(idimer)
if(dimvars%max_force<dimvars%threshold) then
if(printable) write(nfout,'(a,f15.8)') &
- '!** DIMER METHOD reached convergence. max translational force : ',dimvars%max_force
+ '!** dimer method reached convergence. max translational force : ',dimvars%max_force
exit
endif
enddo
@@ -742,4 +745,3 @@
implicit none
call m_dm_do_dimer_method()
end subroutine do_dimer_method
-
diff -ruN phase0_2023.01/src_phase_3d/mdmain.F90 phase0_2023.01.01/src_phase_3d/mdmain.F90
--- phase0_2023.01/src_phase_3d/mdmain.F90 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/mdmain.F90 2023-11-09 12:02:33.702110460 +0900
@@ -980,7 +980,7 @@
if(iteration-first_iteration_of_this_job <= 0 .or. iteration_scdft<=1) then
Break_SC_DFT = .false.
else
- if(dabs(epsilon0 - epsilon0_previous) < max(0.0, delta_epsilon)) then
+ if(dabs(epsilon0 - epsilon0_previous) < max(0.d0, delta_epsilon)) then
Break_SC_DFT = .true.
else
if(iteration_scdft > max_scdft_iteration) then
diff -ruN phase0_2023.01/src_phase_3d/update_version_h.sh phase0_2023.01.01/src_phase_3d/update_version_h.sh
--- phase0_2023.01/src_phase_3d/update_version_h.sh 2023-06-28 09:27:13.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/update_version_h.sh 2023-11-09 12:02:33.688110386 +0900
@@ -1,6 +1,6 @@
#!/bin/sh
if [ -e ../.git ];then
-echo -n 'character(len=40), parameter :: commit_id = ' > version.h ; git rev-parse --sq HEAD >> version.h
+echo -n 'character(len=40), parameter :: commit_id = ' > version.h ; git rev-parse --sq HEAD >> version.h ; echo >> version.h
else
-echo -n "character(len=40), parameter :: commit_id = 'unknown'" > version.h
+echo "character(len=40), parameter :: commit_id = 'unknown'" > version.h
fi
diff -ruN phase0_2023.01/src_phase_3d/version.h phase0_2023.01.01/src_phase_3d/version.h
--- phase0_2023.01/src_phase_3d/version.h 2023-06-28 09:28:07.000000000 +0900
+++ phase0_2023.01.01/src_phase_3d/version.h 2023-11-09 12:02:33.646110167 +0900
@@ -1 +1 @@
-character(len=40), parameter :: commit_id = '297be2ee5c8c4fd395a4de15a7a54b0984ce518c'
\ ファイル末尾に改行がありません
+character(len=40), parameter :: commit_id = '4d1db69edbcf1176ee168b84fb4caad2e1e451c7'