copy Subroutine

public subroutine copy(X, N, Y)

NAME

copy(3f) - [M_datapac:VECTOR_OPERATION] copy the elements of one
vector into another vector

SYNOPSIS

   SUBROUTINE COPY(X,N,Y)

    REAL(kind=wp),intent(in)     :: X(:)
    INTEGER,intent(in)           :: N
    REAL(kind=wp),intent(inout)  :: Y(:)

DESCRIPTION

COPY(3f) copies the contents of the REAL vector X into the REAL
vector Y.

The first element of X is copied into the first element of Y; the
second element of X is copied into the second element of Y, etc.

This pre-f90 procedure can be replaced with modern array syntax
and should not be required in new code.

INPUT ARGUMENTS

X    The vector of observations to be copied. the input vector X
     remains unaltered.

N    The integer number of observations in the vector X.

OUTPUT ARGUMENTS

Y    The vector into which the copied data values from X will be
     sequentially placed such that Y will have its first N
     elements identical to the vector X.

EXAMPLES

Sample program:

program demo_copy
use M_datapac, only : copy
implicit none
character(len=*),parameter :: g='(*(g0.3,1x))'
real,allocatable :: from(:), to(:)
   from=[1.0,2.0,3.0,4.0,5.0]
   to=[-1.0,-1.0,-1.0,-1.0,-1.0,-1.0]
   call copy(from,3,to)
   write(*,g)to
end program demo_copy

Results:

1.00 2.00 3.00 -1.00 -1.00 -1.00

AUTHOR

The original DATAPAC library was written by James Filliben of the
Statistical Engineering Division, National Institute of Standards
and Technology.

MAINTAINER

John Urban, 2022.05.31

LICENSE

CC0-1.0

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: X(:)
integer, intent(in) :: N
real(kind=wp), intent(inout) :: Y(:)

Source Code

subroutine copy(x,n,y)
real(kind=wp),intent(in)     :: X(:)
integer,intent(in)           :: N
real(kind=wp),intent(inout)  :: Y(:)
!
integer       :: i
real(kind=wp) :: hold
!---------------------------------------------------------------------
   !
   !   CHECK THE INPUT ARGUMENTS FOR ERRORS
   !
   if ( N<1 ) then

      write (G_IO,99001)
      99001    format (' ***** FATAL ERROR--The second input argument to COPY(3f) is non-positive *****')
      write (G_IO,99002) N
      99002 format (' ','***** The value of the argument is ',I0,' *****')
   elseif (N.gt.size(Y)) then
      write (G_IO,99003)
      99003    format (' ***** FATAL ERROR--The target vector is too small in COPY(3f) *****')
      write (G_IO,99004) size(y),n
      99004 format (' ','***** The size of the target vector is ',I0,' and the requested number of elements is ',i0,' *****')
   else

      USEABLE: if ( N==1 ) then
         write (G_IO,99005)
         99005 format (' ***** NON-FATAL DIAGNOSTIC--The second input argument to COPY(3f) has the value 1 *****')
      else useable
         hold = X(1)
         do i = 2 , N
            if ( X(i)/=hold ) exit USEABLE
         enddo
         write (G_IO,99006) hold
         99006 format (' ***** NON-FATAL DIAGNOSTIC--The first input argument (a vector) to COPY(3f) has all elements =',&
         & E15.8,' *****')
      endif USEABLE

      do i = 1 , N
         Y(i) = X(i)
      enddo

   endif

end subroutine copy