m_mc_moves.f90 Source File


This file depends on

sourcefile~~m_mc_moves.f90~~EfferentGraph sourcefile~m_mc_moves.f90 m_mc_moves.f90 sourcefile~m_constants_math.f90 m_constants_math.f90 sourcefile~m_mc_moves.f90->sourcefile~m_constants_math.f90 sourcefile~m_globals.f90 m_globals.f90 sourcefile~m_mc_moves.f90->sourcefile~m_globals.f90 sourcefile~m_interaction.f90 m_interaction.f90 sourcefile~m_mc_moves.f90->sourcefile~m_interaction.f90 sourcefile~m_nbr_lists.f90 m_nbr_lists.f90 sourcefile~m_mc_moves.f90->sourcefile~m_nbr_lists.f90 sourcefile~m_precision.f90 m_precision.f90 sourcefile~m_mc_moves.f90->sourcefile~m_precision.f90 sourcefile~m_ran_num.f90 m_ran_num.f90 sourcefile~m_mc_moves.f90->sourcefile~m_ran_num.f90 sourcefile~m_constants_math.f90->sourcefile~m_precision.f90 sourcefile~m_globals.f90->sourcefile~m_precision.f90 sourcefile~m_ia_types.f90 m_ia_types.f90 sourcefile~m_globals.f90->sourcefile~m_ia_types.f90 sourcefile~m_trajectory.f90 m_trajectory.f90 sourcefile~m_globals.f90->sourcefile~m_trajectory.f90 sourcefile~m_interaction.f90->sourcefile~m_constants_math.f90 sourcefile~m_interaction.f90->sourcefile~m_globals.f90 sourcefile~m_interaction.f90->sourcefile~m_nbr_lists.f90 sourcefile~m_interaction.f90->sourcefile~m_precision.f90 sourcefile~m_ia_angle.f90 m_ia_angle.f90 sourcefile~m_interaction.f90->sourcefile~m_ia_angle.f90 sourcefile~m_ia_bond.f90 m_ia_bond.f90 sourcefile~m_interaction.f90->sourcefile~m_ia_bond.f90 sourcefile~m_ia_dihedral.f90 m_ia_dihedral.f90 sourcefile~m_interaction.f90->sourcefile~m_ia_dihedral.f90 sourcefile~m_ia_external.f90 m_ia_external.f90 sourcefile~m_interaction.f90->sourcefile~m_ia_external.f90 sourcefile~m_ia_tether.f90 m_ia_tether.f90 sourcefile~m_interaction.f90->sourcefile~m_ia_tether.f90 sourcefile~m_ia_vdw.f90 m_ia_vdw.f90 sourcefile~m_interaction.f90->sourcefile~m_ia_vdw.f90 sourcefile~m_qsort.f90 m_qsort.f90 sourcefile~m_interaction.f90->sourcefile~m_qsort.f90 sourcefile~m_nbr_lists.f90->sourcefile~m_globals.f90 sourcefile~m_nbr_lists.f90->sourcefile~m_precision.f90 sourcefile~m_table.f90 m_table.f90 sourcefile~m_nbr_lists.f90->sourcefile~m_table.f90 sourcefile~m_vector.f90 m_vector.f90 sourcefile~m_nbr_lists.f90->sourcefile~m_vector.f90 sourcefile~m_ran_num.f90->sourcefile~m_precision.f90 sourcefile~m_ia_angle.f90->sourcefile~m_constants_math.f90 sourcefile~m_ia_angle.f90->sourcefile~m_precision.f90 sourcefile~m_ia_angle.f90->sourcefile~m_ia_types.f90 sourcefile~m_spline.f90 m_spline.f90 sourcefile~m_ia_angle.f90->sourcefile~m_spline.f90 sourcefile~m_ia_bond.f90->sourcefile~m_constants_math.f90 sourcefile~m_ia_bond.f90->sourcefile~m_precision.f90 sourcefile~m_ia_bond.f90->sourcefile~m_ia_types.f90 sourcefile~m_ia_bond.f90->sourcefile~m_spline.f90 sourcefile~m_ia_dihedral.f90->sourcefile~m_constants_math.f90 sourcefile~m_ia_dihedral.f90->sourcefile~m_precision.f90 sourcefile~m_ia_dihedral.f90->sourcefile~m_ia_types.f90 sourcefile~m_ia_external.f90->sourcefile~m_constants_math.f90 sourcefile~m_ia_external.f90->sourcefile~m_precision.f90 sourcefile~m_ia_external.f90->sourcefile~m_ia_types.f90 sourcefile~m_ia_tether.f90->sourcefile~m_constants_math.f90 sourcefile~m_ia_tether.f90->sourcefile~m_precision.f90 sourcefile~m_ia_tether.f90->sourcefile~m_ia_types.f90 sourcefile~m_ia_types.f90->sourcefile~m_precision.f90 sourcefile~m_ia_vdw.f90->sourcefile~m_constants_math.f90 sourcefile~m_ia_vdw.f90->sourcefile~m_precision.f90 sourcefile~m_ia_vdw.f90->sourcefile~m_ia_types.f90 sourcefile~m_ia_vdw.f90->sourcefile~m_spline.f90 sourcefile~m_qsort.f90->sourcefile~m_precision.f90 sourcefile~m_table.f90->sourcefile~m_precision.f90 sourcefile~m_table.f90->sourcefile~m_vector.f90 sourcefile~m_trajectory.f90->sourcefile~m_precision.f90 sourcefile~m_vector.f90->sourcefile~m_precision.f90 sourcefile~m_vector.f90->sourcefile~m_qsort.f90

Files dependent on this one

sourcefile~~m_mc_moves.f90~~AfferentGraph sourcefile~m_mc_moves.f90 m_mc_moves.f90 sourcefile~m_mc_solver.f90 m_mc_solver.f90 sourcefile~m_mc_solver.f90->sourcefile~m_mc_moves.f90 sourcefile~m_setup.f90 m_setup.f90 sourcefile~m_setup.f90->sourcefile~m_mc_solver.f90 sourcefile~main.f90 main.f90 sourcefile~main.f90->sourcefile~m_mc_solver.f90 sourcefile~main.f90->sourcefile~m_setup.f90

