!=======================================================================
!
!  PROGRAM  PHASE/0 2014.01 (rev.375)
!
!  "First-principles Electronic Structure Calculation Program"
!
!  MAIN PROGRAM: PHASE
!
!  AUTHOR(S): T. Yamasaki   August/20/2003
!  
!  FURTHER MODIFICATION: T. Yamasaki, January/13/2004
!  
!  Contact address :  Phase System Consortium
!                     E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
!  
!
!
!=======================================================================
!
!   Since 2002, this program set had been intensively developed as a part of the following 
!  national projects supported by the Ministry of Education, Culture, Sports, Science and 
!  Technology (MEXT) of Japan; "Frontier Simulation Software for Industrial Science 
!  (FSIS)" from 2002 to 2005, "Revolutionary Simulation Software (RSS21)" from 2006 to 
!  2008. "Research and Development of Innovative Simulation Software (RISS)" from 2008 
!  to 2013. These projects is lead by the Center for Research on Innovative Simulation 
!  Software (CISS), the Institute of Industrial Science (IIS), the University of Tokyo.
!   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: mdmain0.F90 238 2012-11-12 04:11:13Z yamasaki $
!
program PHASE
#ifdef NEC_TIMER
  use nec_timer
#endif
  use m_Const_Parameters, only : DRIVER_CONSTRAINT, DRIVER_NEB, DRIVER_MTD
#ifdef PAW3D
  use m_Files,                only : nfout
  use m_Ionic_System,         only : natm
  use m_PseudoPotential,      only : mmesh
  use m_Parallelization,      only : m_Parallel_init_mpi_paw_3D
#endif
  implicit none
  logical  :: ChargeDensity_is_Converged, TotalEnergy_is_Divergent
  logical  :: Already_Converged, Already_Converged2
  logical  :: Positron_bulk, Positron_defect
  logical  :: Hubbard_model
  logical  :: Forces_are_Converged, Ending_Time, Force_errors_are_tolerable,UnitCell_Converged
!!$  logical  :: ChargeDensity_is_Fixed
#ifdef NEC_ITER_REG
  integer  :: count_for_ftrace
#endif

  integer :: initmpi
  logical :: confpara
  integer :: driver
  logical :: ending_t,force_conv,mpi_initialized,uconv
  logical :: initialization_required
  
#ifdef NEC_ITER_REG
     count_for_ftrace = 0
     call FTRACE_REGION_BEGIN("INITIAL")
#endif

  confpara = Resolve_Config_Parallel()
  initmpi=1
  if(confpara) initmpi=0
  mpi_initialized = .false.

  do

  ending_t = .false.
  if (mpi_initialized) initmpi=0
  call Initialization(initmpi)
  mpi_initialized = .true.
  call InputData_Analysis
  driver   = Resolve_Driver()

  if(driver == DRIVER_NEB) then
    call do_neb()
  else if(driver==DRIVER_CONSTRAINT) then
#ifndef DISABLE_CONSTRAINTS
    call constrained_dynamics()
#endif
  else if(driver==DRIVER_MTD) then
#ifndef DISABLE_CONSTRAINTS
    call meta_dynamics()
#endif
  else

  call Preparation                          ! Basis set, symmetry check etc.
  if(initialization_required())then
     call Preparation_for_mpi(1)     ! mpi
  endif
  call PseudoPotential_Construction
#ifdef PAW3D
  call  m_Parallel_init_mpi_paw_3D(nfout,natm,mmesh)
#endif
#ifdef ENABLE_ESM
  if(initialization_required())then
     call Preparation_for_ESM
  endif
#endif

  call Ewald_and_Structure_Factor
  call Initial_Electronic_Structure

  if(ChargeDensity_is_Fixed() .and. One_by_one_in_each_rank_k()) then ! icond=2, 3
     call ekcal  ! contained here
  else
     call Initial_MD_Condition
