*
* $Id: sinmcd.F,v 1.1.1.1 1995/12/12 14:36:19 mclareni Exp $
*
* $Log: sinmcd.F,v $
* Revision 1.1.1.1  1995/12/12 14:36:19  mclareni
* Imported sources
*
*
#include "sigma/pilot.h"
*CMZ :  1.09/04 26/10/93  09.49.19  by  Carlo E. Vandoni
*-- Author :
      SUBROUTINE SINMCD
C    ..................................................
C
C         PURPOSE
C            SERVICE ROUTINE FOR NUMBER
C            DECODES ANY CHARACTER SEQUENCE REPRESENTING A SIGNED
C            OR UNSIGNED REAL NUMBER
C
C         METHOD
C            FINITE STATE ALGORITHM AS GIVEN ON PAGE 41 OF
C            COMPILING TECHNIQUES BY F.R.A.HOPGOOD
C            AMERICAN ELSEVIER (1971)
C            WITH ADAPTATIONS TO SIGMA SYNTAX AS DESCRIBED IN NOTES
C            RESULTING FLOATING POINT NUMBER IN XNUM
C            ERROR CONDITION RETURNED VIA LOGICAL COMM.BLK.VAR. IND
C
C
C...  PAW VERSION  ...  MAY 1988
C    ..................................................
C
#include "sigma/sigkq.inc"
#include "sigma/sigc.inc"
#include "sigma/pawc.inc"
#include "sigma/sicph1.inc"
C
      SAVE IB
C
C
      CHARACTER KHAR*1,NUMSTR*10,SINSTR*1
      CHARACTER KSTRI*15
      DIMENSION IB(7,10),IENTRY(10)
      LOGICAL IND
      EQUIVALENCE(KHAR,ISGN)
      DATA IB(1,1),IB(1,2),IB(1,3),IB(1,4),IB(1,5) /7,7,1,9,7/
      DATA IB(1,6),IB(1,7),IB(1,8),IB(1,9),IB(1,10)/7,3,6,2,1/
      DATA IB(2,1),IB(2,2),IB(2,3),IB(2,4),IB(2,5) /7,8,7,8,5/
      DATA IB(2,6),IB(2,7),IB(2,8),IB(2,9),IB(2,10)/6,4,6,2,1/
      DATA IB(3,1),IB(3,2),IB(3,3),IB(3,4),IB(3,5) /7,7,7,7,7/
      DATA IB(3,6),IB(3,7),IB(3,8),IB(3,9),IB(3,10)/7,7,7,4,2/
      DATA IB(4,1),IB(4,2),IB(4,3),IB(4,4),IB(4,5) /7,8,7,8,5/
      DATA IB(4,6),IB(4,7),IB(4,8),IB(4,9),IB(4,10)/6,7,7,4,2/
C     STATE 6 IS REDUNDANT BUT LEFT IN IN CASE ONE CHANGES ONE-S MIND
C     ABOUT RECURSIVE + OR - SIGNS FOR THE INTEGER EXPONENT
      DATA IB(5,1),IB(5,2),IB(5,3),IB(5,4),IB(5,5) /7,7,5,5,7/
      DATA IB(5,6),IB(5,7),IB(5,8),IB(5,9),IB(5,10)/7,7,7,7,3/
      DATA IB(6,1),IB(6,2),IB(6,3),IB(6,4),IB(6,5) /7,7,7,7,7/
      DATA IB(6,6),IB(6,7),IB(6,8),IB(6,9),IB(6,10)/7,7,7,7,3/
      DATA IB(7,1),IB(7,2),IB(7,3),IB(7,4),IB(7,5) /7,8,7,8,7/
      DATA IB(7,6),IB(7,7),IB(7,8),IB(7,9),IB(7,10)/8,7,8,7,3/
C
      IND=.TRUE.
      KSTRI=' '
      IKSTR=0
C      SIGN=1.
CEV      N=0
C      NSIGN=1
      KSTATE=1
C
 10   CONTINUE
      KHAR=SINSTR(IC)
      IKSTR=IKSTR+1
       IF(IKSTR.GE.16)GOTO 107
      KSTRI(IKSTR:IKSTR)=KHAR
C---  IB NEW ITABLE
      DO 34 K=1,10
      IENTRY(K)=IB(KSTATE,K)
  34  CONTINUE
C
      NUMSTR='1234567890'
      NUM=INDEX(NUMSTR,KHAR)
      IF(NUM.EQ.0) GOTO 20
C     WE HAVE A DIGIT
CEV      IF(NUM.EQ.10) NUM=0
      IS=9
      IACTIO=IENTRY(IS+1)
      GOTO 100
C
 20   CONTINUE
      IS=1
      IF(KHAR.EQ.KQDOT) IS=7
      IF(KHAR.EQ.'E') IS=5
      IF(KHAR.EQ.KQMIN.OR.KHAR.EQ.KQPLUS) IS=3
      IACTIO=IENTRY(IS+1)
 100  CONTINUE
      KSTATE=IENTRY(IS)
C
CEV   IF(SITRAK(36).NE.0)   PRINT *,IACTIO,KSTATE
C
C     TAKE APPROPRIATE ACTION
      GOTO(101,102,103,104,105,200,107,300,111),IACTIO
C
 101  CONTINUE
C     V OF HOPGOOD
      GOTO 200
C
 102  CONTINUE
C     W OF HOPGOOD
CEV      N=N+1
      GOTO 200
C
 103  CONTINUE
C     X OF HOPGOOD
      GOTO 200
C
 104  CONTINUE
C     Y OF HOPGOOD
      GOTO 200
C
 105  CONTINUE
C     Z OF HOPGOOD
C      IF(KHAR.EQ.KQMIN) NSIGN=-NSIGN
      GOTO 200
C
 107  CONTINUE
C     ERROR RETURN FOR NUMBER OF INCORRECT SYNTAX
      IND=.FALSE.
      RETURN
C
C110  NUMBER COMPLETED CORRECTLY, GOES DIRECTLY TO 300
C
 111  CONTINUE
C     RECORD UNARY PLUSES OR MINUSES FOR SIGNED NUMBER
C      IF(KHAR.EQ.QMIN) SIGN=-SIGN
C
 200  CONTINUE
C     CONTINUE THE ASSEMBLY OF THE NUMBER
      IC=IC+1
      GOTO 10
C
C
 300  CONTINUE
C     TRUE RETURN, NUMBER COMPLETED CORRECTLY
       IF(IKSTR.EQ.15) GOTO 302
       DO 301 I=IKSTR,15
*       PRINT *,KSTRI
       KSTRI(I:I)=' '
 301   CONTINUE
 302  CONTINUE
*       PRINT *,KSTRI
      CALL KICTON(KSTRI,I,X)
      IF(IQUEST(1).NE.0) GOTO 107
      XNUM=X
      IF(SITRAK(36).NE.0) PRINT 1100,XNUM
 1100 FORMAT(1X,F18.9)
C
 999  END