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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/02/15 17:49:45  mclareni
* Kernlib
*
*
#include "kerngen/pilot.h"
      FUNCTION ICHEXI (CHV,JLP,JRP)
C
C CERN PROGLIB# M432    ICHEXI          .VERSION KERNFOR  4.35  930308
C ORIG. 04/10/88, JZ
C
C-    Read hexadecimal integer from CHV(JL:JR)

      DIMENSION    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

      JJ = JLP(1)
      JR = JRP(1)

      IVAL = 0
      NDG  = 0
      NEG  = 0
      NGSLAT = 0

   12 IF (JJ.GT.JR)          GO TO 99
      IF (CHV(JJ:JJ).EQ.' ')  THEN
          JJ = JJ + 1
          GO TO 12
        ELSEIF (CHV(JJ:JJ).EQ.'+')  THEN
          JJ = JJ + 1
        ELSEIF (CHV(JJ:JJ).EQ.'-')  THEN
          NEG = 7
          JJ  = JJ + 1
        ENDIF

   21 IF (JJ.GT.JR)          GO TO 99
#if defined(CERNLIB_QASCII)
      K = ICHAR (CHV(JJ:JJ))
      K = K - 48
      IF (K.LT.0)            GO TO 98
      IF (K.GE.10)  THEN
          K = K - 7
          IF (K.LT.10)       GO TO 98
          IF (K.GE.16)  THEN
              K = K - 32
              IF (K.LT.10)   GO TO 98
              IF (K.GE.16)   GO TO 98
            ENDIF
        ENDIF
#endif
#if defined(CERNLIB_QEBCDIC)
      K = ICHAR (CHV(JJ:JJ))
      K = K - 119
      IF (K.LT.10)           GO TO 98
      IF (K.GE.16)  THEN
          K = K - 64
          IF (K.LT.10)       GO TO 98
          IF (K.GE.16)  THEN
              K = K - 57
              IF (K.LT.0)    GO TO 98
              IF (K.GE.10)   GO TO 98
            ENDIF
        ENDIF
#endif
#if !defined(CERNLIB_QISASTD)
      IVAL = IOR (ISHFTL(IVAL,4), K)
#endif
#if defined(CERNLIB_QISASTD)
      IVAL = IOR (ISHFT (IVAL,4), K)
#endif
      NDG  = NDG + 1
      JJ   = JJ + 1
      GO TO 21

   98 IF (CHV(JJ:JJ).NE.' ')  NGSLAT = JJ
   99 NDSLAT = NDG
      NESLAT = JJ
      IF (NEG.NE.0)  THEN
          IF (IVAL.NE.0)  IVAL = -IVAL
        ENDIF
      ICHEXI = IVAL
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/02/15 17:49:45 mclareni
	6	* Kernlib
	7	*
	8	*
	9	#include "kerngen/pilot.h"
	10	FUNCTION ICHEXI (CHV,JLP,JRP)
	11	C
	12	C CERN PROGLIB# M432 ICHEXI .VERSION KERNFOR 4.35 930308
	13	C ORIG. 04/10/88, JZ
	14	C
	15	C- Read hexadecimal integer from CHV(JL:JR)
	16
	17	DIMENSION 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	JJ = JLP(1)
	28	JR = JRP(1)
	29
	30	IVAL = 0
	31	NDG = 0
	32	NEG = 0
	33	NGSLAT = 0
	34
	35	12 IF (JJ.GT.JR) GO TO 99
	36	IF (CHV(JJ:JJ).EQ.' ') THEN
	37	JJ = JJ + 1
	38	GO TO 12
	39	ELSEIF (CHV(JJ:JJ).EQ.'+') THEN
	40	JJ = JJ + 1
	41	ELSEIF (CHV(JJ:JJ).EQ.'-') THEN
	42	NEG = 7
	43	JJ = JJ + 1
	44	ENDIF
	45
	46	21 IF (JJ.GT.JR) GO TO 99
	47	#if defined(CERNLIB_QASCII)
	48	K = ICHAR (CHV(JJ:JJ))
	49	K = K - 48
	50	IF (K.LT.0) GO TO 98
	51	IF (K.GE.10) THEN
	52	K = K - 7
	53	IF (K.LT.10) GO TO 98
	54	IF (K.GE.16) THEN
	55	K = K - 32
	56	IF (K.LT.10) GO TO 98
	57	IF (K.GE.16) GO TO 98
	58	ENDIF
	59	ENDIF
	60	#endif
	61	#if defined(CERNLIB_QEBCDIC)
	62	K = ICHAR (CHV(JJ:JJ))
	63	K = K - 119
	64	IF (K.LT.10) GO TO 98
65	IF (K.GE.16) THEN
66	K = K - 64
67	IF (K.LT.10) GO TO 98
68	IF (K.GE.16) THEN
69	K = K - 57
70	IF (K.LT.0) GO TO 98
71	IF (K.GE.10) GO TO 98
72	ENDIF
73	ENDIF
74	#endif
75	#if !defined(CERNLIB_QISASTD)
76	IVAL = IOR (ISHFTL(IVAL,4), K)
77	#endif
78	#if defined(CERNLIB_QISASTD)
79	IVAL = IOR (ISHFT (IVAL,4), K)
80	#endif
81	NDG = NDG + 1
82	JJ = JJ + 1
83	GO TO 21
84
85	98 IF (CHV(JJ:JJ).NE.' ') NGSLAT = JJ
86	99 NDSLAT = NDG
87	NESLAT = JJ
88	IF (NEG.NE.0) THEN
89	IF (IVAL.NE.0) IVAL = -IVAL
90	ENDIF
91	ICHEXI = IVAL
92	RETURN
93	END