MINICERN/packlib/kernlib/kerngen/tcgens/upkch.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:16  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE UPKCH (ICHV,IGV,NN,IPAR)
  11 C
  12 C CERN PROGLIB# M427    UPKCH           .VERSION KERNFOR  4.20  881028
  13 C ORIG. 07/07/72 JZ
  14 C
  15       COMMON /SLATE/ JCH,N,NBITS,NCHAR,NZONE,IGNOR,JIN,NBDONE,NBEND
  16      +,              JGO,JBT,NLEFT,NRIGH,DUMMY(27)
  17       DIMENSION ICHV(*),IGV(*),IPAR(9)
  18 C                  .
  19 C
  20 #include "kerngen/wordsize.inc"
  21 C
  22 #include "kerngen/q_jbit.inc"
  23 * Ignoring t=pass
  24 C
  25 C
  26       N = NN
  27       IF (N.EQ.0)  RETURN
  28       NBITS = IPAR(1)
  29       NCHAR = IPAR(2)
  30       NZONE = IPAR(3)
  31       IGNOR = IPAR(4)
  32       JIN = 1
  33       JCH = 1
  34       IF (NZONE.NE.0)  GO TO 41
  35 C
  36 C----              ZONE = WORD
  37 C
  38    21 JGO  = NBITPW+1 - IGNOR
  39       NBEND= NBITS + 1
  40       IF (NCHAR.EQ.0)  GO TO 22
  41       NBEND= MAX (NBEND, JGO-NBITS*(NCHAR-1))
  42 C
  43    22 JBT = JGO
  44 C
  45    24 JBT = JBT - NBITS
  46       IGV(JIN)= JBYT (ICHV(JCH),JBT,NBITS)
  47       IF (JIN.EQ.N)  RETURN
  48       JIN = JIN + 1
  49       IF (JBT.GE.NBEND)  GO TO 24
  50       JCH = JCH + 1
  51       GO TO 22
  52 C
  53 C----              ZONE NOT EQUALS A WORD
  54 C
  55    41 IF (NZONE.EQ.NBITPW)  GO TO 21
  56       JBT   = NBITPW - IGNOR
  57       NBEND = NZONE+1 - NBITS
  58       IF (NCHAR.EQ.0)  GO TO 42
  59       NBEND = MIN (NBEND, IGNOR+NCHAR*NBITS)
  60 C
  61    42 NBDONE= IGNOR
  62    43 IF (JBT.GE.0)  GO TO 44
  63       JBT= JBT + NBITPW
  64       JCH= JCH + 1
  65       GO TO 43
  66 C
  67    44 JBT = JBT - NBITS
  68       IF (JBT.LT.0)  GO TO 51
  69       IGV(JIN)= JBYT (ICHV(JCH),JBT+1,NBITS)
  70       GO TO 58
  71 C
  72 C--                CHARACTER ACROSS WORD BOUNDARY
  73    51 NLEFT= NBITS + JBT
  74       NRIGH= -JBT
  75       JBT  = JBT + NBITPW
  76       IGV(JIN)= JBYT (ICHV(JCH+1),JBT+1,NRIGH)
  77       IF (NLEFT.EQ.0)  GO TO 54
  78       CALL CBYT (ICHV(JCH),1,IGV(JIN),NRIGH+1,NLEFT)
  79    54 JCH= JCH + 1
  80 C
  81    58 IF (JIN.EQ.N)  RETURN
  82       JIN= JIN + 1
  83       NBDONE= NBDONE + NBITS
  84       IF (NBDONE.LT.NBEND)  GO TO 44
  85       JBT = JBT - (NZONE-NBDONE) - IGNOR
  86       GO TO 42
  87       END