! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.40)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine ac_main( filename )
  use ac_misc_module
  use ac_mpi_module
  implicit none

  character(len=*), intent(in) :: filename

  call Param__read(filename)
  !!call Param__readMX(filename)

  call Param__setup(0)
  call Param__show

  if( Param%Option%optimize ) then

     if( Param%SCF%opt_iter_max == 0 ) then
        call ac_solve
        call Force__calc
        call Force__show
     else
        call ac_optimize
     end if
  else
     call ac_solve
  end if

  if( Param%Option%phonon ) then
     call ac_phonon
  end if

  if( Param%Band%fname /= "" ) then
     call Hamiltonian__calcBandMap
  end if

  if( Param%DOS%fname /= "" ) then
     call Hamiltonian__calcDOS
  end if

  if( Param%MO%fbase /= "" ) then
     call Hamiltonian__calcMO
  end if

  call Hamiltonian__deallocate

  call Potential__deallocate
  call Density__deallocate
  call Base__deallocate
  call Param__deallocate


  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*)
  write(16,*) '******************** **************** ********************'
  write(16,*) '*                      output files                      *'
  write(16,*) '******************** **************** ********************'
  write(16,*)
  write(16,*) '          Chemical potential & Total energy -> energy.dat'
  write(16,*) '                               Energy level -> level_**.dat'
  write(16,*) '                             charge at site -> charge_per.dat'
  if( Param%Option%optimize ) then
     write(16,*) '                                 Force data -> force.dat'
     if( Param%SCF%opt_iter_max /= 0 ) then
        write(16,*) '                             Structure data -> structure.dat'
     end if
  end if
  write(16,*)
  write(16,*)
  write(16,*)
  write(16,*) ':-:-:-:-:-:-:-:-:-:-:-:-:-:-:-::-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:'
  write(16,*) ':-:-:-:-:-:-:-:-:-:-:-:-:-:-:-::-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:'
  write(16,*) ':-:-:-:-:-:-:-:-:                            :-:-:-:-:-:-:-:-:'
  write(16,*) ':-:-:-:-:-:-:-:-:           finished         :-:-:-:-:-:-:-:-:'
  write(16,*) ':-:-:-:-:-:-:-:-:                            :-:-:-:-:-:-:-:-:'
  write(16,*) ':-:-:-:-:-:-:-:-:-:-:-:-:-:-:-::-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:'
  write(16,*) ':-:-:-:-:-:-:-:-:-:-:-:-:-:-:-::-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:'
  write(16,*)
  close(16)

  return
end subroutine ac_main

subroutine ac_solve
  use ac_misc_module
  use ac_mpi_module
  implicit none

  call MPI__setup
  call Base__setup
  call Density__setup
  call Potential__setup
  call Hamiltonian__calcSCF

  return
end subroutine ac_solve

subroutine backupOptimizePosition
  use ac_misc_module
  implicit none

  integer :: a

  do a=0, Param%Data%natom-1
     Param%Data%vatom(a)%opt_position = Param%Data%vatom(a)%Ro
  end do

  return
end subroutine backupOptimizePosition

subroutine calcOptimizeDirectionSD( iter )
  use ac_misc_module
  implicit none

  integer, intent(in) :: iter
  integer :: a

  do a=1, Param%Data%natom
     if( .not. Param%Data%vatom(a)%optimize ) then
        Param%Data%vatom(a)%opt_direction = 0.d0
     else
        Param%Data%vatom(a)%opt_direction = Param%Data%vatom(a)%force
     end if
  end do

  return
end subroutine calcOptimizeDirectionSD

subroutine calcOptimizeDirectionCG( iter )
  use ac_misc_module
  implicit none

  integer, intent(in) :: iter
  integer :: a

  real(8) :: norm_force
  real(8), save :: norm_force_prev

  call Force__calcNorm(norm_force)

  if( iter == 1 ) then
     do a=1, Param%Data%natom
        if( .not. Param%Data%vatom(a)%optimize ) then
           Param%Data%vatom(a)%opt_direction = 0.d0
        else
           Param%Data%vatom(a)%opt_direction = Param%Data%vatom(a)%force
        end if
     end do
  else
     do a=1, Param%Data%natom
        if( .not. Param%Data%vatom(a)%optimize ) then
           Param%Data%vatom(a)%opt_direction = 0.d0
        else
           Param%Data%vatom(a)%opt_direction &
                = Param%Data%vatom(a)%opt_direction * (norm_force/norm_force_prev) + Param%Data%vatom(a)%force
        end if
     end do
  end if

  norm_force_prev = norm_force

  return
