download scopy.f
Language: Fortran
LOC: 63
Project Info
Scientific Data Tools(sds)
Server: BerliOS
Type: cvs
...\sdsfortranlibs‑1.0\approx\
   bndacc.f
   bndsol.f
   bsplvd.f
   bsplvn.f
   chkder.f
   d1mach.f
   dasum.f
   daxpy.f
   dbndac.f
   dbndsl.f
   dbocls.f
   dbols.f
   dbolsm.f
   dckder.f
   dcopy.f
   dcov.f
   ddot.f
   defc.f
   defcmn.f
   denorm.f
   dfc.f
   dfcmn.f
   dfdjc3.f
   dfspvd.f
   dfspvn.f
   dh12.f
   dhfti.f
   dlpdp.f
   dlsei.f
   dlsi.f
   dmout.f
   dmpar.f
   dnls1.f
   dnls1e.f
   dnrm2.f
   dp1vlu.f
   dpcoef.f
   dpolft.f
   dqrfac.f
   dqrslv.f
   drot.f
   drotg.f
   drotm.f
   drotmg.f
   dscal.f
   dsort.f
   dswap.f
   dvout.f
   dwnlit.f
   dwnlsm.f
   dwnlt1.f
   dwnlt2.f
   dwnlt3.f
   dwnnls.f
   dwupdt.f
   efc.f
   efcmn.f
   enorm.f
   fc.f
   fcmn.f
   fdjac3.f
   fdump.f
   h12.f
   hfti.f
   i1mach.f
   idamax.f
   isamax.f
   ivout.f
   j4save.f
   lmpar.f
   lpdp.f
   lsei.f
   lsi.f
   pcoef.f
   polfit.f
   pvalue.f
   qrfac.f
   qrsolv.f
   r1mach.f
   rwupdt.f
   sasum.f
   saxpy.f
   sbocls.f
   sbols.f
   sbolsm.f
   scopy.f
   scov.f
   sdot.f
   smout.f
   snls1.f
   snls1e.f
   snrm2.f
   srot.f
   srotg.f
   srotm.f
   srotmg.f
   sscal.f
   ssort.f
   sswap.f
   svout.f
   wnlit.f
   wnlsm.f
   wnlt1.f
   wnlt2.f
   wnlt3.f
   wnnls.f
   xerclr.f
   xercnt.f
   xerhlt.f
   xermsg.f
   xerprn.f
   xersve.f
   xgetf.f
   xgetua.f
   xsetf.f

*DECK SCOPY
      SUBROUTINE SCOPY (N, SX, INCX, SY, INCY)
C***BEGIN PROLOGUE  SCOPY
C***PURPOSE  Copy a vector.
C***LIBRARY   SLATEC (BLAS)
C***CATEGORY  D1A5
C***TYPE      SINGLE PRECISION (SCOPY-S, DCOPY-D, CCOPY-C, ICOPY-I)
C***KEYWORDS  BLAS, COPY, LINEAR ALGEBRA, VECTOR
C***AUTHOR  Lawson, C. L., (JPL)
C           Hanson, R. J., (SNLA)
C           Kincaid, D. R., (U. of Texas)
C           Krogh, F. T., (JPL)
C***DESCRIPTION
C
C                B L A S  Subprogram
C    Description of Parameters
C
C     --Input--
C        N  number of elements in input vector(s)
C       SX  single precision vector with N elements
C     INCX  storage spacing between elements of SX
C       SY  single precision vector with N elements
C     INCY  storage spacing between elements of SY
C
C     --Output--
C       SY  copy of vector SX (unchanged if N .LE. 0)
C
C     Copy single precision SX to single precision SY.
C     For I = 0 to N-1, copy  SX(LX+I*INCX) to SY(LY+I*INCY),
C     where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
C     defined in a similar way using INCY.
C
C***REFERENCES  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
C                 Krogh, Basic linear algebra subprograms for Fortran
C                 usage, Algorithm No. 539, Transactions on Mathematical
C                 Software 5, 3 (September 1979), pp. 308-323.
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   791001  DATE WRITTEN
C   890831  Modified array declarations.  (WRB)
C   890831  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   920310  Corrected definition of LX in DESCRIPTION.  (WRB)
C   920501  Reformatted the REFERENCES section.  (WRB)
C***END PROLOGUE  SCOPY
      REAL SX(*), SY(*)
C***FIRST EXECUTABLE STATEMENT  SCOPY
      IF (N .LE. 0) RETURN
      IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
C
C     Code for unequal or nonpositive increments.
C
    5 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
        SY(IY) = SX(IX)
        IX = IX + INCX
        IY = IY + INCY
   10 CONTINUE
      RETURN
C
C     Code for both increments equal to 1.
C
C     Clean-up loop so remaining vector length is a multiple of 7.
C
   20 M = MOD(N,7)
      IF (M .EQ. 0) GO TO 40
      DO 30 I = 1,M
        SY(I) = SX(I)
   30 CONTINUE
      IF (N .LT. 7) RETURN
   40 MP1 = M + 1
      DO 50 I = MP1,N,7
        SY(I) = SX(I)
        SY(I+1) = SX(I+1)
        SY(I+2) = SX(I+2)
        SY(I+3) = SX(I+3)
        SY(I+4) = SX(I+4)
        SY(I+5) = SX(I+5)
        SY(I+6) = SX(I+6)
   50 CONTINUE
      RETURN
C
C     Code for equal, positive, non-unit increments.
C
   60 NS = N*INCX
      DO 70 I = 1,NS,INCX
        SY(I) = SX(I)
   70 CONTINUE
      RETURN
      END

About Koders | Resources | Downloads | Support | Black Duck | Submit Project | Terms of Service | DMCA | Privacy Policy | Site Map| Contact Us