mimic_count_trcnst Subroutine

public subroutine mimic_count_trcnst(nconn, conn_map, bonds, bonds_pcode)

Routine to count the number of interdependent constraints amoung bonds

Arguments

TypeIntentOptionalAttributesName
integer, intent(out), dimension(:), allocatable:: nconn

number of dependencies per bond

integer, intent(out), dimension(:, :), allocatable:: conn_map

dependency map

type(bond_type), intent(in), dimension(:,:):: bonds

list of bond constraints

integer, intent(in), dimension(:):: bonds_pcode

number of bonds per code


Contents

Source Code


Source Code

subroutine mimic_count_trcnst(nconn, conn_map, bonds, bonds_pcode)
    !> number of dependencies per bond
    integer, dimension(:), allocatable, intent(out) :: nconn
    !> dependency map
    integer, dimension(:, :), allocatable, intent(out) :: conn_map
    !> list of bond constraints
    type(bond_type), dimension(:,:), intent(in) :: bonds
    !> number of bonds per code
    integer, dimension(:), intent(in) :: bonds_pcode

    integer :: n_code, n_bond, n_bond2
    integer :: current_maxconn = 0, current_conn = 0, id = 0, id2 = 0
    integer, dimension(:, :), allocatable :: temp_conn_map

    allocate(nconn(sum(bonds_pcode)))

    do n_code = 1, size(bonds_pcode)
        do n_bond = 1, bonds_pcode(n_code)
            current_conn = 0
            id = id + 1
            id2 = sum(bonds_pcode(1:n_code - 1))
            do n_bond2 = 1, bonds_pcode(n_code)
                id2 = id2 + 1
                if (bonds(n_bond, n_code)%atom_i == bonds(n_bond2, n_code)%atom_i .or. &
                    bonds(n_bond, n_code)%atom_j == bonds(n_bond2, n_code)%atom_j .or. &
                    bonds(n_bond, n_code)%atom_i == bonds(n_bond2, n_code)%atom_j .or. &
                    bonds(n_bond, n_code)%atom_j == bonds(n_bond2, n_code)%atom_i) then
                    current_conn = current_conn + 1

                    if (current_conn > current_maxconn) then
                        allocate(temp_conn_map(current_conn, sum(bonds_pcode)))
                        if (allocated(conn_map)) then
                            temp_conn_map(1:current_maxconn, :) = conn_map
                            deallocate(conn_map)
                        end if
                        current_maxconn = current_conn
                        call move_alloc(temp_conn_map, conn_map)
                    end if
                    conn_map(current_conn, id) = id2
                end if
            end do ! n_bond2
            nconn(id) = current_conn
        end do ! n_bond
    end do ! n_code
end subroutine mimic_count_trcnst