end subroutine calcOptimizeDirectionCG

subroutine calcOptimizeDirectionDIIS( iter )
  use ac_misc_module
  implicit none

  integer, intent(in) :: iter
  integer :: a
  real(8), allocatable :: matrix(:,:)
  real(8), allocatable :: alpha(:)
  integer, allocatable :: ipiv(:)
  real(8), allocatable :: work(:)
  integer :: n, m
  integer :: info

  if( Param%SCF%mix_start < Param%SCF%mix_history ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) '      ++++++ Error!: too small mixing start for Pulay mixing'
     close(16)
     Param%SCF%mix_start = Param%SCF%mix_history
  end if

  if( iter==1 ) then
     do a=1, Param%Data%natom
        allocate( Param%Data%vatom(a)%force_past(3,Param%SCF%mix_history) )
     end do
  end if

  do n=Param%SCF%mix_history, 2, -1
     do a=1, Param%Data%natom
        Param%Data%vatom(a)%force_past(:,n)  = Param%Data%vatom(a)%force_past(:,n-1)
     end do
  end do
  do a=1, Param%Data%natom
     if( .not. Param%Data%vatom(a)%optimize ) then
        Param%Data%vatom(a)%force_past(:,1) = 0.d0
     else
        Param%Data%vatom(a)%force_past(:,1) = Param%Data%vatom(a)%force
     end if
  end do

  if( iter < Param%SCF%mix_history ) then
     do a=1, Param%Data%natom
        Param%Data%vatom(a)%opt_direction = Param%Data%vatom(a)%force_past(:,1)
     end do
  else
     allocate( matrix(Param%SCF%mix_history,Param%SCF%mix_history) )
     allocate( alpha(Param%SCF%mix_history) )
     allocate( ipiv(Param%SCF%mix_history) )
     allocate( work(4*Param%SCF%mix_history) )

     do n=1, Param%SCF%mix_history
        do m=n, Param%SCF%mix_history
           matrix(n,m) = 0.0d0
           do a=1, Param%Data%natom
              matrix(n,m) = matrix(n,m) &
                   + sum(Param%Data%vatom(a)%force_past(:,n) * Param%Data%vatom(a)%force_past(:,m))
           end do
        end do
     end do

     do n=1, Param%SCF%mix_history
        alpha(n) = 1.d0
     end do

     call dsysv( 'U', Param%SCF%mix_history, 1, matrix, &
          Param%SCF%mix_history, ipiv, alpha, &
          Param%SCF%mix_history, work, 4*Param%SCF%mix_history, info, 1 )

     alpha(:) = alpha(:)*(1.d0/sum(alpha(:)))

     do a=1, Param%Data%natom
        Param%Data%vatom(a)%opt_direction = 0.d0
     end do

     do a=1, Param%Data%natom
        if( .not. Param%Data%vatom(a)%optimize ) cycle

        do n=1, Param%SCF%mix_history
           Param%Data%vatom(a)%opt_direction = &
                Param%Data%vatom(a)%opt_direction &
                + Param%Data%vatom(a)%force_past(:,n) * alpha(n)
        end do
     end do

     deallocate( matrix )
     deallocate( alpha )
     deallocate( ipiv )
     deallocate( work )
  end if

  return
end subroutine calcOptimizeDirectionDIIS

subroutine moveOptimizeDirection( alpha )
  use ac_misc_module
  implicit none

  real(8), intent(in) :: alpha
  integer :: a

  do a=0, Param%Data%natom-1
     if( .not. Param%Data%vatom(a)%optimize ) cycle

     Param%Data%vatom(a)%Ro = &
          Param%Data%vatom(a)%opt_position + alpha * Param%Data%vatom(a)%opt_direction
  end do

  return
end subroutine moveOptimizeDirection

