*
* $Id: rdword.F,v 1.1.1.1 1996/02/15 17:47:45 mclareni Exp $
*
* $Log: rdword.F,v $
* Revision 1.1.1.1  1996/02/15 17:47:45  mclareni
* Kernlib
*
*
#include "kernbit/pilot.h"
      SUBROUTINE RDWORD(INUM,FPNUM,NAME,KTYPE)
C RDWORD IS A SMALL LEXICAL ANALYSER WHICH WAS WRITTEN TO REPLACE
C FUNCTIONALLY PACKAGE I301 USED ON CDC. IT READS THE NEXT OBJECT FROM
C ITS INTERNAL BUFFER. THIS OBJECT CAN BE A NUMBER, AN ALPHABETIC
C WORD OR A SPECIAL CHARACTER.
C VALUES RETURNED:
C KTYPE - TYPE OF OBJECT READ
C KTYPE=2 - INTEGER
C       1 - FLOATING POINT NUMBER
C       0 - SPECIAL CHARACTER
C      -1 - ALPHABETIC WORD
C      -100 - AN ERROR OR END OF BUFFER WAS DETECTED DURING READING
C             OF THE CURRENT OBJECT
C WHEN INTEGER OR FLOATING POINT NUMBER WAS READ:
C FPNUM = VALUE OF NUMBER READ IN FLOATING POINT FORM
C INUM  = VALUE OF INTEGER READ OR INTEGER PART OF FLOATING POINT
C         NUMBER
C WHEN NAME OR SPECIAL CHARACTER WAS READ:
C NAME = FIRST LENGTH(NAME) CHARACTERS OF NAME READ OR SPECIAL
C        CHARACTER. IF NAME WAS TRUNCATED AN ERROR MESSAGE IS GIVEN
C -----------------------------------------------------------------
C AUXILLIARY SUBROUTINES FOR USE WITH RDWORD:
C RDLOAD(STRING) - PUT 'STRING' INTO INTERNAL BUFFER OF RDWORD AND
C       SET INTERNAL POINTER TO ITS FIRST POSITION
C RDSKIP - SKIPS CONTENT OF THE BUFFER UP TO THE END
C RDENDB() - LOGICAL FUNCTION RETURNING .TRUE. VALUE IF END OF THE
C            BUFFER WAS REACHED AND .FALSE. OTHERWIZE
C*******************************************************************
C** IBPTR - INDEX OF THE CURRENT CHARACTER IN THE BUFFER
C** CURNT - CURRENT CHARACTER IN THE BUFFER TO WHICH IBPTR POINTS
C**         CURNT IS ALWAYS UPDATED WHEN IBPTR CHANGED
C** NOTE: AFTER EVERY SUBROUTINE IBPTR POINTS TO THE FIRST CHARACTER
C**       NOT READ BY THIS SUBROUTINE
C********************************************************************
      EXTERNAL RDWDAT
      CHARACTER*(*) NAME
#include "i303cd.inc"
      CHARACTER*8 FORM
C*NS  LOGICAL RDIGI,RALPH,RDENDB
      LOGICAL RDIGI,RALPH
      CHARACTER*1 RDUPCH
      NAME=' '
      INUM=0
      FPNUM=0.0
      KTYPE=-100
      CALL RDSKPB
C** END OF BUFFER CASE
      IF (IBPTR .GT. 80) RETURN
C** TO STORE THE INDEX OF THE FIRST CHARACTER OF THE WORD
      IFPOS=IBPTR
C** NUMBER PROCESSING
C** SIGN IS THE FIRST CHARACTER
      IF ((CURNT .EQ. '+') .OR. (CURNT .EQ. '-' )) THEN
         NAME=CURNT
         CALL RDNEXT
         IF (.NOT. (RDIGI() .OR. (CURNT .EQ. '.'))) THEN
C        *** NO DIGIT OR POINT AFTER SIGN. IT IS A SPECIAL CHARACTER
            KTYPE=0
            RETURN
         ENDIF
         NAME=' '
      ENDIF
C** DECIMAL POINT IS THE FIRST CHARACTER MAY BE AFTER '+' OR '-'
      IF (CURNT .EQ. '.') THEN
         CALL RDNEXT
         IF (RDIGI()) THEN
            CALL RDMANT(LENMAN,LENEXP)
C          *** MAKE FORMAT WITH NDEC DIGIT AFTER DEC. POINT
            WRITE(FORM,FMT='(2H(F,I2,1H.,I2,1H))') IBPTR-IFPOS,LENMAN
C          *** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
            READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) FPNUM
            INUM=FPNUM
            KTYPE=1
            RETURN
         ELSE
C        *** POINT WHICH IS NOT IN A NUMBER IS A SPECIAL CHARACTER
            NAME='.'
            KTYPE=0
         ENDIF
         RETURN
      ENDIF
C** DIGIT IS THE FIRST CHARACTER OF THE NEW WORD OR SECOND CHARACTER
C** AFTER '+' OR '-' - NUMBER PROCESSING
      IF (RDIGI()) THEN
         CALL RDINT(LENINT)
C        *** DECIMAL POINT AFTER INTEGER PART. READ MANTISSA
         IF (CURNT .EQ. '.') THEN
            CALL RDNEXT
            CALL RDMANT(LENMAN,LENEXP)
C          *** MAKE FORMAT WITH NDEC DIGIT AFTER DEC. POINT
            WRITE(FORM,FMT='(2H(F,I2,1H.,I2,1H))') IBPTR-IFPOS,LENMAN
C          *** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
            READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) FPNUM
            INUM = FPNUM
            KTYPE = 1
            RETURN
         ENDIF
C        *** 'E' IMMEDIATELY AFTER INTEGER PART. THIS IS CONSIDERED
C        *** LEGAL FLOATING POINT NUMBER
         IF (RDUPCH(CURNT) .EQ. 'E') THEN
            CALL RDMANT(LENMAN,LENEXP)
C          *** MAKE FORMAT WITH NDEC DIGIT AFTER DEC. POINT
            WRITE(FORM,FMT='(2H(F,I2,1H.,I2,1H))') IBPTR-IFPOS,LENMAN
C          *** READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
            READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) FPNUM
            INUM = FPNUM
            KTYPE = 1
            RETURN
         ENDIF
C        *** INTEGER PART NOT FOLLOWED BY '.' OR 'E'
C** MAKE FORMAT 'INN' WHERE 'NN' IS THE NUMBER LENGTH
         WRITE(FORM,FMT='(2H(I,I2,1H))') IBPTR-IFPOS
C**    READ NUMBER FROM THE BUFFER ACCORDING TO PREPARED FORMAT
         READ(BUFFER(IFPOS:(IBPTR-1)),FMT=FORM) INUM
         FPNUM=INUM
         KTYPE = 2
         RETURN
      ENDIF
C
C** LETTER IS THE FIRST CHARACTER OF THE NEW WORD - NAME PROCESSING
      IF (RALPH()) THEN
         CALL RDNAME(NAME)
         KTYPE = -1
         RETURN
      ENDIF
C
C** SPECIAL CHARACTER ENCOUNTERED
      NAME=CURNT
      KTYPE = 0
      CALL RDNEXT
      RETURN

      END