Source Code

module m_mc_moves

use m_precision
use m_constants_math
use m_ran_num
use m_globals
use m_nbr_lists
use m_interaction

implicit none

private
public :: mcm_dspl, mcm_crnk, mcm_sc_crnk, mcm_pivot, mcm_dbl_pivot, &
        mcm_sc_pivot, mcm_res_pivot, coordinates_pvt, to_com

!Memory buffer for pivot moves (allocated & deallocated in module m_mc_solver)
real(rp), dimension(:,:), allocatable :: coordinates_pvt

contains
 
!******************************************************************************

subroutine mcm_dspl()
    !! Performs displacement move.

    real(rp), dimension(3) :: coords
    real(rp), dimension(3) :: rdspl
    real(rp) :: enrg_vdw, enrg_bnd, enrg_ang, enrg_dhd, enrg_teth
    real(rp) :: enrg_vdw_, enrg_bnd_, enrg_ang_, enrg_dhd_, enrg_teth_
    real(rp) :: energy_external_
    real(rp) :: enrg_dif
    integer  :: iatm
    integer  :: natmpts, naccept
    integer  :: iatmpt, iaccept
    integer  :: ierr

    !Number of attempts
    natmpts = num_mc_moves(5)

    !Initialize number of accepts to zero
    naccept = 0

    do iatmpt = 1, natmpts
        !Pick an atom
        iatm = get_iuniform(1, num_atoms+1)
        !Choose a random unit vector
        call ransphere(rdspl)
        !Scale the random unit vector to generate a displacement vector
        rdspl = rdspl*get_uniform(0.0_rp, mcm_mxdspl)

        !Get energy based on old configuration. For a good configuration, ierr
        !will return 0.
        enrg_vdw_ = 0.0_rp; enrg_bnd_ = 0.0_rp
        enrg_ang_ = 0.0_rp; enrg_dhd_ = 0.0_rp; enrg_teth_ = 0.0_rp
        energy_external_ = energy_external

        if (lvdw) then
            if (use_verlet_tab) then
                call ia_calc_atm_vdw_energy_vl(iatm, enrg_vdw_, ierr)
            else
                call ia_calc_atm_vdw_energy(iatm, enrg_vdw_, ierr)
            end if
        end if
        if (num_bonds > 0) call ia_calc_atm_bond_energy(iatm, enrg_bnd_, ierr)
        if (num_angles > 0) call ia_calc_atm_angle_energy(iatm, enrg_ang_)
        if (num_dihedrals > 0) call ia_calc_atm_dihedral_energy(iatm, enrg_dhd_)
        if (num_tethers > 0) call ia_calc_atm_tether_energy(iatm, enrg_teth_, ierr)
        if (num_externals > 0) call ia_calc_external_energy(ierr)

        !Save atom position
        coords = coordinates(:,iatm)

        !Displace atom
        coordinates(:,iatm) = coordinates(:,iatm) + rdspl

        !Get energy based on new configuration
        enrg_vdw = 0.0_rp; enrg_bnd = 0.0_rp
        enrg_ang = 0.0_rp; enrg_dhd = 0.0_rp; enrg_teth = 0.0_rp

        if (lvdw) then
            if (use_verlet_tab) then
                call ia_calc_atm_vdw_energy_vl(iatm, enrg_vdw, ierr)
            else
                call ia_calc_atm_vdw_energy(iatm, enrg_vdw, ierr)
            end if
        end if

        if ((ierr==0) .and. (num_bonds > 0)) then
            call ia_calc_atm_bond_energy(iatm, enrg_bnd, ierr)
        end if
        if ((ierr==0) .and. (num_angles > 0)) then
            call ia_calc_atm_angle_energy(iatm, enrg_ang)
        end if
        if ((ierr==0) .and. (num_dihedrals > 0)) then
            call ia_calc_atm_dihedral_energy(iatm, enrg_dhd)
        end if
        if ((ierr==0) .and. (num_tethers > 0)) then
            call ia_calc_atm_tether_energy(iatm, enrg_teth, ierr)
        end if
        if ((ierr==0) .and. (num_externals > 0)) then
            call ia_calc_external_energy(ierr)
        end if

        if (ierr /= 0) then
            enrg_dif = huge(0.0_rp)
        else
            enrg_dif = (enrg_vdw - enrg_vdw_) + (enrg_ang - enrg_ang_) &
                + (enrg_ang - enrg_ang_) + (enrg_dhd - enrg_dhd_)      &
                + (enrg_teth - enrg_teth_)                             &
                + (energy_external - energy_external_)
        end if

        iaccept = metro_crit(enrg_dif)
        naccept = naccept + iaccept
        if (iaccept == 0) then
            !If move is not accepted, revert position
            coordinates(:,iatm) =  coords
            energy_external = energy_external_
        else
            !If move is accepted, update energy
            energy_bond = energy_bond + enrg_bnd - enrg_bnd_
            energy_angle = energy_angle + enrg_ang - enrg_ang_
            energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
            energy_vdw = energy_vdw + enrg_vdw - enrg_vdw_
            energy_tether = energy_tether + enrg_teth - enrg_teth_
            if (num_tethers == 0) call to_com()
        end if
    end do

    mc_rec(1,5) = mc_rec(1,5) + natmpts
    mc_rec(2,5) = mc_rec(2,5) + naccept

    end subroutine

!******************************************************************************

