diff libcruft/arpack/util/icopy.f @ 12274:9f5d2ef078e8 release-3-4-x

import ARPACK sources to libcruft from Debian package libarpack2 2.1+parpack96.dfsg-3+b1
author John W. Eaton <jwe@octave.org>
date Fri, 28 Jan 2011 14:04:33 -0500
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/arpack/util/icopy.f	Fri Jan 28 14:04:33 2011 -0500
@@ -0,0 +1,77 @@
+*--------------------------------------------------------------------
+*\Documentation
+*
+*\Name: ICOPY
+*
+*\Description:
+*     ICOPY copies an integer vector lx to an integer vector ly.
+*
+*\Usage:
+*     call icopy ( n, lx, inc, ly, incy )
+*
+*\Arguments:
+*    n        integer (input)
+*             On entry, n is the number of elements of lx to be
+c             copied to ly.
+*
+*    lx       integer array (input)
+*             On entry, lx is the integer vector to be copied.
+*
+*    incx     integer (input)
+*             On entry, incx is the increment between elements of lx.
+*
+*    ly       integer array (input)
+*             On exit, ly is the integer vector that contains the
+*             copy of lx.
+*
+*    incy     integer (input)
+*             On entry, incy is the increment between elements of ly.
+*
+*\Enddoc
+*
+*--------------------------------------------------------------------
+*
+      subroutine icopy( n, lx, incx, ly, incy )
+*
+*     ----------------------------
+*     Specifications for arguments
+*     ----------------------------
+      integer    incx, incy, n
+      integer    lx( 1 ), ly( 1 )
+*
+*     ----------------------------------
+*     Specifications for local variables
+*     ----------------------------------
+      integer           i, ix, iy
+*
+*     --------------------------
+*     First executable statement
+*     --------------------------
+      if( n.le.0 )
+     $   return
+      if( incx.eq.1 .and. incy.eq.1 )
+     $   go to 20
+c
+c.....code for unequal increments or equal increments
+c     not equal to 1
+      ix = 1
+      iy = 1
+      if( incx.lt.0 )
+     $   ix = ( -n+1 )*incx + 1
+      if( incy.lt.0 )
+     $   iy = ( -n+1 )*incy + 1
+      do 10 i = 1, n
+         ly( iy ) = lx( ix )
+         ix = ix + incx
+         iy = iy + incy
+   10 continue
+      return
+c
+c.....code for both increments equal to 1
+c
+   20 continue
+      do 30 i = 1, n
+         ly( i ) = lx( i )
+   30 continue
+      return
+      end