MINICERN/packlib/kernlib/kerngen/tcgen/icnumu.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 ICNUMU (CHV,JLP,JRP)
  11 C
  12 C CERN PROGLIB# M432    ICNUMU          .VERSION KERNFOR  4.40  940929
  13 C ORIG. 19/07/93, JZ
  14 C
  15 C-    Verify CHV(JL:JR) is alpha-numeric or underscore
  16
  17       DIMENSION    JLP(9), JRP(9)
  18
  19       COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
  20       CHARACTER    CHV*(*), CHWK*1
  21
  22 #include "kerngen/qnatch.inc"
  23 * Ignoring t=pass
  24
  25       JJ = JLP(1)
  26       JR = JRP(1)
  27
  28       NGSLAT = 0
  29       JPN = 0
  30       JPA = 0
  31       ND  = 0
  32
  33    12 IF (JJ.GT.JR)          GO TO 99
  34       CHWK = CHV(JJ:JJ)
  35       IF (CHWK.EQ.' ')       GO TO 19
  36       IF (CHWK.EQ.'_')       GO TO 17
  37 #if defined(CERNLIB_QASCII)
  38       K = ICHAR (CHWK)
  39       IF (K.LT.48)           GO TO 91
  40       IF (K.LT.58)  THEN
  41           IF (JPN.EQ.0)  JPN = JJ
  42           GO TO 18
  43         ENDIF
  44
  45       IF     (K.LT.65)       GO TO 91
  46       IF     (K.GE.91)  THEN
  47           IF (K.LT.97)       GO TO 91
  48           IF (K.GE.123)      GO TO 91
  49         ENDIF
  50 #endif
  51 #if defined(CERNLIB_QEBCDIC)
  52       J = ICHAR (CHWK)
  53       K = NATCH(J+1)
  54       IF (K.LE.1)            GO TO 91
  55       IF (K.EQ.2)  THEN
  56           IF (JPN.EQ.0)  JPN = JJ
  57           GO TO 18
  58         ENDIF
  59 #endif
  60    17 IF (JPA.EQ.0)  JPA = JJ
  61    18 ND  = ND + 1
  62    19 JJ  = JJ + 1
  63       GO TO 12
  64
  65    91 NGSLAT = JJ
  66    99 NDSLAT = ND
  67       NESLAT = JPN
  68       NFSLAT = JPA
  69       ICNUMU = JJ
  70       RETURN
  71       END