subroutine mcm_crnk(is_ring)
    !! Performs crankshaft move (including end-bond rotation) on an unbranched
    !! chain or ring. End-bond rotation will not be performed for rings.

    logical, intent(in) :: is_ring
    real(rp), dimension(3,3) :: rotmat
    real(rp), dimension(3) :: coords
    real(rp), dimension(3) :: axis
    real(rp), dimension(3) :: r_pvt
    real(rp), dimension(3) :: ristar
    real(rp) :: axis_len
    real(rp) :: angle
    real(rp) :: enrg_vdw, enrg_ang, enrg_dhd, enrg_teth
    real(rp) :: enrg_vdw_, enrg_ang_, enrg_dhd_, enrg_teth_
    real(rp) :: energy_external_
    real(rp) :: enrg_dif
    integer  :: iatm
    integer  :: natmpts, naccept
    integer  :: iatmpt, iaccept
    integer  :: crnk_beg, crnk_end
    integer  :: ierr
    integer  :: na_bbone

    !No branches: Total number of atoms same as the number of backbone atoms.
    na_bbone = num_atoms

    !There must be two or more atoms
    if (na_bbone < 2) return

    !Number of attempts
    natmpts = num_mc_moves(2)

    !Initialize number of accepts to zero
    naccept = 0

    do iatmpt = 1, natmpts
        !Pick an atom
        if (is_ring) then
            !For rings: No ends
            iatm = get_iuniform(1, na_bbone+1)
            if (iatm == 1) then
                crnk_beg = na_bbone; crnk_end = 2
            else if (iatm == na_bbone) then
                crnk_beg = na_bbone - 1; crnk_end = 1
            else
                crnk_beg = iatm - 1; crnk_end = iatm + 1
            end if
            axis = coordinates(:,crnk_end) - coordinates(:,crnk_beg)
        else
            !For chains
            if (num_tethers == 0) then
                iatm = get_iuniform(1, na_bbone+1)
            else
                iatm = get_iuniform(2, na_bbone+1) !<-- Tether constraints here
            end if
            if (iatm == 1) then
                !Ends are rotated about a random axis
                call ransphere(axis)
                crnk_beg = 2
            else if (iatm == na_bbone) then
                !Ends are rotated about a random axis
                call ransphere(axis)
                crnk_beg = na_bbone - 1
            else
                !Non-ends are rotated about an axis determined by adjacent atom
                !positions
                crnk_beg = iatm - 1; crnk_end = iatm + 1
                axis = coordinates(:,crnk_end) - coordinates(:,crnk_beg)
            end if
        end if

        axis_len = norm2(axis)
        if (axis_len < 1.0E-8_rp) then
            !If axis_len is too small reject the move
            cycle
        else
            !Get unit vector along the axis
            axis = axis/axis_len
        end if

        angle = get_uniform(-math_pi, math_pi)
        call get_rotmat(axis, angle, rotmat)

        r_pvt = coordinates(:,crnk_beg) !Pivot point

        !Get energy based on old configuration. For a good configuration, ierr
        !will return 0.
        enrg_vdw_ = 0.0_rp; enrg_ang_ = 0.0_rp
        enrg_dhd_ = 0.0_rp; enrg_teth_ = 0.0_rp
        energy_external_ = energy_external

        if (lvdw) then
            if (use_verlet_tab) then
                call ia_calc_atm_vdw_energy_vl(iatm, enrg_vdw_, ierr)
            else
                call ia_calc_atm_vdw_energy(iatm, enrg_vdw_, ierr)
            end if
        end if
        if (num_angles > 0) call ia_calc_atm_angle_energy(iatm, enrg_ang_)
        if (num_dihedrals > 0) call ia_calc_atm_dihedral_energy(iatm, enrg_dhd_)
        if (num_tethers > 0) call ia_calc_atm_tether_energy(iatm, enrg_teth_, ierr)
        if (num_externals > 0) call ia_calc_external_energy(ierr)

        !Save atom position
        coords = coordinates(:,iatm)

        !Rotate atom
        ristar = coordinates(:,iatm) - r_pvt
        coordinates(:,iatm) = r_pvt + rotmat(:,1)*ristar(1) &
                + rotmat(:,2)*ristar(2) + rotmat(:,3)*ristar(3)

        !Get energy based on new configuration
        enrg_vdw = 0.0_rp; enrg_ang = 0.0_rp
        enrg_dhd = 0.0_rp; enrg_teth = 0.0_rp

        if (lvdw) then
            if (use_verlet_tab) then
                call ia_calc_atm_vdw_energy_vl(iatm, enrg_vdw, ierr)
            else
                call ia_calc_atm_vdw_energy(iatm, enrg_vdw, ierr)
            end if
        end if

        if ((ierr==0) .and. (num_angles > 0)) then
            call ia_calc_atm_angle_energy(iatm, enrg_ang)
        end if
        if ((ierr==0) .and. (num_dihedrals > 0)) then
            call ia_calc_atm_dihedral_energy(iatm, enrg_dhd)
        end if
        if ((ierr==0) .and. (num_tethers > 0)) then
            call ia_calc_atm_tether_energy(iatm, enrg_teth, ierr)
        end if
        if ((ierr==0) .and. (num_externals > 0)) then
            call ia_calc_external_energy(ierr)
        end if

        if (ierr /= 0) then
            enrg_dif = huge(0.0_rp)
        else
            enrg_dif = (enrg_vdw - enrg_vdw_) + (enrg_ang - enrg_ang_) &
                + (enrg_dhd - enrg_dhd_) + (enrg_teth - enrg_teth_)    &
                + (energy_external - energy_external_)
        end if

        iaccept = metro_crit(enrg_dif)
        naccept = naccept + iaccept
        if (iaccept == 0) then
            !If move is not accepted, revert position
            coordinates(:,iatm) =  coords
            energy_external = energy_external_
        else
            !If move is accepted, update energy
            energy_angle = energy_angle + enrg_ang - enrg_ang_
            energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
            energy_vdw = energy_vdw + enrg_vdw - enrg_vdw_
            energy_tether = energy_tether + enrg_teth - enrg_teth_
            if (num_tethers == 0) call to_com()
        end if
    end do

    mc_rec(1,2) = mc_rec(1,2) + natmpts
    mc_rec(2,2) = mc_rec(2,2) + naccept

    end subroutine

!******************************************************************************

