*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:54:04  mclareni
* Initial revision
*
*
. $$$*****$$$*****$$$*****$$$*****
.
.     SUBROUTINE UCOCOP(A,X,IDO,IW,NA,NX)        *** V 302 ***
.     EXTRACTS IDO TIMES IW CONSECUTIVE WORDS FROM A, EVERY NA WORDS
.     AND PLANTS THEM INTO X, EVERY NX WORDS
.     DO NOTHING IF  IW.LE.0 .OR. IDO.LE.0
.
. $$$*****$$$*****$$$*****$$$*****
 
          AXR$
          FORT$
$(1)
UCOCOP*
#include "ftnors1.inc"
#include "spyuse.inc"
* Ignoring t=pass
          DL        A2,2,XARG          . LOC(IDO), LOC(IW)
          L         R2,0,A2            . IDO
          L         A3,0,A3            . IW
          DL        A1,4,XARG
          TLE,U     A3,1
          J         RETUR6             . IF IW.LE.0
          L         A4,A3
          ANU       A4,0,A1            . IW-NA
          DL        A0,0,XARG          . LOC(A), LOC(X)
          AN        A4,0,A2            . IW-NX
          LXI,U     A0,1
          LXI,U     A1,1
          J         UCP2
UCP1
          LR        R1,A3
          BT        A1,0,*A0
          AN        A0,A5
          AN        A1,A4
UCP2      JGD       R2,UCP1
          J         RETUR6
 
#if (defined(CERNLIB_WBACK))&&(defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
          INFO      010  3
$(3)      +         0776003,UCOCOP
          +         0,SAVX11
          +         'UCOCOP'
#include "gerr_c.inc"
SAVX11    RES       1
#endif
          END
#ifdef CERNLIB_TCGEN_UCOCOP
#undef CERNLIB_TCGEN_UCOCOP
#endif