subroutine ac_optimize
  use ac_misc_module
  use ac_mpi_module
  implicit none

  integer :: a
  real(8) :: norm_force
  real(8) :: alpha, beta
  real(8) :: Ea, dEba, dEca
  integer :: iter

  open(unit=16,file=Param%Option%file_ac_tempout,position='append')
  write(16,*)
  write(16,*)
  write(16,*)
  write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
  write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
  write(16,*) '>>>>>>>>>>>> START OPTIMIZING GEOMETRIC STRUCTURE <<<<<<<<<<<<'
  write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
  write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
  write(16,*)
  close(16)

  alpha=0.d0
  beta=0.d0

  do iter=1, Param%SCF%opt_iter_max
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>> iterations (optimize):',iter
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     close(16)

     call backupOptimizePosition

     call Param__Structure__show
     call ac_solve
     Ea = Energy%Etot

     call Force__calc
     call Force__show
     call Force__calcNorm(norm_force)

     norm_force = sqrt(norm_force)

     if( norm_force < Param%SCF%force_criterion ) then
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*)'   ### :: optimization :: converged #################################'
        write(16,973) Param%SCF%force_criterion,alpha,beta
973     format('    #ab###            ',f20.13,2f10.4,'  ###ba#')
        write(16,974) iter,norm_force,Ea
974     format('    #fc###       ',i5,f20.13,f20.6,'  ###cf#')
        write(16,*)'   ##################################################################'
        close(16)
        exit
     else
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*)'   ### :: optimization ##############################################'
        write(16,975) Param%SCF%force_criterion,alpha,beta
975     format('    #ab###            ',f20.13,2f10.4,'  ###ba#')
        write(16,976) iter,norm_force,Ea
        write(16,*)'   ##################################################################'
976     format('    #fn###       ',i5,f20.13,f20.6,'  ###nf#')
        close(16)
     end if

     select case( Param%Option%optimize_method )
     case('sd')
        call calcOptimizeDirectionSD( iter )
     case('cg')
        call calcOptimizeDirectionCG( iter )
     case('diis')
        call calcOptimizeDirectionDIIS( iter )
     end select

     alpha = 0.10d0 / norm_force

100  continue

     call moveOptimizeDirection( alpha )

     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     close(16)
     call ac_solve
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*)
     close(16)
     dEba = Energy%Etot - Ea
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,978) alpha*norm_force,dEba
978  format('   **ea1**   point B: ',f20.13,f20.6,'  **1ae**')
     close(16)

     if( dEba > 0.0d0 ) then
        alpha = alpha*0.25d0
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>> retry B <<<<<<<<<<<<<<<<<<<<<<<<<<<'
        close(16)
        goto 100
     end if

     call moveOptimizeDirection( alpha*2.0d0 )

     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     close(16)
     call ac_solve
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*)
     close(16)
     dEca = Energy%Etot - Ea
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,977) alpha*2.0d0*norm_force,dEca
977  format('   **ea2**   point C: ',f20.13,f20.6,'  **2ae**')
     close(16)

     if( dEca < 2*dEba ) then
        alpha = alpha*4.00d0
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>> retry C <<<<<<<<<<<<<<<<<<<<<<<<<<<'
        close(16)
        goto 100
     end if

     beta = 0.5d0 * (dEca-4.0d0*dEba)/(dEca-2.0d0*dEba)

     if( beta > 4.0d0 ) then
        alpha = alpha*4.00d0
        open(unit=16,file=Param%Option%file_ac_tempout,position='append')
        write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>> retry D <<<<<<<<<<<<<<<<<<<<<<<<<<<'
        close(16)
        goto 100
     end if

     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,979) alpha*beta*norm_force,beta
979  format('   **mov**        D : ',f20.13,f20.6,'  **mov**')
     close(16)
     call moveOptimizeDirection( alpha*beta )

  end do

  if( norm_force < Param%SCF%force_criterion ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*)
     write(16,*)
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>> FINISHED: OPTIMIZING GEOMETRIC STRUCTURE <<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*)
     close(16)
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,*)
     write(16,*)
     write(16,*)
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>> FINISHED     :: not yet converged ::     <<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
     write(16,*)
     close(16)
  end if

  return
end subroutine ac_optimize