subroutine mcm_sc_crnk()
    !! Performs side chain crankshaft move. 
     
    real(rp), dimension(3,3) :: rotmat
    real(rp), dimension(3) :: coords
    real(rp), dimension(3) :: axis
    real(rp), dimension(3) :: r_pvt
    real(rp), dimension(3) :: ristar
    real(rp) :: axis_len
    real(rp) :: angle
    real(rp) :: enrg_vdw, enrg_ang, enrg_dhd, enrg_teth
    real(rp) :: enrg_vdw_, enrg_ang_, enrg_dhd_, enrg_teth_
    real(rp) :: energy_external_
    real(rp) :: enrg_dif
    integer  :: iatm
    integer  :: natmpts, naccept
    integer  :: iatmpt, iaccept
    integer  :: crnk_beg, crnk_end
    integer  :: ierr
    integer  :: na_br, ia_br_beg, ia_br, ibr

    !Number of attempts
    natmpts = num_mc_moves(2)
    !Initialize number of accepts to zero
    naccept = 0

    do iatmpt = 1, natmpts
        !Pick a side chain
        ibr = get_iuniform(2, num_branches+1) !Ignore the backbone
        na_br = branches(2,ibr)
        ia_br_beg = branches(3,ibr)

        !Pick an atom on this side chain and crankshaft axis
        if (na_br == 1) then
            !There is only one atom on this side chain
            iatm = ia_br_beg
            call ransphere(axis)
            crnk_beg = branches(1,ibr)
        else
            !There are multiple atoms on this side chain
            iatm = get_iuniform(ia_br_beg, ia_br_beg+na_br)
            if (iatm == ia_br_beg) then
                !First side chain atom
                crnk_beg = branches(1,ibr)
                crnk_end = iatm + 1
                axis = coordinates(:,crnk_end) - coordinates(:,crnk_beg)
            else if (iatm == (ia_br_beg+na_br-1)) then
                !Last side chain atom
                call ransphere(axis)
                crnk_beg = iatm - 1
            else
                !Intermediate side chain atom
                crnk_beg = iatm - 1; crnk_end = iatm + 1
                axis = coordinates(:,crnk_end) - coordinates(:,crnk_beg)
            end if
        end if

        axis_len = norm2(axis)
        if (axis_len < 1.0E-8_rp) then
            !If axis_len is too small reject the move
            cycle
        else
            !Get unit vector along the axis
            axis = axis/axis_len
        end if

        angle = get_uniform(-math_pi, math_pi)
        call get_rotmat(axis, angle, rotmat)

        r_pvt = coordinates(:,crnk_beg) !Pivot point

        !Get energy based on old configuration. For a good configuration, ierr
        !will return 0.
        enrg_vdw_ = 0.0_rp; enrg_ang_ = 0.0_rp
        enrg_dhd_ = 0.0_rp; enrg_teth_ = 0.0_rp
        energy_external_ = energy_external

        if (lvdw) then
            if (use_verlet_tab) then
                call ia_calc_atm_vdw_energy_vl(iatm, enrg_vdw_, ierr)
            else
                call ia_calc_atm_vdw_energy(iatm, enrg_vdw_, ierr)
            end if
        end if
        if (num_angles > 0) call ia_calc_atm_angle_energy(iatm, enrg_ang_)
        if (num_dihedrals > 0) call ia_calc_atm_dihedral_energy(iatm, enrg_dhd_)
        if (num_tethers > 0) call ia_calc_atm_tether_energy(iatm, enrg_teth_, ierr)
        if (num_externals > 0) call ia_calc_external_energy(ierr)

        !Save atom position
        coords = coordinates(:,iatm)

        !Rotate atom
        ristar = coordinates(:,iatm) - r_pvt
        coordinates(:,iatm) = r_pvt + rotmat(:,1)*ristar(1) &
                + rotmat(:,2)*ristar(2) + rotmat(:,3)*ristar(3)
    
        !Get energy based on new configuration
        enrg_vdw = 0.0_rp; enrg_ang = 0.0_rp
        enrg_dhd = 0.0_rp; enrg_teth = 0.0_rp

        if (lvdw) then
            if (use_verlet_tab) then
                call ia_calc_atm_vdw_energy_vl(iatm, enrg_vdw, ierr)
            else
                call ia_calc_atm_vdw_energy(iatm, enrg_vdw, ierr)
            end if
        end if

        if ((ierr==0) .and. (num_angles > 0)) then
            call ia_calc_atm_angle_energy(iatm, enrg_ang)
        end if
        if ((ierr==0) .and. (num_dihedrals > 0)) then
            call ia_calc_atm_dihedral_energy(iatm, enrg_dhd)
        end if
        if ((ierr==0) .and. (num_tethers > 0)) then
            call ia_calc_atm_tether_energy(iatm, enrg_teth, ierr)
        end if
        if ((ierr==0) .and. (num_externals > 0)) then
            call ia_calc_external_energy(ierr)
        end if

        if (ierr /= 0) then
            enrg_dif = huge(0.0_rp)
        else
            enrg_dif = (enrg_vdw - enrg_vdw_) + (enrg_ang - enrg_ang_) &
                + (enrg_dhd - enrg_dhd_) + (enrg_teth - enrg_teth_)    &
                + (energy_external - energy_external_)
        end if

        iaccept = metro_crit(enrg_dif)
        naccept = naccept + iaccept
        if (iaccept == 0) then
            !If move is not accepted, revert position
            coordinates(:,iatm) =  coords
            energy_external = energy_external_
        else
            !If move is accepted, update energy
            energy_angle = energy_angle + enrg_ang - enrg_ang_
            energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
            energy_vdw = energy_vdw + enrg_vdw - enrg_vdw_
            energy_tether = energy_tether + enrg_teth - enrg_teth_
            if (num_tethers == 0) call to_com()
        end if
    end do

    mc_rec(1,2) = mc_rec(1,2) + natmpts
    mc_rec(2,2) = mc_rec(2,2) + naccept

    end subroutine

!******************************************************************************

