[u/mrichter/AliRoot.git] / MINICERN / packlib / kernlib / kerngen / tcgen / csethi.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:43  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      SUBROUTINE CSETHI (INTP, CHV,JLP,JRP)
C
C CERN PROGLIB# M432    CSETHI          .VERSION KERNFOR  4.31  911111
C ORIG. 17/10/89, JZ
C
C-    Set hexadecimal integer into CHV(JL:JR) right-justified

      DIMENSION    INTP(9), JLP(9), JRP(9)

      COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
      CHARACTER    CHV*(*)

#if !defined(CERNLIB_QISASTD)
#include "kerngen/q_andor.inc"
#include "kerngen/q_shift.inc"
#endif

      JL  = JLP(1)
      JJ  = JRP(1)

      IVAL   = INTP(1)
      NDG    = 0
      NGSLAT = 0

   12 IF (JJ.LT.JL)          GO TO 97
      K    = IAND (IVAL,15)
#if !defined(CERNLIB_QISASTD)
      IVAL = ISHFTR (IVAL,4)
#endif
#if defined(CERNLIB_QISASTD)
      IVAL = ISHFT (IVAL,-4)
#endif
      IF (K.LT.10)  THEN
#if defined(CERNLIB_QASCII)
          CHV(JJ:JJ) = CHAR(K+48)
        ELSE
          CHV(JJ:JJ) = CHAR(K+55)
#endif
#if defined(CERNLIB_QEBCDIC)
          CHV(JJ:JJ) = CHAR(K+240)
        ELSE
          CHV(JJ:JJ) = CHAR(K+183)
#endif
        ENDIF

      JJ  = JJ  - 1
      NDG = NDG + 1
      IF (IVAL.NE.0)         GO TO 12
      GO TO 98

   97 NGSLAT = JL
   98 NFSLAT = JJ
      NESLAT = JJ
      NDSLAT = NDG
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/02/15 17:49:43 mclareni
	6	* Kernlib
	7	*
	8	*
	9	#include "kerngen/pilot.h"
	10	SUBROUTINE CSETHI (INTP, CHV,JLP,JRP)
	11	C
	12	C CERN PROGLIB# M432 CSETHI .VERSION KERNFOR 4.31 911111
	13	C ORIG. 17/10/89, JZ
	14	C
	15	C- Set hexadecimal integer into CHV(JL:JR) right-justified
	16
	17	DIMENSION INTP(9), JLP(9), JRP(9)
	18
	19	COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
	20	CHARACTER CHV()
	21
	22	#if !defined(CERNLIB_QISASTD)
	23	#include "kerngen/q_andor.inc"
	24	#include "kerngen/q_shift.inc"
	25	#endif
	26
	27	JL = JLP(1)
	28	JJ = JRP(1)
	29
	30	IVAL = INTP(1)
	31	NDG = 0
	32	NGSLAT = 0
	33
	34	12 IF (JJ.LT.JL) GO TO 97
	35	K = IAND (IVAL,15)
	36	#if !defined(CERNLIB_QISASTD)
	37	IVAL = ISHFTR (IVAL,4)
	38	#endif
	39	#if defined(CERNLIB_QISASTD)
	40	IVAL = ISHFT (IVAL,-4)
	41	#endif
	42	IF (K.LT.10) THEN
	43	#if defined(CERNLIB_QASCII)
	44	CHV(JJ:JJ) = CHAR(K+48)
	45	ELSE
	46	CHV(JJ:JJ) = CHAR(K+55)
	47	#endif
	48	#if defined(CERNLIB_QEBCDIC)
	49	CHV(JJ:JJ) = CHAR(K+240)
	50	ELSE
	51	CHV(JJ:JJ) = CHAR(K+183)
	52	#endif
	53	ENDIF
	54
	55	JJ = JJ - 1
	56	NDG = NDG + 1
	57	IF (IVAL.NE.0) GO TO 12
	58	GO TO 98
	59
	60	97 NGSLAT = JL
	61	98 NFSLAT = JJ
	62	NESLAT = JJ
	63	NDSLAT = NDG
	64	RETURN
65	END