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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:43  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      SUBROUTINE CSETOI (INTP, CHV,JLP,JRP)
C
C CERN PROGLIB# M432    CSETOI          .VERSION KERNFOR  4.33  920511
C ORIG. 03/06/92, JZ
C
C-    Set octal 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,7)
#if !defined(CERNLIB_QISASTD)
      IVAL = ISHFTR (IVAL,3)
#endif
#if defined(CERNLIB_QISASTD)
      IVAL = ISHFT (IVAL,-3)
#endif
#if defined(CERNLIB_QASCII)
      CHV(JJ:JJ) = CHAR(K+48)
#endif
#if defined(CERNLIB_QEBCDIC)
      CHV(JJ:JJ) = CHAR(K+240)
#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 CSETOI (INTP, CHV,JLP,JRP)
	11	C
	12	C CERN PROGLIB# M432 CSETOI .VERSION KERNFOR 4.33 920511
	13	C ORIG. 03/06/92, JZ
	14	C
	15	C- Set octal 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,7)
	36	#if !defined(CERNLIB_QISASTD)
	37	IVAL = ISHFTR (IVAL,3)
	38	#endif
	39	#if defined(CERNLIB_QISASTD)
	40	IVAL = ISHFT (IVAL,-3)
	41	#endif
	42	#if defined(CERNLIB_QASCII)
	43	CHV(JJ:JJ) = CHAR(K+48)
	44	#endif
	45	#if defined(CERNLIB_QEBCDIC)
	46	CHV(JJ:JJ) = CHAR(K+240)
	47	#endif
	48
	49	JJ = JJ - 1
	50	NDG = NDG + 1
	51	IF (IVAL.NE.0) GO TO 12
	52	GO TO 98
	53
	54	97 NGSLAT = JL
	55	98 NFSLAT = JJ
	56	NESLAT = JJ
	57	NDSLAT = NDG
	58	RETURN
	59	END