subroutine mcm_pivot()
    !! Performs a pivot move. Does not use a Verlet list.
    !I have left some print statements for debugging purposes.

    integer :: iaccept
    real(rp), dimension(3,3) :: rotmat
    real(rp), dimension(3) :: axis
    real(rp), dimension(3) :: r_pvt
    real(rp), dimension(3) :: ristar
    real(rp) :: angle
    real(rp) :: enrg_ang_, enrg_ang, enrg_dhd_, enrg_dhd
    real(rp) :: energy_vdw_, energy_external_
    real(rp) :: enrg_dif
    integer  :: pvt
    integer  :: ierr
    integer  :: na_bbone, na_br, tp
    integer  :: i, jbeg, jend, ibr, ia_br, ia_br_beg 

    iaccept = 0; ierr = 0
    coordinates_pvt = coordinates 

    if (num_branches == 0) then
        na_bbone = num_atoms
    else
        na_bbone = branches(2,1)
    end if

    call ransphere(axis)
    angle = get_uniform(-math_pi, math_pi)
    call get_rotmat(axis, angle, rotmat)

    !Pick a pivot point on the backbone. The section to be rotated cannot
    !have any tethering.
    if (num_tethers == 0) then
        !For a free molecule, rotate the shorter part
        pvt = get_iuniform(2, na_bbone)
        if (pvt < na_bbone/2 ) then
            jbeg = 1; jend = pvt - 1     !Will be rotated
        else
            jbeg = pvt + 1; jend = na_bbone !Will be rotated
        end if
    else
        !Change this part to suit the tether location. Here assuming that atom 1
        !is tethered to a wall, rotate the section away from the wall.
        pvt = get_iuniform(1, na_bbone)
        jbeg = pvt + 1; jend = na_bbone !Will be rotated
    end if
    r_pvt = coordinates(:,pvt)
    !print*, 'pvt ', pvt
    !print*, 'jbeg:jend ', jbeg, jend

    !Energy before rotation. This includes only the contribution from the pivot
    !point atom. The total vdw and total external energies are already known
    !from the last iteration.
    enrg_ang_ = 0.0_rp; enrg_dhd_ = 0.0_rp
    energy_vdw_ = energy_vdw           !Caching
    energy_external_ = energy_external !Caching
    if (num_angles > 0) call ia_calc_atm_angle_energy(pvt, enrg_ang_)
    if (num_dihedrals > 0) call ia_calc_atm_dihedral_energy(pvt, enrg_dhd_)

    !Rotate backbone
    do i = jbeg, jend
       ristar = coordinates(:,i) - r_pvt
       coordinates(:,i) = r_pvt + rotmat(:,1)*ristar(1) &
                       + rotmat(:,2)*ristar(2)          &
                       + rotmat(:,3)*ristar(3)
    end do 
    !Rotate side chains
    if (num_branches > 0) then
        do ibr = 2, num_branches !Backbone is the first branch
            tp = branches(1,ibr) !Index of tether point
            if ( (tp < jbeg) .or. (tp > jend) ) cycle
            na_br = branches(2,ibr) !Number of atoms in branch
            ia_br_beg = branches(3,ibr) !Index of the beginning atom in branch
            do ia_br = 1, na_br
                i = ia_br_beg + ia_br - 1
                ristar = coordinates(:,i) - r_pvt
                coordinates(:,i) = r_pvt + rotmat(:,1)*ristar(1) &
                        + rotmat(:,2)*ristar(2) + rotmat(:,3)*ristar(3)
            end do
        end do 
    end if

    !Total energy after rotation
    enrg_ang = 0.0_rp; enrg_dhd = 0.0_rp

    call ia_calc_external_energy(ierr)
    if ((ierr == 0) .and. (lvdw)) then
        call ia_calc_vdw_energy(ierr)
    end if
    if ((ierr == 0) .and. (num_angles > 0)) then
        call ia_calc_atm_angle_energy(pvt, enrg_ang)
    end if
    if ((ierr == 0) .and. (num_dihedrals > 0)) then
        call ia_calc_atm_dihedral_energy(pvt, enrg_dhd)
    end if

    !Energy difference
    if (ierr /= 0) then
        enrg_dif = huge(0.0_rp)
    else
        enrg_dif = (energy_vdw - energy_vdw_) + (enrg_ang - enrg_ang_) &
            + (enrg_dhd - enrg_dhd_) + (energy_external - energy_external_)
    end if

    iaccept = metro_crit(enrg_dif)
    if (iaccept == 0) then
        !If the move is rejected
        coordinates = coordinates_pvt
        energy_vdw = energy_vdw_
        energy_external = energy_external_
    else
        energy_angle = energy_angle + enrg_ang - enrg_ang_
        energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
        if (num_tethers == 0) call to_com()
    end if

    mc_rec(1,1) = mc_rec(1,1) + 1
    mc_rec(2,1) = mc_rec(2,1) + iaccept

    end subroutine

!******************************************************************************

