MINICERN/packlib/kernlib/kerngen/tcgen/csethi.F

   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