MINICERN/packlib/kernlib/kerngen/tcgen/ishftc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:48  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10 #if !defined(CERNLIB_QMILSTD)
  11       FUNCTION ISHFTC(I,K,L)
  12 C
  13 C CERN PROGLIB# M441    ISHFTC          .VERSION KERNFOR  4.16  870601
  14 C ORIG. 01/10/85  T.LINDELOF
  15 C
  16 C      FORTRAN VERSION OF MIL-STD-1753 ISHFTC FUNCTION
  17 C      K IS THE SHIFT COUNT - NEGATIVE TO THE RIGHT
  18 C                             POSITIVE TO THE LEFT
  19 C      L IS THE NUMBER OF THE RIGHTMOST BITS TO BE SHIFTED, ALL
  20 C         OTHER BITS ARE LEFT UNCHANGED
  21 C
  22 #include "kerngen/wordsize.inc"
  23 #include "kerngen/iall1s.inc"
  24
  25 #include "kerngen/q_andor.inc"
  26 * Ignoring t=pass
  27 C
  28       IF (K.GT.0) THEN
  29          ISHFTC = IOR(IAND(ISHFT(IALL11, L), I),
  30      +    IOR(ISHFT(ISHFT(I, NBITPW-L), K-NBITPW),
  31      +        ISHFT(ISHFT(I, NBITPW-L+K), L-NBITPW)))
  32       ELSEIF (K.LT.0) THEN
  33          ISHFTC = IOR(IAND(ISHFT(IALL11, L), I),
  34      +        IOR(ISHFT(ISHFT(I, NBITPW-L), L+K-NBITPW),
  35      +        ISHFT(ISHFT(I, NBITPW+K), L-NBITPW) ))
  36       ELSE
  37          ISHFTC = I
  38       ENDIF
  39       END
  40 #endif