subroutine mcm_res_pivot()
    !!Performs a restricted pivot move on the backbone. Does not use a Verlet list.
    !!Unlike usual pivot, the rotation axis for is chosen along the
    !!bond incident to the pivot point. This move may be useful for molecules that
    !!are restricted to be in a stretched conformation or if angular constraints
    !!need to be respected.
    !I have left some print statements for debugging purposes.

    integer :: iaccept
    real(rp), dimension(3,3) :: rotmat
    real(rp), dimension(3) :: axis
    real(rp), dimension(3) :: r_pvt
    real(rp), dimension(3) :: ristar
    real(rp) :: angle
    real(rp) :: enrg_ang_, enrg_ang, enrg_dhd_, enrg_dhd
    real(rp) :: energy_vdw_, energy_external_
    real(rp) :: enrg_dif
    integer  :: pvt
    integer  :: ierr
    integer  :: na_bbone, na_br, tp
    integer  :: i, jbeg, jend, ibr, ia_br, ia_br_beg 

    iaccept = 0; ierr = 0
    coordinates_pvt = coordinates 

    if (num_branches == 0) then
        na_bbone = num_atoms
    else
        na_bbone = branches(2,1)
    end if

    !Pick a pivot point on the backbone. The section to be rotated cannot
    !have any tethering.
    if (num_tethers == 0) then
        !For a free molecule, rotate the shorter part
        pvt = get_iuniform(2, na_bbone)
        if (pvt < na_bbone/2 ) then
            jbeg = 1; jend = pvt - 1     !Will be rotated
            axis = coordinates(:,pvt) - coordinates(:,pvt+1)
            axis = axis/norm2(axis)
        else
            jbeg = pvt + 1; jend = na_bbone !Will be rotated
            axis = coordinates(:,pvt) - coordinates(:,pvt-1)
            axis = axis/norm2(axis)
        end if
    else
        !Change this part to suit the tether location. Here, assuming that atom 1
        !is tethered to a wall, rotate the section away from the wall.
        pvt = get_iuniform(1, na_bbone)
        jbeg = pvt + 1; jend = na_bbone !Will be rotated
        axis = coordinates(:,pvt) - coordinates(:,pvt-1)
        axis = axis/norm2(axis)
    end if
    r_pvt = coordinates(:,pvt)
    !print*, 'pvt ', pvt
    !print*, 'jbeg:jend ', jbeg, jend

    !Choose the angle of rotation
    angle = get_uniform(-math_pi, math_pi)
    call get_rotmat(axis, angle, rotmat)

    !Energy before rotation. This includes only the contribution from the pivot
    !point atom. The total vdw and total external energies are already known
    !from the last iteration.
    enrg_ang_ = 0.0_rp; enrg_dhd_ = 0.0_rp
    energy_vdw_ = energy_vdw           !Caching
    energy_external_ = energy_external !Caching
    if (num_angles > 0) call ia_calc_atm_angle_energy(pvt, enrg_ang_)
    if (num_dihedrals > 0) call ia_calc_atm_dihedral_energy(pvt, enrg_dhd_)

    !Rotate backbone
    do i = jbeg, jend
       ristar = coordinates(:,i) - r_pvt
       coordinates(:,i) = r_pvt + rotmat(:,1)*ristar(1) &
                       + rotmat(:,2)*ristar(2)          &
                       + rotmat(:,3)*ristar(3)
    end do 
    !Rotate side chains
    if (num_branches > 0) then
        do ibr = 2, num_branches !Backbone is the first branch
            tp = branches(1,ibr) !Index of tether point
            if ( (tp < jbeg) .or. (tp > jend) ) cycle
            na_br = branches(2,ibr) !Number of atoms in branch
            ia_br_beg = branches(3,ibr) !Index of the beginning atom in branch
            do ia_br = 1, na_br
                i = ia_br_beg + ia_br - 1
                ristar = coordinates(:,i) - r_pvt
                coordinates(:,i) = r_pvt + rotmat(:,1)*ristar(1) &
                        + rotmat(:,2)*ristar(2) + rotmat(:,3)*ristar(3)
            end do
        end do 
    end if

    !Total energy after rotation
    enrg_ang = 0.0_rp; enrg_dhd = 0.0_rp

    call ia_calc_external_energy(ierr)
    if ((ierr == 0) .and. (lvdw)) then
        call ia_calc_vdw_energy(ierr)
    end if
    if ((ierr == 0) .and. (num_angles > 0)) then
        call ia_calc_atm_angle_energy(pvt, enrg_ang)
    end if
    if ((ierr == 0) .and. (num_dihedrals > 0)) then
        call ia_calc_atm_dihedral_energy(pvt, enrg_dhd)
    end if

    !Energy difference
    if (ierr /= 0) then
        enrg_dif = huge(0.0_rp)
    else
        enrg_dif = (energy_vdw - energy_vdw_) + (enrg_ang - enrg_ang_) &
            + (enrg_dhd - enrg_dhd_) + (energy_external - energy_external_)
    end if

    iaccept = metro_crit(enrg_dif)
    if (iaccept == 0) then
        !If the move is rejected
        coordinates = coordinates_pvt
        energy_vdw = energy_vdw_
        energy_external = energy_external_
    else
        energy_angle = energy_angle + enrg_ang - enrg_ang_
        energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
        if (num_tethers == 0) call to_com()
    end if

    mc_rec(1,4) = mc_rec(1,4) + 1
    mc_rec(2,4) = mc_rec(2,4) + iaccept

    end subroutine

!******************************************************************************

subroutine mcm_dbl_pivot()
    !!Performs double pivot move (for rings). Does not use Verlet list.
    !It is assumed that there are no tethers. If there are tethers, it is better
    !to incorporate them via energetic penalty.
    !I have left some print statements for debugging purposes.

    integer :: iaccept
    real(rp), dimension(3,3) :: rotmat
    real(rp), dimension(3) :: axis
    real(rp), dimension(3) :: r_pvt
    real(rp), dimension(3) :: ristar
    real(rp) :: angle
    real(rp) :: enrg_ang_, enrg_ang, enrg_dhd_, enrg_dhd
    real(rp) :: energy_vdw_, energy_external_
    real(rp) :: enrg, enrg_dif
    real(rp) :: axis_len
    integer  :: ierr
    integer  :: na_bbone, na_br, tp
    integer  :: ax_beg, ax_end, tmp, mstps, jstps
    integer  :: i, j, jj, jbeg, ibr, ia_br, ia_br_beg

    iaccept = 0; ierr = 0
    coordinates_pvt = coordinates 

    if (num_branches == 0) then
        na_bbone = num_atoms
    else
        na_bbone = branches(2,1)
    end if

    ax_beg = get_iuniform(1, na_bbone+1)
!   print*, 'ax_beg ', ax_beg
    do
        mstps = get_iuniform(2, na_bbone-1)
        ax_end = mod(ax_beg+mstps-1, na_bbone) + 1
        axis = coordinates(:,ax_end) - coordinates(:,ax_beg)
        axis_len = norm2(axis)
        !Check if axis_len is too small
        if (axis_len > 1.0E-8_rp) exit
    end do
