!=======================================================================
!
!  PROGRAM  PHASE/0 2015.01 ($Rev: 440 $)
!
!  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
!  
!
!
!=======================================================================
!
!     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: mdmain.F90 440 2015-08-03 07:18:01Z ktagami $
!
#ifdef FJ_TIMER
#  define __TIMER_FJ_START_w_BARRIER(str,a)  call mpi_barrier(str,ierr); call timer_sta(a)
#  define __TIMER_FJ_START(a)                call timer_sta(a)
#  define __TIMER_FJ_STOP(a)                 call timer_end(a)
#else
#  define __TIMER_FJ_START_w_BARRIER(str,a)
#  define __TIMER_FJ_START(a)
#  define __TIMER_FJ_STOP(a)
#endif
#ifdef __TIMER__
#  define __TIMER_START_w_BARRIER(str,a)  call mpi_barrier(str,ierr) ;   call timer_sta(a)
#  define __TIMER_START(a)                call timer_sta(a)
#  define __TIMER_STOP(a)                 call timer_end(a)
#else
#  define __TIMER_START_w_BARRIER(str,a)
#  define __TIMER_START(a)
#  define __TIMER_STOP(a)
#endif
!
program PHASE


  use m_Const_Parameters,    only : DRIVER_NEB,DRIVER_CONSTRAINT,DRIVER_MTD
  use m_Parallelization,     only : mpi_comm_group


  implicit none
  logical  :: ChargeDensity_is_Converged, TotalEnergy_is_Divergent
  logical  :: Already_Converged, Already_Converged2
  logical  :: Positron_bulk, Positron_defect, Structure_is_fixed
  logical  :: Hubbard_model
  logical  :: Forces_are_Converged, Ending_Time, Force_errors_are_tolerable
  logical  :: from_Initialize
!!$  logical  :: ChargeDensity_is_Fixed
   interface
     subroutine Initialization(init_mpi)
       integer, intent(in), optional :: init_mpi
     end subroutine Initialization
   end interface
#ifdef NEC_ITER_REG
  integer  :: count_for_ftrace
#endif

  integer :: ispin, ik, iksnl, ierR

  integer :: initmpi
  logical :: confpara
  integer :: driver
  
#ifdef NEC_ITER_REG
     count_for_ftrace = 0
     call FTRACE_REGION_BEGIN("INITIAL")
#endif

  confpara = Resolve_Config_Parallel()
  initmpi=1
  if(confpara) initmpi=0
                                                  __TIMER_START(17)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,21)
!  call Initialization(init_mpi=1)
  call Initialization(initmpi)
                                                  __TIMER_FJ_STOP(21)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,22)
  call InputData_Analysis

  driver   = Resolve_Driver()
  if (driver==DRIVER_NEB)then
#ifndef DISABLE_CONSTRAINTS
      call do_neb()
  else if (driver==DRIVER_CONSTRAINT) then
      call constrained_dynamics()
  else if (driver==DRIVER_MTD) then
      call meta_dynamics()
#endif
  else
                                                  __TIMER_FJ_STOP(22)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,23)
  call Preparation                   ! Basis set, symmetry check etc.
                                                  __TIMER_FJ_STOP(23)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,24)
  call Preparation_for_mpi(1)        ! mpi
                                                  __TIMER_FJ_STOP(24)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,25)
  call PseudoPotential_Construction
                                                  __TIMER_FJ_STOP(25)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,26)
#ifdef ENABLE_ESM_PACK
  call Preparation_for_ESM
#endif

  call Ewald_and_Structure_Factor
                                                  __TIMER_FJ_STOP(26)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,27)
  call Initial_Electronic_Structure
                                                  __TIMER_FJ_STOP(27)
                                                  __TIMER_STOP(17)

 
  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

     if(.not.Already_Converged()) then
#ifdef NEC_ITER_REG
        call FTRACE_REGION_BEGIN("SOLVE-FIRST")
#endif
        StressLoop: do
           AtomicConfiguration: do
              ChargeDensity:    do

#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
                                                  __TIMER_START_w_BARRIER(mpi_comm_group,16)
!!$                 call ReadCheckPointData_if_needed
                 call Renewal_of_WaveFunctions
                                                  __TIMER_START_w_BARRIER(mpi_comm_group,11)
                 call ChargeDensity_Construction(0)
                 call ChargeDensity_Mixing
                                                  __TIMER_STOP(11)
                 if(Ending_Time()) then
                                                  __TIMER_STOP(16)
                    exit StressLoop
                 end if
                 if(TotalEnergy_is_Divergent()) then
                                                  __TIMER_STOP(16)
                    exit StressLoop
                 end if
                                                  __TIMER_START_w_BARRIER(mpi_comm_group,11)
                 call Renewal_of_Potential
                                                  __TIMER_STOP(11)
                 if(Hubbard_model()) then
                    call Renewal_of_Hubbard_Potential
                 end if
!!$                 call WriteCheckPointData  ! if necessary
                 if(ChargeDensity_is_Converged()) then
                                                  __TIMER_STOP(16)
                    exit ChargeDensity
                 end if
                                                  __TIMER_STOP(16)
              enddo ChargeDensity


              if(Positron_defect()) then
                 call Renewal_of_pPotential()
                 call Solve_pWaveFunctions()
              end if
              if(Structure_is_fixed()) then
                  exit StressLoop
              end if
              call Forces
              if(Forces_are_Converged()) then
                exit AtomicConfiguration
              endif
              if(Force_errors_are_tolerable()) then
                 call Postprocessing_during_MD()
                 call Move_Ions
                 call Ewald_and_Structure_Factor
                 call MDIterationNumber_Setting
              end if
           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

  if(ChargeDensity_is_Fixed() .and. One_by_one_in_each_rank_k()) then ! icond=2, 3
     call WriteDownData_onto_Files_ek()
  else
     call Postprocessing(.false.)
                                                  __TIMER_FJ_START_w_BARRIER(mpi_comm_group,39)
     call rttddft_main
     call WriteDownData_onto_Files(.true.)
                                                  __TIMER_FJ_STOP(39)
  end if

  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

  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 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

end program PHASE
