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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:46  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       FUNCTION ICOCTI (CHV,JLP,JRP)
  11 C
  12 C CERN PROGLIB# M432    ICOCTI          .VERSION KERNFOR  4.35  930308
  13 C ORIG. 03/06/92, JZ
  14 C
  15 C-    Read octal 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.8)            GO TO 98
  52 #endif
  53 #if defined(CERNLIB_QEBCDIC)
  54       K = ICHAR (CHV(JJ:JJ))
  55       K = K - 240
  56       IF (K.LT.0)            GO TO 98
  57       IF (K.GE.8)            GO TO 98
  58 #endif
  59 #if !defined(CERNLIB_QISASTD)
  60       IVAL = IOR (ISHFTL(IVAL,3), K)
  61 #endif
  62 #if defined(CERNLIB_QISASTD)
  63       IVAL = IOR (ISHFT (IVAL,3), K)
  64 #endif
  65       NDG  = NDG + 1
  66       JJ   = JJ + 1
  67       GO TO 21
  68
  69    98 IF (CHV(JJ:JJ).NE.' ')  NGSLAT = JJ
  70    99 NDSLAT = NDG
  71       NESLAT = JJ
  72       IF (NEG.NE.0)  THEN
  73           IF (IVAL.NE.0)  IVAL = -IVAL
  74         ENDIF
  75       ICOCTI = IVAL
  76       RETURN
  77       END