!   print*, 'mstps: ax_end ', mstps, ax_end
    !Swap ax_beg and ax_end such that ax_end > ax_beg
    if (ax_end < ax_beg) then
        tmp = ax_end; ax_end = ax_beg; ax_beg = tmp
    end if
!   print*, 'ax_beg:ax_end ', ax_beg, ax_end

    !Get unit vector along the axis
    axis = axis/axis_len

    angle = get_uniform(-math_pi, math_pi)
    call get_rotmat(axis, angle, rotmat)
    r_pvt = coordinates(:,ax_beg) !First pivot point

    !Find the shorter part of the molecule to rotate. Note that the atoms ax_end
    !and ax_beg (i.e. atoms on the rotation axis) are not to be rotated.
    if ((ax_end-ax_beg) < na_bbone/2 ) then
        !Will be rotated
        jbeg = ax_beg + 1; jstps = (ax_end-1) - (ax_beg+1)     
    else
        !Will be rotated
        jbeg = ax_end + 1; jstps = na_bbone - (ax_end+1) + (ax_beg-1) 
    end if
!   print*, 'jbeg:jstps ', jbeg, jstps

    !Energy before rotation. This includes only the contribution from the pivot
    !point atom. The total vdw and total external energies are already known
    !from the last iteration.
    enrg_ang_ = 0.0_rp; enrg_dhd_ = 0.0_rp
    energy_vdw_ = energy_vdw           !Caching
    energy_external_ = energy_external !Caching
    if (num_angles > 0) then
        call ia_calc_atm_angle_energy(ax_beg, enrg)
        enrg_ang_ = enrg
        call ia_calc_atm_angle_energy(ax_end, enrg)
        enrg_ang_ = enrg_ang_ + enrg
    end if
    if (num_dihedrals > 0) then
        call ia_calc_atm_dihedral_energy(ax_beg, enrg)
        enrg_dhd_ = enrg
        call ia_calc_atm_dihedral_energy(ax_end, enrg)
        enrg_dhd_ = enrg_dhd_ + enrg
    end if

    !Rotate backbone
    do jj = 0, jstps
        j = mod(jbeg+jj-1, na_bbone) + 1
        ristar = coordinates(:,j) - r_pvt
        coordinates(:,j) = r_pvt + rotmat(:,1)*ristar(1) &
                        + rotmat(:,2)*ristar(2)          &
                        + rotmat(:,3)*ristar(3)
        !Rotate side chains
        if (num_branches > 0) then
            do ibr = 2, num_branches !Backbone is the first branch
                tp = branches(1,ibr) !Index of tether point
                if (tp /= j) cycle
                na_br = branches(2,ibr) !Number of atoms in branch
                ia_br_beg = branches(3,ibr) !Index of the beginning atom in branch
                do ia_br = 1, na_br
                    i = ia_br_beg + ia_br - 1
                    ristar = coordinates(:,i) - r_pvt
                    coordinates(:,i) = r_pvt + rotmat(:,1)*ristar(1) &
                            + rotmat(:,2)*ristar(2) + rotmat(:,3)*ristar(3)
                end do
            end do 
        end if
    end do 

    !Total energy after rotation
    enrg_ang = 0.0_rp; enrg_dhd = 0.0_rp

    call ia_calc_external_energy(ierr)

    if ((ierr == 0) .and. (lvdw)) then
        call ia_calc_vdw_energy(ierr)
    end if

    if ((ierr == 0) .and. (num_angles > 0)) then
        call ia_calc_atm_angle_energy(ax_beg, enrg)
        enrg_ang = enrg
        call ia_calc_atm_angle_energy(ax_end, enrg)
        enrg_ang = enrg_ang + enrg
    end if

    if ((ierr == 0) .and. (num_dihedrals > 0)) then
        call ia_calc_atm_dihedral_energy(ax_beg, enrg)
        enrg_dhd = enrg
        call ia_calc_atm_dihedral_energy(ax_end, enrg)
        enrg_dhd = enrg_dhd + enrg
    end if

    !Energy difference
    if (ierr /= 0) then
        enrg_dif = huge(0.0_rp)
    else
        enrg_dif = (energy_vdw - energy_vdw_) + (enrg_ang - enrg_ang_) &
            + (enrg_dhd - enrg_dhd_) + (energy_external - energy_external_)
    end if

    iaccept = metro_crit(enrg_dif)
    if (iaccept == 0) then
        !If the move is rejected
        coordinates = coordinates_pvt
        energy_vdw = energy_vdw_
        energy_external = energy_external_
    else
        energy_angle = energy_angle + enrg_ang - enrg_ang_
        energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
        call to_com()
    end if

    mc_rec(1,1) = mc_rec(1,1) + 1
    mc_rec(2,1) = mc_rec(2,1) + iaccept

    end subroutine

!******************************************************************************

