[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgens / upkch.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:50:16  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      SUBROUTINE UPKCH (ICHV,IGV,NN,IPAR)
C
C CERN PROGLIB# M427    UPKCH           .VERSION KERNFOR  4.20  881028
C ORIG. 07/07/72 JZ
C
      COMMON /SLATE/ JCH,N,NBITS,NCHAR,NZONE,IGNOR,JIN,NBDONE,NBEND
     +,              JGO,JBT,NLEFT,NRIGH,DUMMY(27)
      DIMENSION ICHV(*),IGV(*),IPAR(9)
C                  .
C
#include "kerngen/wordsize.inc"
C
#include "kerngen/q_jbit.inc"
* Ignoring t=pass
C
C
      N = NN
      IF (N.EQ.0)  RETURN
      NBITS = IPAR(1)
      NCHAR = IPAR(2)
      NZONE = IPAR(3)
      IGNOR = IPAR(4)
      JIN = 1
      JCH = 1
      IF (NZONE.NE.0)  GO TO 41
C
C----              ZONE = WORD
C
   21 JGO  = NBITPW+1 - IGNOR
      NBEND= NBITS + 1
      IF (NCHAR.EQ.0)  GO TO 22
      NBEND= MAX (NBEND, JGO-NBITS*(NCHAR-1))
C
   22 JBT = JGO
C
   24 JBT = JBT - NBITS
      IGV(JIN)= JBYT (ICHV(JCH),JBT,NBITS)
      IF (JIN.EQ.N)  RETURN
      JIN = JIN + 1
      IF (JBT.GE.NBEND)  GO TO 24
      JCH = JCH + 1
      GO TO 22
C
C----              ZONE NOT EQUALS A WORD
C
   41 IF (NZONE.EQ.NBITPW)  GO TO 21
      JBT   = NBITPW - IGNOR
      NBEND = NZONE+1 - NBITS
      IF (NCHAR.EQ.0)  GO TO 42
      NBEND = MIN (NBEND, IGNOR+NCHAR*NBITS)
C
   42 NBDONE= IGNOR
   43 IF (JBT.GE.0)  GO TO 44
      JBT= JBT + NBITPW
      JCH= JCH + 1
      GO TO 43
C
   44 JBT = JBT - NBITS
      IF (JBT.LT.0)  GO TO 51
      IGV(JIN)= JBYT (ICHV(JCH),JBT+1,NBITS)
      GO TO 58
C
C--                CHARACTER ACROSS WORD BOUNDARY
   51 NLEFT= NBITS + JBT
      NRIGH= -JBT
      JBT  = JBT + NBITPW
      IGV(JIN)= JBYT (ICHV(JCH+1),JBT+1,NRIGH)
      IF (NLEFT.EQ.0)  GO TO 54
      CALL CBYT (ICHV(JCH),1,IGV(JIN),NRIGH+1,NLEFT)
   54 JCH= JCH + 1
C
   58 IF (JIN.EQ.N)  RETURN
      JIN= JIN + 1
      NBDONE= NBDONE + NBITS
      IF (NBDONE.LT.NBEND)  GO TO 44
      JBT = JBT - (NZONE-NBDONE) - IGNOR
      GO TO 42
      END
Commit	Line	Data
fe4da5cc	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