clone_signs Subroutine

public subroutine clone_signs(tmp_sgns, tmp_lenof_sign, lenof_sign, num_signs)

Arguments

Type IntentOptional Attributes Name
integer(kind=hsize_t), intent(inout), allocatable :: tmp_sgns(:,:)
integer, intent(in) :: tmp_lenof_sign
integer, intent(in) :: lenof_sign
integer(kind=hsize_t), intent(in) :: num_signs

Contents

Source Code


Source Code

    subroutine clone_signs(tmp_sgns, tmp_lenof_sign, lenof_sign, num_signs)
        ! Resize a 2-D array from one first dimension to another by either deleting
        ! or copying entries
        implicit none
        ! Input: tmp_sgns - temporary storing the signs to be adapted to this runs number
        !                   of replicas
        !        tmp_lenof_sign - first dimension of tmp_sgns on input
        !        lenof_sign - first dimension of  tmp_sgns on return
        !        num_signs - number of entries in tmp_sgns to copy
        integer(hsize_t), allocatable, intent(inout) :: tmp_sgns(:, :)
        integer(hsize_t), intent(in) :: num_signs
        integer, intent(in) :: tmp_lenof_sign, lenof_sign

        ! a temporary buffer to store the old signs while reallocating tmp_sgns
        integer(hsize_t), allocatable :: sgn_store(:, :)
        integer :: ierr, i

        if (allocated(tmp_sgns)) then
            ! copy the signs to a temporary
            allocate(sgn_store(tmp_lenof_sign, num_signs), stat=ierr)
            sgn_store(:, :) = tmp_sgns(:, :)

            ! now, resize tmp_sgns
            deallocate(tmp_sgns)
            allocate(tmp_sgns(lenof_sign, num_signs), stat=ierr)

            ! and clone the signs to match lenof_sign numbers per entry
            do i = 1, int(num_signs)
                ! depending on if we want to remove or add replicas,
                ! shrink or expand the signs
                call resize_sign(tmp_sgns(:, i), sgn_store(:, i))
            end do

            deallocate(sgn_store)
        else
            write(stdout, *) "WARNING: Attempted to adjust lenof_sign for an empty input"
            ! throw a warning
        end if

    end subroutine clone_signs