subroutine mcm_sc_pivot()
    !! Performs pivot move on side chains. Does not use Verlet list.

    real(rp), dimension(3,3) :: rotmat
    real(rp), dimension(3) :: axis
    real(rp), dimension(3) :: r_pvt
    real(rp), dimension(3) :: ristar
    real(rp) :: angle
    real(rp) :: enrg_ang_, enrg_ang, enrg_dhd_, enrg_dhd
    real(rp) :: energy_vdw_, energy_external_
    real(rp) :: enrg_dif
    integer  :: pvt
    integer  :: ierr
    integer  :: natmpts, naccept
    integer  :: iatmpt, iaccept
    integer  :: i, jbeg, jend, ibr, ia_br, ia_br_beg, na_br 

    !Number of attempts
    natmpts = num_mc_moves(3)
    !Initialize number of accepts to zero
    naccept = 0

    do iatmpt = 1, natmpts
        coordinates_pvt = coordinates
        !Pick a side chain
        ibr = get_iuniform(2, num_branches) !Ignore the backbone
        na_br = branches(2,ibr)
        ia_br_beg = branches(3,ibr)

        call ransphere(axis)
        angle = get_uniform(-math_pi, math_pi)
        call get_rotmat(axis, angle, rotmat)

        !Pick a pivot point on this side chain
        if (na_br == 1) then
            !There is only one atom on this side chain. Pivot point
            !is the backbone atom to which this side chain is tethered to.
            pvt = branches(1,ibr)
            jbeg = ia_br_beg; jend = ia_br_beg + na_br - 1
        else
            !There are multiple atoms on this side chain
            pvt = get_iuniform(0, na_br)
            if (pvt == 0) then
                !Pivot point is the backbone atom to which this side chain
                !is tethered to.
                pvt = branches(1,ibr)
                jbeg = ia_br_beg; jend = ia_br_beg + na_br - 1
            else
                pvt = pvt + ia_br_beg - 1
                jbeg = pvt + 1; jend = ia_br_beg + na_br - 1
            end if
        end if

        r_pvt = coordinates(:,pvt) !Pivot point

        !Energy before rotation. This includes only the contribution from the pivot
        !point atom. The total vdw and total external energies are already known
        !from the last iteration.
        enrg_ang_ = 0.0_rp; enrg_dhd_ = 0.0_rp
        energy_vdw_ = energy_vdw           !Caching
        energy_external_ = energy_external !Caching
        if (num_angles > 0) call ia_calc_atm_angle_energy(pvt, enrg_ang_)
        if (num_dihedrals > 0) call ia_calc_atm_dihedral_energy(pvt, enrg_dhd_)

        !Rotate 
        do i = jbeg, jend
           ristar = coordinates(:,i) - r_pvt
           coordinates(:,i) = r_pvt + rotmat(:,1)*ristar(1) &
                           + rotmat(:,2)*ristar(2)          &
                           + rotmat(:,3)*ristar(3)
        end do

        !Total energy after rotation
        enrg_ang = 0.0_rp; enrg_dhd = 0.0_rp

        call ia_calc_external_energy(ierr)
        if ((ierr == 0) .and. (lvdw)) then
            call ia_calc_vdw_energy(ierr)
        end if
        if ((ierr == 0) .and. (num_angles > 0)) then
            call ia_calc_atm_angle_energy(pvt, enrg_ang)
        end if
        if ((ierr == 0) .and. (num_dihedrals > 0)) then
            call ia_calc_atm_dihedral_energy(pvt, enrg_dhd)
        end if

        !Energy difference
        if (ierr /= 0) then
            enrg_dif = huge(0.0_rp)
        else
            enrg_dif = (energy_vdw - energy_vdw_) + (enrg_ang - enrg_ang_) &
                + (enrg_dhd - enrg_dhd_) + (energy_external - energy_external_)
        end if

        iaccept = metro_crit(enrg_dif)
        naccept = naccept + iaccept
        if (iaccept == 0) then
            !If move is not accepted, revert position
            coordinates = coordinates_pvt
            energy_vdw = energy_vdw_
            energy_external = energy_external_
        else
            !If move is accepted, update energy
            energy_angle = energy_angle + enrg_ang - enrg_ang_
            energy_dihedral = energy_dihedral + enrg_dhd - enrg_dhd_
            if (num_tethers == 0) call to_com()
        end if
    end do

    mc_rec(1,3) = mc_rec(1,3) + natmpts
    mc_rec(2,3) = mc_rec(2,3) + naccept

    end subroutine

!******************************************************************************

function metro_crit(enrg_dif) result (res)
    !! Applies Metropolis criterion to a given energy difference. Returns zero
    !! for rejection and one for acceptance.

    real(rp), intent(in) :: enrg_dif
    integer  :: res
    real(rp) :: ran
    real(rp) :: prob

    res = 0

    if (enrg_dif <= 0.0_rp) then
        res = 1
    else if ((enrg_dif >= 0.0_rp) .and. (enrg_dif <= 40.0_rp)) then
        !Avoid considering very high energy differences. Here, any move with
        !a energy difference of more than 40 is rejected.
        ran = get_uniform(0.0_rp, 1.0_rp)
        prob = exp(-enrg_dif)
        if (ran <= prob) then
            res = 1
        end if
    end if

    end function

!******************************************************************************

subroutine get_rotmat(axis, alpha, rotmat)
    !! Returns the rotation matrix for axis-angle

    real(rp), dimension(3,3), intent(out):: rotmat
    real(rp), dimension(3), intent(in) :: axis
    real(rp), intent(in) :: alpha
    real(rp)  :: sinalpha
    real(rp)  :: cosalpha
    real(rp)  :: icosalpha
    real(rp)  :: icosxy
    real(rp)  :: icosyz
    real(rp)  :: icoszx
    real(rp)  :: sinx
    real(rp)  :: siny
    real(rp)  :: sinz
    
    sinalpha  = sin(alpha)
    cosalpha  = cos(alpha)
    icosalpha = 1.0_rp - cosalpha
    
    icosxy = axis(1)*axis(2)*icosalpha 
    icosyz = axis(2)*axis(3)*icosalpha 
    icoszx = axis(3)*axis(1)*icosalpha 
    sinx   = axis(1)*sinalpha
    siny   = axis(2)*sinalpha
    sinz   = axis(3)*sinalpha
    
    rotmat(1,1) =  cosalpha + icosalpha*axis(1)*axis(1)
    rotmat(2,1) =  sinz + icosxy
    rotmat(3,1) =  -siny + icoszx
    rotmat(1,2) =  icosxy - sinz
    rotmat(2,2) =  cosalpha + icosalpha*axis(2)*axis(2)
    rotmat(3,2) =  sinx + icosyz
    rotmat(1,3) =  siny + icoszx
    rotmat(2,3) =  -sinx + icosyz
    rotmat(3,3) =  cosalpha + icosalpha*axis(3)*axis(3)
    
    end subroutine

!******************************************************************************

subroutine to_com()
    !!Brings the center-of-mass of the molecule to the origin.

    real(rp), dimension(3) :: cm
    integer :: i

    cm = sum(coordinates,2)/num_atoms

    do i = 1, num_atoms
        coordinates(:,i) = coordinates(:,i) - cm
    end do

    end subroutine

!******************************************************************************

end module m_mc_moves