qmcchem/src/MAIN/admc.org

#+TITLE: Asynchronous DMC
#+AUTHOR: Anthony Scemama
#+EMAIL: scemama@irsamc.ups-tlse.fr


#+PROPERTY: header-args  :tangle no :noweb yes 


* Main program

** Declarations

  #+NAME: declarations
  #+begin_src f90 
  include '../types.F'

  integer          :: iter
  integer          :: k_full  ! Index of walkers in elec_coord_full
  integer          :: k_new   ! Index of walkers in elec_coord_new
  integer          :: iw      ! Number of copies in branching
  integer          :: l

  real, allocatable :: elec_coord_new(:,:,:)

  double precision :: w
  double precision, allocatable :: E_out(:), w_sum(:)

  double precision, external :: qmc_ranf                                                  

  allocate(elec_coord_new(elec_num+1,3,walk_num))
  allocate(E_out(walk_num), w_sum(walk_num))
  #+end_src

** Main flow

   - Fetch ~walk_num~ electron coordinates in ~elec_coord_full~
   - For each set of coordinates,
     - Make a PDMC trajectory, and output the weight ~w~
     - Perform branching depending on the value of the weight
     - Store the new sets of coordinates in ~elec_coord_new~
   - When ~elec_coord_new~ is full, send it to the server
     
  #+begin_src f90 :tangle "admc.irp.f" 
program admc
  call run
  call ezfio_finish
end program admc

subroutine run
  implicit none

  <<declarations>>
  
  ! Initialization
  if (vmc_algo /= t_Brownian) then
     call abrt(irp_here,'DMC should run with Brownian algorithm')
  endif

  do iter=1,1000
!    call read_coords()
     k_new  = 1
     do k_full=1,walk_num
        call pdmc_trajectory(k_full, w, E_out(k_full), w_sum(k_full))

        <<branching>>

       if (k_new >= walk_num) then
         w_sum(k_full+1:) = 0.d0
         exit
       end if
     end do
  
     k_new = k_new-1
     elec_coord_full(1:elec_num+1,1:3,1:k_new) = &
          elec_coord_new(1:elec_num+1,1:3,1:k_new)

!     call write_coords(k_new)
     call write_energy(walk_num, E_out, w_sum)
  end do

end subroutine run

<<read_coords>>
<<write_coords>>
<<write_energy>>
<<pdmc_trajectory>>
  #+end_src

** Branching

   #+NAME: branching
    #+begin_src f90
  ! Find number of copies
  iw = int(w)
  w = w - int(w)
  if (qmc_ranf() < w) then
     iw = iw+1
  end if

  ! Duplicate walker
  do l=1,iw
    elec_coord_new(1:elec_num+1,1:3,k_new) = &
         elec_coord(1:elec_num+1,1:3) 
    k_new = k_new+1
    if (k_new >= walk_num) exit
  end do

    #+end_src

* Read/write
  
** Read coordinates

   Fetch a new set of coordinates for ~walk_num~ walkers from the pool of coordinates.
  
   #+NAME: read_coords
   #+begin_src f90
subroutine read_coords()
  implicit none

  integer :: i, k

  do k=1,walk_num
     do i=1,elec_num
        read(*,*) elec_coord_full(i,1:3,k)
     end do
  end do

  SOFT_TOUCH elec_coord_full
     
end subroutine read_coords
   #+end_src

** Write coordinates

   Send the current set of coordinates for ~walk_num~ walkers to the pool of coordinates.
  
   #+NAME: write_coords
   #+begin_src f90
subroutine write_coords()
  implicit none

  integer :: i, k

  do k=1,walk_num
     do i=1,elec_num
        write(*,*) 'C', elec_coord_full(i,1:3,k)
     end do
  end do

end subroutine write_coords
   #+end_src

** Write energy

   Compute the weighted average over the computed energies.
  \[
     E = \frac{\sum_i w_i E_i}{\sum_i w_i}
  \]
  
   #+NAME: write_energy
   #+begin_src f90
subroutine write_energy(walk_num_, E_out, w_sum)
  implicit none
  integer, intent(in) :: walk_num_
  double precision, intent(in) :: E_out(walk_num_)
  double precision, intent(in) :: w_sum(walk_num_)

  integer :: i, k
  double precision :: E, S

  E = 0.d0
  S = 0.d0
  do k=1,walk_num
     S = S + w_sum(k)
     E = E + w_sum(k) * E_out(k)
  end do
  write(*,*) 'E', E/S, S

end subroutine write_energy
   #+end_src

* PDMC trajectory
  
  Computes a PDMC trajectory until the weight ~w~ is $1/2 < w < 3/2$.
  The energy of the trajectory is computed as
  \[
     E = \frac{\sum_i w_i E(R_i)}{\sum_i w_i}
  \]

  The function returns:
  - ~w~: the last of all $w_i$
  - ~E_out~: The average energy $E$ of the trajectory
  - ~w_sum~: The sum of the weights
    
  #+NAME: declarations_pdmc
  #+begin_src f90
  integer          :: i,j,l
  double precision :: delta

  ! If true, continue to make more steps
  logical :: loop

  ! Max number of steps
  integer :: imax
  integer, parameter :: nmax=10000

  ! Brownian step variables
  double precision               :: p,q
  real                           :: delta_x
  logical                        :: accepted

  ! Local energies from the past
  double precision :: E_loc_save(4)
  double precision :: w

  #+end_src
  
   #+NAME: pdmc_trajectory
   #+begin_src f90
subroutine pdmc_trajectory(k_full, pdmc_weight, E_out, w_sum)
  implicit none

  integer, intent(in) :: k_full
  double precision, intent(out) :: pdmc_weight, E_out, w_sum

  <<declarations_pdmc>>
  
  elec_coord(1:elec_num+1,1:3) = elec_coord_full(1:elec_num+1,1:3,k_full)
  TOUCH elec_coord

  E_out = 0.d0
  w_sum = 0.d0

  E_loc_save(1:4) = E_loc

  pdmc_weight = 1.d0
  loop = .True.

  do imax = 1, nmax

     call brownian_step(p,q,accepted,delta_x)

!    delta = (9.d0*E_loc+19.d0*E_loc_save(1)-5.d0*E_loc_save(2)+E_loc_save(3))/24.d0
     delta = E_loc
     delta = (delta - E_ref)*p

     if (delta >= 0.d0) then
       w = dexp(-dtime_step*delta)
     else
       w = 2.d0-dexp(dtime_step*delta)
     endif
     elec_coord(elec_num+1,1) += p*time_step
     elec_coord(elec_num+1,2)  = E_loc
     elec_coord(elec_num+1,3)  = pdmc_weight
     if (accepted) then
        E_loc_save(4) = E_loc_save(3) 
        E_loc_save(3) = E_loc_save(2) 
        E_loc_save(2) = E_loc_save(1) 
        E_loc_save(1) = E_loc
     endif

     w_sum = w_sum + pdmc_weight
     E_out = E_out + pdmc_weight * E_loc

     pdmc_weight = pdmc_weight * w

     loop = pdmc_weight > 0.5d0 .and. pdmc_weight < 2.0d0
     if (.not.loop) exit
     
  end do

  E_out = E_out / w_sum

end subroutine pdmc_trajectory
   #+end_src