#ifdef NEC_ITER_REG
     call FTRACE_REGION_END("INITIAL")
#endif
     force_conv = Already_Converged()
     if(.not.force_conv) then
#ifdef NEC_ITER_REG
        call FTRACE_REGION_BEGIN("SOLVE-FIRST")
#endif
        StressLoop: do
           AtomicConfiguration: do
              ChargeDensity:    do
                 force_conv=.false.
#ifdef NEC_ITER_REG
                 count_for_ftrace = count_for_ftrace + 1
                 if(count_for_ftrace .eq. 2) then
                    call FTRACE_REGION_END("SOLVE-FIRST")
                    call FTRACE_REGION_BEGIN("SOLVE-CORE")
                 end if
#endif
                 call IterationNumber_Setting

! ============================ added by K. Tagami ============- 5.0
                 call Renewal_of_Chg_Ctrl_Param
! ============================================================ 5.0

                 call Renewal_of_WaveFunctions
                 call ChargeDensity_Construction(0)
                 call ChargeDensity_Mixing
                 ending_t = Ending_Time()
                 if(ending_t)                      exit StressLoop
                 if(TotalEnergy_is_Divergent())    exit StressLoop
                 call Renewal_of_Potential
                 if(Hubbard_model()) then
                    call Renewal_of_Hubbard_Parameters
                    call Renewal_of_Hubbard_Potential
                 end if
                 if(ChargeDensity_is_Converged())  exit ChargeDensity
              enddo ChargeDensity
              call Forces
              force_conv = Forces_are_Converged()
              if(force_conv) exit AtomicConfiguration
              if(Force_errors_are_tolerable()) then
                 call Postprocessing_during_MD()
                 call Move_Ions
                 call MDIterationNumber_Setting
                 call Ewald_and_Structure_Factor
!!$                 call MDIterationNumber_Setting
              end if
              if(BreakMD(force_conv))then
                 exit AtomicConfiguration
              endif
           enddo AtomicConfiguration
           call Stress
           exit StressLoop
        end do StressLoop
#ifdef NEC_ITER_REG
        if(count_for_ftrace .eq. 1) then
           call FTRACE_REGION_END("SOLVE-FIRST")
        else
           call FTRACE_REGION_END("SOLVE-CORE")
        end if
#endif
     end if

     if(Already_Converged2() .and. .not.Positron_defect() .and. Positron_bulk()) then
#ifdef NEC_ITER_REG
        call FTRACE_REGION_BEGIN("POSITRON")
#endif
        call Renewal_of_pPotential()
        call Solve_pWaveFunctions()
#ifdef NEC_ITER_REG
        call FTRACE_REGION_END("POSITRON")
#endif
     end if

#ifdef NEC_ITER_REG
     call FTRACE_REGION_BEGIN("FINAL")
#endif
  end if
  uconv = UnitCell_Converged(force_conv)
  if(.not.uconv.and..not.ending_t)then
     call MDIterationNumber_Setting2()
     call WriteDownData_onto_Files(.false.)
  else
     if(ChargeDensity_is_Fixed() .and. One_by_one_in_each_rank_k()) then ! icond=2, 3
        call WriteDownData_onto_Files_ek()
     else
        if(uconv) call Postprocessing(.false.)
        call WriteDownData_onto_Files(ending_t.or.uconv)
        if(uconv) exit
     end if
  endif

  if(.not.ending_t) then
     call Array_Deallocate()
     call Continuation_Mode()
  endif

  endif

  if (ending_t.or.OneShot()) exit

  enddo
#ifdef NEC_TIMER
  call print_timer()
#endif
  if(driver/=DRIVER_NEB) call Finalization_of_mpi           ! mpi
#ifdef NEC_ITER_REG
  call FTRACE_REGION_END("FINAL")
