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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:49  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       FUNCTION NCOCTI (CHV)
  11 C
  12 C CERN PROGLIB# M432    NCOCTI          .VERSION KERNFOR  4.35  930308
  13 C ORIG. 03/06/92, JZ
  14 C
  15 C-    Read octal integer from CHV
  16
  17       COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
  18       CHARACTER    CHV*(*)
  19
  20 #if !defined(CERNLIB_QISASTD)
  21 #include "kerngen/q_andor.inc"
  22 #include "kerngen/q_shift.inc"
  23 #endif
  24
  25       JJ = 1
  26       JR = LEN(CHV)
  27
  28       IVAL = 0
  29       NDG  = 0
  30       NEG  = 0
  31       NGSLAT = 0
  32
  33    12 IF (JJ.GT.JR)          GO TO 99
  34       IF (CHV(JJ:JJ).EQ.' ')  THEN
  35           JJ = JJ + 1
  36           GO TO 12
  37         ELSEIF (CHV(JJ:JJ).EQ.'+')  THEN
  38           JJ = JJ + 1
  39         ELSEIF (CHV(JJ:JJ).EQ.'-')  THEN
  40           NEG = 7
  41           JJ  = JJ + 1
  42         ENDIF
  43
  44    21 IF (JJ.GT.JR)          GO TO 99
  45 #if defined(CERNLIB_QASCII)
  46       K = ICHAR (CHV(JJ:JJ))
  47       K = K - 48
  48       IF (K.LT.0)            GO TO 98
  49       IF (K.GE.8)            GO TO 98
  50 #endif
  51 #if defined(CERNLIB_QEBCDIC)
  52       K = ICHAR (CHV(JJ:JJ))
  53       K = K - 240
  54       IF (K.LT.0)            GO TO 98
  55       IF (K.GE.8)            GO TO 98
  56 #endif
  57 #if !defined(CERNLIB_QISASTD)
  58       IVAL = IOR (ISHFTL(IVAL,3), K)
  59 #endif
  60 #if defined(CERNLIB_QISASTD)
  61       IVAL = IOR (ISHFT (IVAL,3), K)
  62 #endif
  63       NDG  = NDG + 1
  64       JJ   = JJ + 1
  65       GO TO 21
  66
  67    98 IF (CHV(JJ:JJ).NE.' ')  NGSLAT = JJ
  68    99 NDSLAT = NDG
  69       NESLAT = JJ
  70       IF (NEG.NE.0)  THEN
  71           IF (IVAL.NE.0)  IVAL = -IVAL
  72         ENDIF
  73       NCOCTI = IVAL
  74       RETURN
  75       END