Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not
allocated, or is not big enough, this will allocate space for it.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=DP), | intent(inout), | dimension(:,:), allocatable | :: | arr |
Destination array |
|
| real(kind=DP), | intent(in), | dimension(:,:), allocatable | :: | source |
Array to append |
|
| integer(kind=I4B), | intent(in), | optional | :: | nold |
Extent of original array. If passed, the source array will begin at arr(nold+1). Otherwise, the size of arr will be used. |
|
| logical, | intent(in), | optional, | dimension(:) | :: | lsource_mask |
Logical mask indicating which elements to append to |
subroutine base_util_append_arr_DPvec(arr, source, nold, lsource_mask) !! author: David A. Minton !! !! Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not !! allocated, or is not big enough, this will allocate space for it. implicit none ! Arguments real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append integer(I4B), intent(in), optional :: nold !! Extent of original array. If passed, the source array will begin at arr(nold+1). !! Otherwise, the size of arr will be used. logical, dimension(:), intent(in), optional :: lsource_mask !! Logical mask indicating which elements to append to ! Internals integer(I4B) :: nnew, nsrc, nend_orig if (.not.allocated(source)) return if (present(lsource_mask)) then nsrc = count(lsource_mask(:)) else nsrc = size(source,dim=2) end if if (nsrc == 0) return if (.not.allocated(arr)) then nend_orig = 0 allocate(arr(NDIM,nsrc)) else if (present(nold)) then nend_orig = nold else nend_orig = size(arr,dim=2) end if call util_resize(arr, nend_orig + nsrc) end if nnew = nend_orig + nsrc if (present(lsource_mask)) then arr(1, nend_orig + 1:nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) arr(2, nend_orig + 1:nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) arr(3, nend_orig + 1:nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) else arr(:,nend_orig + 1:nnew) = source(:,1:nsrc) end if return end subroutine base_util_append_arr_DPvec