#endif
contains
  subroutine ekcal()
    logical :: AllKpoints_are_Calculated2, Already_Converged_for_Kgroup
    logical :: EigenValues_are_Converged, AllKpoints_are_Converged
    integer :: nk
    nk = 0
    KPOINT_GROUP: do
       call KpointNumber_Setting2()
       if(AllKpoints_are_Converged()) exit KPOINT_GROUP
       call Preparation_ek()
       call Preparation_for_mpi_ek
       call PseudoPotential_ek
       call Initial_WaveFunctions_ek
       if(.not.Already_Converged_for_kgroup()) then
          SolveWaveFunctions: do
             if(Ending_Time())                 exit KPOINT_GROUP
             call IterationNumber_Setting()
             call Renewal_of_WaveFunctions()
             if(EigenValues_are_Converged())   exit SolveWaveFunctions
          enddo SolveWaveFunctions
!!$          call Postprocessing_k()
          if(AllKpoints_are_Calculated2(nk))     exit KPOINT_GROUP
       else
          exit KPOINT_GROUP
       end if
    enddo KPOINT_GROUP
  end subroutine ekcal

  subroutine Continuation_Mode()
    use m_Const_Parameters,   only : COORDINATE_CONTINUATION,ON,OFF
    use m_Control_Parameters, only : icond, sw_optimize_lattice,sw_rebuild_pws
    if(sw_optimize_lattice==ON .and. sw_rebuild_pws==OFF) return
    icond = COORDINATE_CONTINUATION
  end subroutine continuation_mode

  subroutine Postprocessing_during_MD()
    use m_IterationNumbers, only : iteration_ionic
    use m_Control_Parameters, only : postproc_frequency
    if(postproc_frequency<=0) return
    if(mod(iteration_ionic,postproc_frequency)==0)then
       call Postprocessing(.true.)
    endif
  end subroutine Postprocessing_during_MD

  logical function BreakMD(conv)
    use m_IterationNumbers, only : iteration_ionic
    use m_Ionic_System, only : addition_frequency,m_IS_natm_can_change
    logical, intent(in) :: conv
    if(.not.m_IS_natm_can_change())then
       BreakMD = conv
       return
    endif
    BreakMD = mod(iteration_ionic,addition_frequency)==0
  end function BreakMD

  logical function OneShot()
    use m_Ionic_System, only : m_IS_natm_can_change
    use m_Control_Parameters, only : sw_optimize_lattice
    use m_Const_Parameters, only : OFF
    OneShot = .not.m_IS_natm_can_change()
    if(OneShot) then
        OneShot = sw_optimize_lattice==OFF
    endif
  end function OneShot

  logical function ChargeDensity_is_Fixed()
    use m_Control_Parameters, only : icond
    use m_Const_Parameters,   only : FIXED_CHARGE, FIXED_CHARGE_CONTINUATION
    if(icond == FIXED_CHARGE .or. icond == FIXED_CHARGE_CONTINUATION) then
       ChargeDensity_is_Fixed = .true.
    else
       ChargeDensity_is_Fixed = .false.
    end if
  end function ChargeDensity_is_Fixed

  logical function One_by_one_in_each_rank_k()
    use m_Control_Parameters, only : fixed_charge_k_parallel
    use m_Const_Parameters,   only : ONE_BY_ONE
    if(fixed_charge_k_parallel == ONE_BY_ONE) then
       One_by_one_in_each_rank_k = .true.
    else
       One_by_one_in_each_rank_k = .false.
    end if
  end function One_by_one_in_each_rank_k

  integer function Resolve_Driver()
    use m_Control_Parameters, only : driver
    Resolve_Driver = driver
  end function Resolve_Driver

  logical function Resolve_Config_Parallel()
    use m_Parallelization, only : m_Parallel_resolve_conf_para
    implicit none
    Resolve_Config_Parallel = m_Parallel_resolve_conf_para()
  end function Resolve_Config_Parallel

  subroutine Array_Deallocate()
   end subroutine Array_Deallocate
end program PHASE
